Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Samples/Auto Server/AutoServer_ClientMain.pas

unit AutoServer_ClientMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  uROClient, uROClientIntf, uRORemoteService, uROBinMessage, uROWinInetHTTPChannel,
  ComCtrls, uROPoweredByRemObjectsButton,  AutoServerLibrary_Intf;

type
  TAutoServer_ClientMainForm = class(TForm)
    ROMessage: TROBinMessage;
    ROChannel: TROWinInetHTTPChannel;
    RORemoteService: TRORemoteService;
    cbShutdown: TCheckBox;
    Memo: TMemo;
    cbEnvironment: TComboBox;
    GetEnvironmentButton: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure GetEnvironmentButtonClick(Sender: TObject);
  private
    fServerHandle: cardinal;
    FAutoServerService: IAutoServerService;
    function GetAutoShutDownServer: boolean;
    procedure SetAutoShutDownServer(const Value: boolean);
    procedure FillEnvironment;
    procedure Log(AStr: string);
  public
    property AutoShutDownServer: boolean read GetAutoShutDownServer write SetAutoShutDownServer;
  end;

var
  AutoServer_ClientMainForm: TAutoServer_ClientMainForm;

implementation

uses ShellAPI;

{$R *.dfm}

procedure TAutoServer_ClientMainForm.FillEnvironment;
var
  p, buf: Pchar;
  List: TStringList;
  i: integer;
begin
  cbEnvironment.Clear;
  List := TStringList.Create;
  try
    buf := GetEnvironmentStrings;
    try
      p := buf;
      while p^ <> #0 do begin
        List.Add(p);
        inc(p, StrLen(p) + 1);
      end;
    finally
      FreeEnvironmentStrings(buf);
    end;
    for i := 0 to List.Count - 1 do
      if List.Names[i] <> '' then
        cbEnvironment.Items.Add(List.Names[i]);
    if cbEnvironment.Items.Count <> 0 then
      cbEnvironment.ItemIndex := 0;
  finally
    List.Free;
  end;
end;

procedure TAutoServer_ClientMainForm.FormCreate(Sender: TObject);
var
  serverfilename: string;
  res: integer;
begin
  fAutoServerService := (RORemoteService as IAutoServerService);
  // Locates the server window
  Log('Searching for server process ...');
  fServerHandle := FindWindow(nil, 'AutoServer - Server');

  if (fServerHandle = 0) then begin
    Log('No server found.');
    AutoShutDownServer := TRUE;

    // Starts it
    serverfilename := ExtractFilePath(Application.ExeName) + 'AutoServer.exe';
    Log('Attempting to start a server ''' + serverfilename + '''');
    Res := ShellExecute(0, 'open', PChar(serverfilename), nil, nil, SW_NORMAL);
    if res < 33 then begin
      Log(SysErrorMessage(Res));
      exit;
    end
    else
      Log('Waiting for the server to start ...');
    // Waits half a second. Not the best implementation but it's just to give an idea
    Sleep(500);

    Log('Searching for a server ...');
    fServerHandle := FindWindow(nil, 'AutoServer - Server');
    if (fServerHandle = 0) then
      Log('The server could not be started!')
    else
      Log('The server has been started successfully');
  end
  else begin
    Log('The server is up and running already');
    AutoShutDownServer := FALSE;
  end;
end;

procedure TAutoServer_ClientMainForm.FormDestroy(Sender: TObject);
begin
  if AutoShutDownServer then PostMessage(fServerHandle, WM_CLOSE, 0, 0);
end;

function TAutoServer_ClientMainForm.GetAutoShutDownServer: boolean;
begin
  result := cbShutdown.Checked;
end;

procedure TAutoServer_ClientMainForm.SetAutoShutDownServer(const Value: boolean);
begin
  cbShutdown.Checked := Value;
end;

procedure TAutoServer_ClientMainForm.FormShow(Sender: TObject);
begin
  FillEnvironment;
end;

procedure TAutoServer_ClientMainForm.Log(AStr: string);
begin
  Memo.Lines.Add(AStr);
end;

procedure TAutoServer_ClientMainForm.GetEnvironmentButtonClick(
  Sender: TObject);
var
  res: string;
begin
  Log('');
  Log('GetEnvironment');
  Log('--------------');
  Log('Sending:'#9#9 + cbEnvironment.Text);
  Res := FAutoServerService.GetEnvironment(cbEnvironment.Text);
  Log('Receiving:'#9 + Res);
end;

end.