source: cprs/trunk/BDK50/BDK32_P50/Source/Loginfrm.pas@ 1729

Last change on this file since 1729 was 1678, checked in by healthsevak, 10 years ago

Added this new version of Broker component libraries while updating the working copy to CPRS version 28
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.