source: cprs/branches/HealthSevak-CPRS/BDK50/BDK32_P50/Source/Loginfrm.pas@ 1797

Last change on this file since 1797 was 1691, checked in by healthsevak, 10 years ago

Committing the files for first time to this new branch
File size: 13.5 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 47 (Jun. 17, 2008))
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; overload;
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, XlfSid; // XlfSid added 051219 JLI
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 if not (LoginfrmSignonBroker.SecurityPhrase = '') then
116 begin
117 with Param[0] do // start BSE JLI 060130
118 begin
119 Value := '-35^' + Encrypt(LoginfrmSignonBroker.SecurityPhrase);
120 PType := literal;
121 end; // with // end BSE JLI 060130
122 end
123 // following lines added 051219 JLI
124 else with Param[0] do
125 begin
126 Ptype := literal;
127 Value := Encrypt(GetNTLogonSid);
128 end;
129 RemoteProcedure := 'XUS SIGNON SETUP';
130 // end of addition 051219 JLI
131 Call;
132 end;
133 except {P4}
134 frmSignon.Free; {P4} // Release jli 041104
135 exit; {P4}
136 end; {P4}
137 lblServer.Caption := LoginfrmSignonBroker.Results[0];
138 lblVolume.Caption := LoginfrmSignonBroker.Results[1];
139 lblUCI.Caption := LoginfrmSignonBroker.Results[2];
140 lblPort.Caption := LoginfrmSignonBroker.Results[3];
141 intDeviceLock := 0;
142 if LoginfrmSignonBroker.Results.Count > 5 then //Server sent single signon info.
143 if LoginfrmSignonBroker.Results[5] = '1' then //Signon not needed
144 Result := False
145 else
146 Result := True;
147 LoginfrmSignonBroker.Login.IsProductionAccount := False;
148 LoginfrmSignonBroker.Login.DomainName := '';
149 if LoginfrmSignonBroker.Results.Count > 7 then
150 begin
151 LoginfrmSignonBroker.Login.DomainName := LoginfrmSignonBroker.Results[6];
152 if LoginfrmSignonBroker.Results[7] = '1' then
153 LoginfrmSignonBroker.Login.IsProductionAccount := True;
154 end;
155 end;
156end;
157
158{--------------------- TfrmSignon.btnOkClick ---------------------
159This gets called when user presses OK button on the login form.
160Access and verify codes are transmitted as access;verify to the server.
161Server responds with a multi-purpose array where each node has some
162special meaning, which may change periodically and should be revised.
163SignonBroker.Results[0] - DUZ (0 if unsuccessful signon)
164SignonBroker.Results[1] - 0=OK 1=device lock (too many bad tries)
165SignonBroker.Results[2] - 0=verify doesn't need to be changed
166 1=verify needs changing
167SignonBroker.Results[3] - message (i.e. signon inhibited, etc.)
168SignonBroker.Results[4] - reserved
169SignonBroker.Results[5] - number of lines in greeting message
170 (currently hard set to 0) to suppress msg display
171SignonBroker.Results[6-n] - greeting message
172------------------------------------------------------------------}
173procedure TfrmSignon.btnOkClick(Sender: TObject);
174var
175 I: integer;
176begin
177 frmSignon.Tag := 0; {initialize signon flag}
178 try //P4
179 with LoginfrmSignonBroker do begin
180 with Param[0] do begin
181 Value := Encrypt(accessCode.text + ';' + verifyCode.text);
182 PType := literal;
183 end;
184 RemoteProcedure := 'XUS AV CODE';
185 Call;
186
187 {Device is locked -- too many failures}
188 if Results[1] = '1' then
189 begin
190 RPCBShowErrMsg(Results[3]);
191 Close;
192 end
193
194 {Verify code must change}
195 else if Results[2] = '1' then
196 begin
197 MessageDlg('You must change your VERIFY CODE at this time.',
198 mtWarning, [mbOK], 0); //Notify that VC must change.
199 if DoVerify then
200 frmSignon.Tag := 1; //VC changed -> OK
201 Close;
202 {Note: if VC change necessary and it wasn't made,
203 Tag remains 0 meaning unsuccessful signon.}
204 end
205
206 {Signon failed for some other reason}
207 else if Results[0] = '0' then
208 begin
209 accessCode.text := '';
210 verifyCode.text := '';
211 RPCBShowErrMsg(Results[3]);
212 accessCode.SetFocus; //Try again.
213 end
214
215 {Signon succeeded.}
216 else
217 begin
218 frmSignon.Tag := 1; {set flag that signon was good}
219 {display any server greeting messages}
220
221 if cbxChangeVerifyCode.Checked then
222 DoVerify;
223 if Results.Count > 5 then
224 begin
225 if Results[5] <> '0' then
226 begin
227 frmSignonMsg := TfrmSignonMsg.Create(Self);
228 try
229 with frmSignonMsg do begin
230 for I := 1 to StrToInt(Results[5]) do
231 mmoMsg.Lines.Add(Results[5+I]);
232 ShowApplicationAndFocusOK(Application);
233 ShowModal;
234 end;
235 finally
236 frmSignonMsg.Free; // Release; jli 041104
237 end;
238 end;
239 end;
240 Close;
241 end;
242 end;
243 except //P4
244 btnCancelClick(self); //P4
245 end; //P4
246end;
247
248procedure TfrmSignon.btnCancelClick(Sender: TObject);
249begin
250 LoginfrmSignOnBroker.Login.ErrorText := 'User Cancelled Login Process';
251 Close;
252end;
253
254procedure TfrmSignon.FormShow(Sender: TObject);
255var
256 Str: String;
257begin
258 Str := 'RPCBroker';
259 {add Configure... to system menu}
260 SysMenu := GetSystemMenu(Handle, False);
261 AppendMenu(SysMenu, MF_Enabled + MF_String + MF_Unchecked, SC_Configure,
262 '&Properties...');
263 AppendMenu(SysMenu, MF_Enabled + MF_String + MF_Unchecked, SC_About,PChar('&About '+Str));
264 with LoginfrmSignonBroker do begin
265 RemoteProcedure := 'XUS INTRO MSG';
266 lstCall(introText.Lines);
267 end;
268 OrigHelp := Application.HelpFile; // Save original helpfile.
269 Application.HelpFile := ReadRegData(HKLM, REG_BROKER, 'BrokerDr') +
270 '\clagent.hlp'; // Identify ConnectTo helpfile.
271end;
272
273procedure TfrmSignon.FormCreate(Sender: TObject);
274var
275 SignonConfiguration: TSignonConfiguration;
276begin
277 if Pos('RPCSharedBrokerSessionMgr',ParamStr(0)) > 0 then
278 IsSharedBroker := True;
279
280 if (Pos('LARGE',UpperCase(ReadRegDataDefault(HKCU, 'Control Panel\Appearance', 'Current',''))) > 0) or
281 (Screen.Width < 800) then
282 begin
283 WindowState := wsMaximized;
284 with Screen do
285 begin
286 if Width < 700 then // 640
287 IntroText.Font.Size := 9
288 else if Width < 750 then // 720
289 IntroText.Font.Size := 10
290 else if Width < 900 then // 800
291 IntroText.Font.Size := 11
292 else if Width < 1100 then // 1024
293 IntroText.Font.Size := 15
294 else if Width < 1200 then // 1152
295 IntroText.Font.Size := 16
296 else
297 IntroText.Font.Size := 19; // 1280
298 end; // with
299 end;
300
301 FormStyle := fsStayOnTop; // make form stay on top of others so it can be found
302 {adjust appearance per user's preferences}
303 SignonConfiguration := TSignonConfiguration.Create;
304 try
305 DefaultSignonConfiguration := TSignOnValues.Create;
306 DefaultSignonConfiguration.BackColor := IntroText.Color;
307 DefaultSignonConfiguration.Height := Height;
308 DefaultSignonConfiguration.Width := Width;
309 DefaultSignonConfiguration.Position := '0';
310 DefaultSignonConfiguration.Size := '0';
311 DefaultSignonConfiguration.Left := Left;
312 DefaultSignonConfiguration.Top := Top;
313 DefaultSignonConfiguration.Font := IntroText.Font;
314 DefaultSignonConfiguration.TextColor := IntroText.Font.Color;
315 DefaultSignonConfiguration.FontStyles := IntroText.Font.Style;
316 SignonDefaults.SetEqual(DefaultSignonConfiguration);
317
318
319 SignonConfiguration.ReadRegistrySettings;
320 if InitialValues.Size = '0' then
321 begin {restore defaults}
322 Width:= DefaultSignonConfiguration.Width;
323 Height := DefaultSignonConfiguration.Height;
324 end
325 else begin
326 try
327 Position := poDesigned;
328 Width := StrToInt(Piece(strSize,U,2));
329 Height := StrToInt(Piece(strSize,U,3));
330 except
331 Width:= DefaultSignonConfiguration.Width;
332 Height := DefaultSignonConfiguration.Height;
333 end;
334 end;
335
336 if InitialValues.Position = '0' then {restore defaults}
337 Position := poScreenCenter
338 else begin
339 try
340 Top:= StrToInt(Piece(strPosition,U,2));
341 Left := StrToInt(Piece(strPosition,U,3));
342 except
343 Position := poScreenCenter
344 end;
345 end;
346
347 if InitialValues.BackColor <> 0 then
348 introText.Color := InitialValues.BackColor
349 else
350 introText.Color := clWindow;
351
352 introText.Font := InitialValues.Font;
353
354 finally
355 SignonConfiguration.Free;
356 end;
357 FChngVerify := False;
358end;
359
360procedure TfrmSignon.WMSysCommand(var Message: TWMSysCommand);
361var
362 Str: String;
363 SignonConfiguration: TSignonConfiguration;
364 frmErrMsg: TfrmErrMsg;
365begin
366 if Message.CmdType = SC_Configure then
367 begin
368 if IsSharedBroker then
369 Self.WindowState := wsMinimized;
370 SignonConfiguration := TSignonConfiguration.Create;
371 try
372 ShowApplicationAndFocusOK(Application);
373 SignonConfiguration.ShowModal;
374 finally
375 SignonConfiguration.Free;
376 Self.WindowState := wsNormal;
377 end;
378 end
379 else if Message.CmdType = SC_About then
380 begin
381 frmErrMsg := TfrmErrMsg.Create(Application);
382 try
383 frmErrMsg.Caption := 'About RPCBroker';
384 Str := 'RPCBroker Version is '+RpcbiBroker.BrokerVersion;
385 frmErrMsg.mmoErrorMessage.Lines.Add(Str);
386 ShowApplicationAndFocusOK(Application);
387 frmErrMsg.ShowModal;
388 finally
389 frmErrMsg.Free;
390 end;
391 end
392 else inherited;
393end;
394
395procedure TfrmSignon.FormClose(Sender: TObject; var Action: TCloseAction);
396begin
397 if Piece(strSize,U,1) = '2' then begin
398 strSize := '2^'+IntToStr(Width)+ U + IntToStr(Height);
399 WriteRegData(HKCU, REG_SIGNON, 'SignonSiz', strSize);
400 end;
401
402 if Piece(strPosition,U,1) = '2' then begin
403 strPosition := '2^'+IntToStr(Top)+ U + IntToStr(Left);
404 WriteRegData(HKCU, REG_SIGNON, 'SignonPos', strPosition);
405 end;
406 Application.HelpFile := OrigHelp; // Restore helpfile.
407end;
408
409procedure TfrmSignon.introTextURLClick(Sender: TObject; URL: String);
410begin
411 ShellExecute(Application.Handle,'open',PChar(URL),nil,nil,SW_NORMAL);
412end;
413
414function TfrmSignon.DoVerify: Boolean;
415var
416 VCEdit1: TVCEdit;
417begin
418 VCEdit1 := TVCEdit.Create(Self);
419 try
420 VCEdit1.RPCBroker := LoginfrmSignonBroker;
421 Result := VCEdit1.ChangeVCKnowOldVC(VerifyCode.Text); //invoke VCEdit form.
422 finally
423 VCEdit1.Free;
424 end;
425end;
426
427end.
428
Note: See TracBrowser for help on using the repository browser.