source: cprs/branches/GUI-config/BDK32/Samples/RPCBroker/SilentSignOn/fXWBAVCodes.pas@ 798

Last change on this file since 798 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility

File size: 3.2 KB
Line 
1unit fXWBAVCodes;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, Trpcb, RpcSLogin, Menus, frmVistAAbout;
8
9type
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
46var
47 Form1: TForm1;
48 Login: TVistaLogin;
49
50implementation
51
52{$R *.DFM}
53
54procedure TForm1.btnConnectClick(Sender: TObject);
55var
56 NChars: Cardinal;
57 NameBuffer: PChar;
58begin
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;
111end;
112
113procedure TForm1.btnExitClick(Sender: TObject);
114begin
115 halt;
116end;
117
118procedure TForm1.mnuFileExitClick(Sender: TObject);
119begin
120 halt;
121end;
122
123procedure TForm1.mnuHelpAboutClick(Sender: TObject);
124begin
125 ShowAboutBox;
126end;
127
128end.
129
Note: See TracBrowser for help on using the repository browser.