| [453] | 1 | unit fXWBAppHandle1;
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | interface
 | 
|---|
 | 4 | 
 | 
|---|
 | 5 | uses
 | 
|---|
 | 6 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 | 
|---|
 | 7 |   StdCtrls, RpcSlogin, Trpcb, RpcConf1, frmVistAAbout, Menus, ActnList;
 | 
|---|
 | 8 | 
 | 
|---|
 | 9 | type
 | 
|---|
 | 10 |   TForm1 = class(TForm)
 | 
|---|
 | 11 |     brkrRPCB: TRPCBroker;
 | 
|---|
 | 12 |     btnConnect: TButton;
 | 
|---|
 | 13 |     btnStartApp2: TButton;
 | 
|---|
 | 14 |     edtOtherProgram: TEdit;
 | 
|---|
 | 15 |     lblOtherProgram: TLabel;
 | 
|---|
 | 16 |     lblOptional: TLabel;
 | 
|---|
 | 17 |     lblWithFull: TLabel;
 | 
|---|
 | 18 |     Memo1: TMemo;
 | 
|---|
 | 19 |     btnExit: TButton;
 | 
|---|
 | 20 |     mnuMainMenu: TMainMenu;
 | 
|---|
 | 21 |     mnuFile: TMenuItem;
 | 
|---|
 | 22 |     mnuFileExit: TMenuItem;
 | 
|---|
 | 23 |     Help1: TMenuItem;
 | 
|---|
 | 24 |     mnuAbout: TMenuItem;
 | 
|---|
 | 25 |     mnuOptions: TMenuItem;
 | 
|---|
 | 26 |     OnlyOldConnection1: TMenuItem;
 | 
|---|
 | 27 |     ActionList1: TActionList;
 | 
|---|
 | 28 |     actOldConnectionOnly: TAction;
 | 
|---|
 | 29 |     actBackwardsCompatible: TAction;
 | 
|---|
 | 30 |     actDebugMode: TAction;
 | 
|---|
 | 31 |     BackwardsCompatible1: TMenuItem;
 | 
|---|
 | 32 |     DebugMode1: TMenuItem;
 | 
|---|
 | 33 |     procedure btnConnectClick(Sender: TObject);
 | 
|---|
 | 34 |     procedure btnStartApp2Click(Sender: TObject);
 | 
|---|
 | 35 |     procedure btnExitClick(Sender: TObject);
 | 
|---|
 | 36 |     procedure mnuFileExitClick(Sender: TObject);
 | 
|---|
 | 37 |     procedure mnuAboutClick(Sender: TObject);
 | 
|---|
 | 38 |     procedure actOldConnectionOnlyExecute(Sender: TObject);
 | 
|---|
 | 39 |     procedure actBackwardsCompatibleExecute(Sender: TObject);
 | 
|---|
 | 40 |     procedure actDebugModeExecute(Sender: TObject);
 | 
|---|
 | 41 |   private
 | 
|---|
 | 42 |     { Private declarations }
 | 
|---|
 | 43 |   public
 | 
|---|
 | 44 |     { Public declarations }
 | 
|---|
 | 45 |   end;
 | 
|---|
 | 46 | 
 | 
|---|
 | 47 | var
 | 
|---|
 | 48 |   Form1: TForm1;
 | 
|---|
 | 49 | 
 | 
|---|
 | 50 | implementation
 | 
|---|
 | 51 | 
 | 
|---|
 | 52 | {$R *.DFM}
 | 
|---|
 | 53 | 
 | 
|---|
 | 54 | 
 | 
|---|
 | 55 | procedure TForm1.btnConnectClick(Sender: TObject);
 | 
|---|
 | 56 | var
 | 
|---|
 | 57 |   Server, Port: String;
 | 
|---|
 | 58 | begin
 | 
|---|
 | 59 |   if btnConnect.Caption = '&Connect' then
 | 
|---|
 | 60 |   begin
 | 
|---|
 | 61 |     GetServerInfo(Server, Port);
 | 
|---|
 | 62 |     brkrRPCB.Server := Server;
 | 
|---|
 | 63 |     brkrRPCB.ListenerPort := StrToInt(Port);
 | 
|---|
 | 64 |     brkrRPCB.Connected := True;
 | 
|---|
 | 65 |     if brkrRPCB.Connected then
 | 
|---|
 | 66 |     begin
 | 
|---|
 | 67 |       btnConnect.Caption := '&Disconnect';
 | 
|---|
 | 68 |       mnuOptions.Enabled := False;
 | 
|---|
 | 69 |     end;
 | 
|---|
 | 70 |   end
 | 
|---|
 | 71 |   else
 | 
|---|
 | 72 |   begin
 | 
|---|
 | 73 |     brkrRPCB.Connected := False;
 | 
|---|
 | 74 |     btnConnect.Caption := '&Connect';
 | 
|---|
 | 75 |     mnuOptions.Enabled := True;
 | 
|---|
 | 76 |   end;
 | 
|---|
 | 77 | end;
 | 
|---|
 | 78 | 
 | 
|---|
 | 79 | procedure TForm1.btnStartApp2Click(Sender: TObject);
 | 
|---|
 | 80 | var
 | 
|---|
 | 81 |   CurDir: String;
 | 
|---|
 | 82 | begin
 | 
|---|
 | 83 |   if edtOtherProgram.Text <> '' then
 | 
|---|
 | 84 |   begin
 | 
|---|
 | 85 |     CurDir := edtOtherProgram.Text;
 | 
|---|
 | 86 |     StartProgSLogin(CurDir,nil);
 | 
|---|
 | 87 |   end
 | 
|---|
 | 88 |   else
 | 
|---|
 | 89 |   begin
 | 
|---|
 | 90 |     { Use Test2.exe and expecting it to be in the startup directory for the current application}
 | 
|---|
 | 91 |     CurDir := ExtractFilePath(ParamStr(0)) + 'XWBAppHandle2.exe';
 | 
|---|
 | 92 | 
 | 
|---|
 | 93 |     { Now start application with silent login }
 | 
|---|
 | 94 |     StartProgSLogin(CurDir, brkrRPCB);
 | 
|---|
 | 95 |   end;
 | 
|---|
 | 96 | end;
 | 
|---|
 | 97 | 
 | 
|---|
 | 98 | procedure TForm1.btnExitClick(Sender: TObject);
 | 
|---|
 | 99 | begin
 | 
|---|
 | 100 |   halt;
 | 
|---|
 | 101 | end;
 | 
|---|
 | 102 | 
 | 
|---|
 | 103 | procedure TForm1.mnuFileExitClick(Sender: TObject);
 | 
|---|
 | 104 | begin
 | 
|---|
 | 105 |   Halt;
 | 
|---|
 | 106 | end;
 | 
|---|
 | 107 | 
 | 
|---|
 | 108 | procedure TForm1.mnuAboutClick(Sender: TObject);
 | 
|---|
 | 109 | begin
 | 
|---|
 | 110 |   ShowAboutBox;
 | 
|---|
 | 111 | end;
 | 
|---|
 | 112 | 
 | 
|---|
 | 113 | procedure TForm1.actOldConnectionOnlyExecute(Sender: TObject);
 | 
|---|
 | 114 | begin
 | 
|---|
 | 115 |   if actOldConnectionOnly.Checked then
 | 
|---|
 | 116 |   begin
 | 
|---|
 | 117 |     actOldConnectionOnly.Checked := False;
 | 
|---|
 | 118 |     brkrRPCB.OldConnectionOnly := False;
 | 
|---|
 | 119 |   end
 | 
|---|
 | 120 |   else
 | 
|---|
 | 121 |   begin
 | 
|---|
 | 122 |     actOldConnectionOnly.Checked := True;
 | 
|---|
 | 123 |     brkrRPCB.OldConnectionOnly := True;
 | 
|---|
 | 124 |   end;
 | 
|---|
 | 125 | end;
 | 
|---|
 | 126 | 
 | 
|---|
 | 127 | procedure TForm1.actBackwardsCompatibleExecute(Sender: TObject);
 | 
|---|
 | 128 | begin
 | 
|---|
 | 129 |   if actBackwardsCompatible.Checked then
 | 
|---|
 | 130 |   begin
 | 
|---|
 | 131 |     actBackwardsCompatible.Checked := False;
 | 
|---|
 | 132 |     brkrRPCB.IsBackwardCompatibleConnection := False;
 | 
|---|
 | 133 |   end
 | 
|---|
 | 134 |   else
 | 
|---|
 | 135 |   begin
 | 
|---|
 | 136 |     brkrRPCB.IsBackwardCompatibleConnection := True;
 | 
|---|
 | 137 |     actBackwardsCompatible.Checked := True;
 | 
|---|
 | 138 |   end;
 | 
|---|
 | 139 | end;
 | 
|---|
 | 140 | 
 | 
|---|
 | 141 | procedure TForm1.actDebugModeExecute(Sender: TObject);
 | 
|---|
 | 142 | begin
 | 
|---|
 | 143 |   if actDebugMode.Checked then
 | 
|---|
 | 144 |   begin
 | 
|---|
 | 145 |     actDebugMode.Checked := False;
 | 
|---|
 | 146 |     brkrRPCB.DebugMode := False;
 | 
|---|
 | 147 |   end
 | 
|---|
 | 148 |   else
 | 
|---|
 | 149 |   begin
 | 
|---|
 | 150 |     brkrRPCB.DebugMode := True;
 | 
|---|
 | 151 |     actDebugMode.Checked := True;
 | 
|---|
 | 152 |   end;
 | 
|---|
 | 153 | end;
 | 
|---|
 | 154 | 
 | 
|---|
 | 155 | end.
 | 
|---|