unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, GiveIo;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    btnLoad: TButton;
    btnUnload: TButton;
    GroupBox2: TGroupBox;
    btnGiveCurr: TButton;
    btnTest: TButton;
    GroupBox3: TGroupBox;
    ExeName: TEdit;
    btnExec: TButton;
    Label1: TLabel;
    procedure btnTestClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
    procedure btnUnloadClick(Sender: TObject);
    procedure btnGiveCurrClick(Sender: TObject);
    procedure btnExecClick(Sender: TObject);
  private
    FGiveIO : TGiveIO;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{Создание компонента TGiveIO}
procedure TForm1.FormCreate(Sender: TObject);
begin
 FGiveIO:= TGiveIO.Create;
end;

{Уничтожение компонента TGiveIO}
procedure TForm1.FormDestroy(Sender: TObject);
begin
 FGiveIO.Free;
end;

{Тестовая кнопка обращения к базовому COM-порту}
procedure TForm1.btnTestClick(Sender: TObject);
var Result : Byte;
begin
 asm
  mov dx,$3F8
  in al,dx       
  mov Result,al
 end;
end;

{Регистрация сервиса в реестре и старт}
procedure TForm1.btnLoadClick(Sender: TObject);
begin
 FGiveIO.CreateService(ExtractFilePath(ParamStr(0)));
 FGiveIO.StartService;
end;

{Останов сервиса и удаление из реестра}
procedure TForm1.btnUnloadClick(Sender: TObject);
begin
 FGiveIO.StopService;
 FGiveIO.RemoveService;
end;

{Получить доступ к портам для текущего процесса}
procedure TForm1.btnGiveCurrClick(Sender: TObject);
begin
 FGiveIO.GiveIoForCurrentProcess;
end;

{Запустить другой процесс (программу) и предоставить}
{ему доступ к портам}
procedure TForm1.btnExecClick(Sender: TObject);
var si : STARTUPINFO; pi : PROCESS_INFORMATION;
begin
 ZeroMemory(@si, sizeof(si));
 si.cb:= sizeof(si);

 if not CreateProcess(nil, PChar(ExeName.Text), nil, nil, False,
          0, nil, nil, si, pi) then begin
  MessageDlg('Ошибка запуска программы', mtError, [mbOK], 0);
  Exit;
 End;

 FGiveIO.GiveIoForProcess(pi.dwProcessId);
end;

end.
