source: cprs/branches/GUI-config/BDK32/Source/Loginfrm.pas@ 881

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

New WorldVistA Config Utility
File size: 12.9 KB
Line 
1{ **************************************************************
2 Package: XWB - Kernel RPCBroker
3 Date Created: Sept 18, 1997 (Version 1.1)
4 Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
5 Developers: Danila Manapsal, Don Craven, Joel Ivey
6 Description: Code supportin Login form.
7 Current Release: Version 1.1 Patch 40 (January 7, 2005))
8*************************************************************** }
9
10{**************************************************
11ver. 1.1.4 1/6/99 (DCM)
12
13XWB*1.1*4 adds a try-except block in SetUpSignOn to close
14login form when the server job times out. Also adds a try-
15except block in btnOkClick in order to cancel the action
16if the server job times out. Danila
17
18ver. 1.1.11 9/13/99
19XWB*1.1*11 deleted obsolete code. DCM (9/13/99)
20**********************************************************}
21unit Loginfrm;
22
23interface
24
25uses
26 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
27 Forms, Dialogs, StdCtrls, XWBut1, ExtCtrls, Buttons,
28 Hash, MFunStr, Trpcb, SgnonCnf, frmSignonMessage, ShellApi,
29 Windows, XWBRich20{, ActiveX}; //, {OleServer;}
30
31{ TODO : remove units from directory: APi, xuesap_TLB, fRPCBTimer, fConfirmMapping, fESSOConf }
32
33type
34 TfrmSignon = class(TForm)
35 Panel1: TPanel;
36 Panel7: TPanel;
37 Panel8: TPanel;
38 Label1: TLabel;
39 Label2: TLabel;
40 verifyCode: TEdit;
41 accessCode: TEdit;
42 btnOk: TBitBtn;
43 btnCancel: TBitBtn;
44 Image1: TImage;
45 Bevel1: TBevel;
46 Bevel2: TBevel;
47 Bevel3: TBevel;
48 Bevel4: TBevel;
49 Bevel5: TBevel;
50 Label3: TLabel;
51 Label4: TLabel;
52 Label5: TLabel;
53 Label6: TLabel;
54 lblServer: TLabel;
55 lblVolume: TLabel;
56 lblUCI: TLabel;
57 lblPort: TLabel;
58 introText: TXWBRichEdit;
59 cbxChangeVerifyCode: TCheckBox;
60 RpcbiBroker: TRPCBroker;
61 procedure btnOkClick(Sender: TObject);
62 procedure btnCancelClick(Sender: TObject);
63 procedure FormShow(Sender: TObject);
64 procedure FormCreate(Sender: TObject);
65 procedure FormClose(Sender: TObject; var Action: TCloseAction);
66 procedure introTextURLClick(Sender: TObject; URL: String);
67 private
68 FChngVerify: Boolean; // indicates whether user has requested changing verify code
69 OrigHelp : String; //Help filename of calling application.
70 function DoVerify: Boolean;
71 procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
72 public
73 DefaultSignonConfiguration: TSignonValues;
74public
75end;
76
77procedure PrepareSignonForm(AppBroker: TRPCBroker);
78function SetUpSignOn : Boolean;
79
80var
81 frmSignon: TfrmSignon;
82 intDeviceLock: integer;
83 LoginfrmSignOnBroker: TRPCBroker;
84
85Const
86 SC_Configure = 1;
87 SC_About = 2;
88
89implementation
90
91
92uses
93 RpcSlogin, VCEdit, fRPCBErrMsg, RpcConf1;
94
95var
96 SysMenu: HMenu;
97
98{$R *.DFM}
99
100procedure PrepareSignonForm(AppBroker: TRPCBroker);
101begin
102 LoginfrmSignonBroker := AppBroker;
103end;
104
105function SetUpSignOn : Boolean;
106begin
107 Result := True; //By default Signon is needed.
108 if LoginfrmSignonBroker = nil then LoginfrmSignonBroker := frmSignon.RpcbiBroker;
109 {SignonBroker superseeds RpcbiBroker}
110 with frmSignon do
111 begin
112 try
113 with LoginfrmSignonBroker do
114 begin
115 RemoteProcedure := 'XUS SIGNON SETUP';
116 Call;
117 end;
118 except {P4}
119 frmSignon.Free; {P4} // Release jli 041104
120 exit; {P4}
121 end; {P4}
122 lblServer.Caption := LoginfrmSignonBroker.Results[0];
123 lblVolume.Caption := LoginfrmSignonBroker.Results[1];
124 lblUCI.Caption := LoginfrmSignonBroker.Results[2];
125 lblPort.Caption := LoginfrmSignonBroker.Results[3];
126 intDeviceLock := 0;
127 if LoginfrmSignonBroker.Results.Count > 5 then //Server sent single signon info.
128 if LoginfrmSignonBroker.Results[5] = '1' then //Signon not needed
129 Result := False
130 else
131 Result := True;
132 LoginfrmSignonBroker.Login.IsProductionAccount := False;
133 LoginfrmSignonBroker.Login.DomainName := '';
134 if LoginfrmSignonBroker.Results.Count > 7 then
135 begin
136 LoginfrmSignonBroker.Login.DomainName := LoginfrmSignonBroker.Results[6];
137 if LoginfrmSignonBroker.Results[7] = '1' then
138 LoginfrmSignonBroker.Login.IsProductionAccount := True;
139 end;
140 end;
141end;
142
143{--------------------- TfrmSignon.btnOkClick ---------------------
144This gets called when user presses OK button on the login form.
145Access and verify codes are transmitted as access;verify to the server.
146Server responds with a multi-purpose array where each node has some
147special meaning, which may change periodically and should be revised.
148SignonBroker.Results[0] - DUZ (0 if unsuccessful signon)
149SignonBroker.Results[1] - 0=OK 1=device lock (too many bad tries)
150SignonBroker.Results[2] - 0=verify doesn't need to be changed
151 1=verify needs changing
152SignonBroker.Results[3] - message (i.e. signon inhibited, etc.)
153SignonBroker.Results[4] - reserved
154SignonBroker.Results[5] - number of lines in greeting message
155 (currently hard set to 0) to suppress msg display
156SignonBroker.Results[6-n] - greeting message
157------------------------------------------------------------------}
158procedure TfrmSignon.btnOkClick(Sender: TObject);
159var
160 I: integer;
161begin
162 frmSignon.Tag := 0; {initialize signon flag}
163 try //P4
164 with LoginfrmSignonBroker do begin
165 with Param[0] do begin
166 Value := Encrypt(accessCode.text + ';' + verifyCode.text);
167 PType := literal;
168 end;
169 RemoteProcedure := 'XUS AV CODE';
170 Call;
171
172 {Device is locked -- too many failures}
173 if Results[1] = '1' then
174 begin
175 RPCBShowErrMsg(Results[3]);
176 Close;
177 end
178
179 {Verify code must change}
180 else if Results[2] = '1' then
181 begin
182 MessageDlg('You must change your VERIFY CODE at this time.',
183 mtWarning, [mbOK], 0); //Notify that VC must change.
184 if DoVerify then
185 frmSignon.Tag := 1; //VC changed -> OK
186 Close;
187 {Note: if VC change necessary and it wasn't made,
188 Tag remains 0 meaning unsuccessful signon.}
189 end
190
191 {Signon failed for some other reason}
192 else if Results[0] = '0' then
193 begin
194 accessCode.text := '';
195 verifyCode.text := '';
196 RPCBShowErrMsg(Results[3]);
197 accessCode.SetFocus; //Try again.
198 end
199
200 {Signon succeeded.}
201 else
202 begin
203 frmSignon.Tag := 1; {set flag that signon was good}
204 {display any server greeting messages}
205
206 if cbxChangeVerifyCode.Checked then
207 DoVerify;
208 if Results.Count > 5 then
209 begin
210 if Results[5] <> '0' then
211 begin
212 frmSignonMsg := TfrmSignonMsg.Create(Self);
213 try
214 with frmSignonMsg do begin
215 for I := 1 to StrToInt(Results[5]) do
216 mmoMsg.Lines.Add(Results[5+I]);
217 ShowApplicationAndFocusOK(Application);
218 ShowModal;
219 end;
220 finally
221 frmSignonMsg.Free; // Release; jli 041104
222 end;
223 end;
224 end;
225 Close;
226 end;
227 end;
228 except //P4
229 btnCancelClick(self); //P4
230 end; //P4
231end;
232
233procedure TfrmSignon.btnCancelClick(Sender: TObject);
234begin
235 LoginfrmSignOnBroker.Login.ErrorText := 'User Cancelled Login Process';
236 Close;
237end;
238
239procedure TfrmSignon.FormShow(Sender: TObject);
240var
241 Str: String;
242begin
243 Str := 'RPCBroker';
244 {add Configure... to system menu}
245 SysMenu := GetSystemMenu(Handle, False);
246 AppendMenu(SysMenu, MF_Enabled + MF_String + MF_Unchecked, SC_Configure,
247 '&Properties...');
248 AppendMenu(SysMenu, MF_Enabled + MF_String + MF_Unchecked, SC_About,PChar('&About '+Str));
249 with LoginfrmSignonBroker do begin
250 RemoteProcedure := 'XUS INTRO MSG';
251 lstCall(introText.Lines);
252 end;
253 OrigHelp := Application.HelpFile; // Save original helpfile.
254 Application.HelpFile := ReadRegData(HKLM, REG_BROKER, 'BrokerDr') +
255 '\clagent.hlp'; // Identify ConnectTo helpfile.
256end;
257
258procedure TfrmSignon.FormCreate(Sender: TObject);
259var
260 SignonConfiguration: TSignonConfiguration;
261begin
262 if Pos('RPCSharedBrokerSessionMgr',ParamStr(0)) > 0 then
263 IsSharedBroker := True;
264
265 if (Pos('LARGE',UpperCase(ReadRegDataDefault(HKCU, 'Control Panel\Appearance', 'Current',''))) > 0) or
266 (Screen.Width < 800) then
267 begin
268 WindowState := wsMaximized;
269 with Screen do
270 begin
271 if Width < 700 then // 640
272 IntroText.Font.Size := 9
273 else if Width < 750 then // 720
274 IntroText.Font.Size := 10
275 else if Width < 900 then // 800
276 IntroText.Font.Size := 11
277 else if Width < 1100 then // 1024
278 IntroText.Font.Size := 15
279 else if Width < 1200 then // 1152
280 IntroText.Font.Size := 16
281 else
282 IntroText.Font.Size := 19; // 1280
283 end; // with
284 end;
285
286 FormStyle := fsStayOnTop; // make form stay on top of others so it can be found
287 {adjust appearance per user's preferences}
288 SignonConfiguration := TSignonConfiguration.Create;
289 try
290 DefaultSignonConfiguration := TSignOnValues.Create;
291 DefaultSignonConfiguration.BackColor := IntroText.Color;
292 DefaultSignonConfiguration.Height := Height;
293 DefaultSignonConfiguration.Width := Width;
294 DefaultSignonConfiguration.Position := '0';
295 DefaultSignonConfiguration.Size := '0';
296 DefaultSignonConfiguration.Left := Left;
297 DefaultSignonConfiguration.Top := Top;
298 DefaultSignonConfiguration.Font := IntroText.Font;
299 DefaultSignonConfiguration.TextColor := IntroText.Font.Color;
300 DefaultSignonConfiguration.FontStyles := IntroText.Font.Style;
301 SignonDefaults.SetEqual(DefaultSignonConfiguration);
302
303
304 SignonConfiguration.ReadRegistrySettings;
305 if InitialValues.Size = '0' then
306 begin {restore defaults}
307 Width:= DefaultSignonConfiguration.Width;
308 Height := DefaultSignonConfiguration.Height;
309 end
310 else begin
311 try
312 Position := poDesigned;
313 Width := StrToInt(Piece(strSize,U,2));
314 Height := StrToInt(Piece(strSize,U,3));
315 except
316 Width:= DefaultSignonConfiguration.Width;
317 Height := DefaultSignonConfiguration.Height;
318 end;
319 end;
320
321 if InitialValues.Position = '0' then {restore defaults}
322 Position := poScreenCenter
323 else begin
324 try
325 Top:= StrToInt(Piece(strPosition,U,2));
326 Left := StrToInt(Piece(strPosition,U,3));
327 except
328 Position := poScreenCenter
329 end;
330 end;
331
332 if InitialValues.BackColor <> 0 then
333 introText.Color := InitialValues.BackColor
334 else
335 introText.Color := clWindow;
336
337 introText.Font := InitialValues.Font;
338
339 finally
340 SignonConfiguration.Free;
341 end;
342 FChngVerify := False;
343end;
344
345procedure TfrmSignon.WMSysCommand(var Message: TWMSysCommand);
346var
347 Str: String;
348 SignonConfiguration: TSignonConfiguration;
349 frmErrMsg: TfrmErrMsg;
350begin
351 if Message.CmdType = SC_Configure then
352 begin
353 if IsSharedBroker then
354 Self.WindowState := wsMinimized;
355 SignonConfiguration := TSignonConfiguration.Create;
356 try
357 ShowApplicationAndFocusOK(Application);
358 SignonConfiguration.ShowModal;
359 finally
360 SignonConfiguration.Free;
361 Self.WindowState := wsNormal;
362 end;
363 end
364 else if Message.CmdType = SC_About then
365 begin
366 frmErrMsg := TfrmErrMsg.Create(Application);
367 try
368 frmErrMsg.Caption := 'About RPCBroker';
369 Str := 'RPCBroker Version is '+RpcbiBroker.BrokerVersion;
370 frmErrMsg.mmoErrorMessage.Lines.Add(Str);
371 ShowApplicationAndFocusOK(Application);
372 frmErrMsg.ShowModal;
373 finally
374 frmErrMsg.Free;
375 end;
376 end
377 else inherited;
378end;
379
380procedure TfrmSignon.FormClose(Sender: TObject; var Action: TCloseAction);
381begin
382 if Piece(strSize,U,1) = '2' then begin
383 strSize := '2^'+IntToStr(Width)+ U + IntToStr(Height);
384 WriteRegData(HKCU, REG_SIGNON, 'SignonSiz', strSize);
385 end;
386
387 if Piece(strPosition,U,1) = '2' then begin
388 strPosition := '2^'+IntToStr(Top)+ U + IntToStr(Left);
389 WriteRegData(HKCU, REG_SIGNON, 'SignonPos', strPosition);
390 end;
391 Application.HelpFile := OrigHelp; // Restore helpfile.
392end;
393
394procedure TfrmSignon.introTextURLClick(Sender: TObject; URL: String);
395begin
396 ShellExecute(Application.Handle,'open',PChar(URL),nil,nil,SW_NORMAL);
397end;
398
399function TfrmSignon.DoVerify: Boolean;
400var
401 VCEdit1: TVCEdit;
402begin
403 VCEdit1 := TVCEdit.Create(Self);
404 try
405 VCEdit1.RPCBroker := LoginfrmSignonBroker;
406 Result := VCEdit1.ChangeVCKnowOldVC(VerifyCode.Text); //invoke VCEdit form.
407 finally
408 VCEdit1.Free;
409 end;
410end;
411
412end.
413
Note: See TracBrowser for help on using the repository browser.