| 1 | unit fXWBAVCodes;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses
|
|---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|---|
| 7 | StdCtrls, Trpcb, RpcSLogin, Menus, frmVistAAbout;
|
|---|
| 8 |
|
|---|
| 9 | type
|
|---|
| 10 | TForm1 = class(TForm)
|
|---|
| 11 | edtDUZ: TEdit;
|
|---|
| 12 | edtName: TEdit;
|
|---|
| 13 | edtDTime: TEdit;
|
|---|
| 14 | edtUserName: TEdit;
|
|---|
| 15 | btnConnect: TButton;
|
|---|
| 16 | edtAccessCode: TEdit;
|
|---|
| 17 | edtVerifyCode: TEdit;
|
|---|
| 18 | lblAccessCode: TLabel;
|
|---|
| 19 | lblVerifyCode: TLabel;
|
|---|
| 20 | btnExit: TButton;
|
|---|
| 21 | lblDUZ: TLabel;
|
|---|
| 22 | lblName: TLabel;
|
|---|
| 23 | lblDTime: TLabel;
|
|---|
| 24 | lblUserName: TLabel;
|
|---|
| 25 | edtServer: TEdit;
|
|---|
| 26 | edtListenerPort: TEdit;
|
|---|
| 27 | lblServer: TLabel;
|
|---|
| 28 | lblListenerPort: TLabel;
|
|---|
| 29 | Memo1: TMemo;
|
|---|
| 30 | MainMenu1: TMainMenu;
|
|---|
| 31 | mnuFile: TMenuItem;
|
|---|
| 32 | mnuFileExit: TMenuItem;
|
|---|
| 33 | mnuHelp: TMenuItem;
|
|---|
| 34 | mnuHelpAbout: TMenuItem;
|
|---|
| 35 | brkrRPCB: TRPCBroker;
|
|---|
| 36 | procedure btnConnectClick(Sender: TObject);
|
|---|
| 37 | procedure btnExitClick(Sender: TObject);
|
|---|
| 38 | procedure mnuFileExitClick(Sender: TObject);
|
|---|
| 39 | procedure mnuHelpAboutClick(Sender: TObject);
|
|---|
| 40 | private
|
|---|
| 41 | { Private declarations }
|
|---|
| 42 | public
|
|---|
| 43 | { Public declarations }
|
|---|
| 44 | end;
|
|---|
| 45 |
|
|---|
| 46 | var
|
|---|
| 47 | Form1: TForm1;
|
|---|
| 48 | Login: TVistaLogin;
|
|---|
| 49 |
|
|---|
| 50 | implementation
|
|---|
| 51 |
|
|---|
| 52 | {$R *.DFM}
|
|---|
| 53 |
|
|---|
| 54 | procedure TForm1.btnConnectClick(Sender: TObject);
|
|---|
| 55 | var
|
|---|
| 56 | NChars: Cardinal;
|
|---|
| 57 | NameBuffer: PChar;
|
|---|
| 58 | begin
|
|---|
| 59 | if btnConnect.Caption = 'Connect' then
|
|---|
| 60 | begin
|
|---|
| 61 | { check data there for silent login }
|
|---|
| 62 | if (edtAccessCode.Text = '') or
|
|---|
| 63 | (edtVerifyCode.Text = '') or
|
|---|
| 64 | (edtServer.Text = '') or
|
|---|
| 65 | (edtListenerPort.Text = '') then
|
|---|
| 66 | ShowMessage('The four Bold edit boxes must be filled in before the connection can be made.')
|
|---|
| 67 | else
|
|---|
| 68 | begin
|
|---|
| 69 | { set up for silent login }
|
|---|
| 70 | with BrkrRPCB do
|
|---|
| 71 | begin
|
|---|
| 72 | Login.AccessCode := edtAccessCode.Text;
|
|---|
| 73 | Login.VerifyCode := edtVerifyCode.Text;
|
|---|
| 74 | Server := edtServer.Text;
|
|---|
| 75 | ListenerPort := StrToInt(edtListenerPort.Text);
|
|---|
| 76 | KernelLogin := False;
|
|---|
| 77 | Login.Mode := lmAVCodes;
|
|---|
| 78 | Login.PromptDivision := True;
|
|---|
| 79 | Connected := True;
|
|---|
| 80 |
|
|---|
| 81 | if Connected = True then
|
|---|
| 82 | begin
|
|---|
| 83 | GetUserInfo(brkrRPCB);
|
|---|
| 84 | edtDUZ.Text := User.DUZ;
|
|---|
| 85 | edtName.Text := User.Name;
|
|---|
| 86 | edtDTime.Text := User.DTime;
|
|---|
| 87 |
|
|---|
| 88 | { Get local username as well }
|
|---|
| 89 | NChars := 0;
|
|---|
| 90 | GetUserName(nil,NChars);
|
|---|
| 91 | NameBuffer := StrAlloc(NChars);
|
|---|
| 92 | if GetUserName(NameBuffer, NChars) then
|
|---|
| 93 | edtUserName.Text := StrPas(NameBuffer)
|
|---|
| 94 | else
|
|---|
| 95 | edtUserName.Text := 'Can''t get name';
|
|---|
| 96 | btnConnect.Caption := 'Disconnect';
|
|---|
| 97 | btnExit.Default := True;
|
|---|
| 98 | btnConnect.Default := False;
|
|---|
| 99 | end; // if Connected = True
|
|---|
| 100 | end; // with brkrRPCB do
|
|---|
| 101 | end; // else
|
|---|
| 102 | end // if btnConnect.Caption
|
|---|
| 103 | else
|
|---|
| 104 | begin
|
|---|
| 105 | brkrRPCB.Connected := False;
|
|---|
| 106 | btnConnect.Caption := 'Connect';
|
|---|
| 107 | end;
|
|---|
| 108 | edtAccessCode.Text := '';
|
|---|
| 109 | edtVerifyCode.Text := '';
|
|---|
| 110 | Application.ProcessMessages;
|
|---|
| 111 | end;
|
|---|
| 112 |
|
|---|
| 113 | procedure TForm1.btnExitClick(Sender: TObject);
|
|---|
| 114 | begin
|
|---|
| 115 | halt;
|
|---|
| 116 | end;
|
|---|
| 117 |
|
|---|
| 118 | procedure TForm1.mnuFileExitClick(Sender: TObject);
|
|---|
| 119 | begin
|
|---|
| 120 | halt;
|
|---|
| 121 | end;
|
|---|
| 122 |
|
|---|
| 123 | procedure TForm1.mnuHelpAboutClick(Sender: TObject);
|
|---|
| 124 | begin
|
|---|
| 125 | ShowAboutBox;
|
|---|
| 126 | end;
|
|---|
| 127 |
|
|---|
| 128 | end.
|
|---|
| 129 |
|
|---|
