source: cprs/branches/GUI-config/BDK32/Source/VCEdit.pas@ 1222

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

New WorldVistA Config Utility

File size: 8.3 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: Verify Code edit dialog.
7 Current Release: Version 1.1 Patch 40 (January 7, 2005))
8*************************************************************** }
9
10unit VCEdit;
11
12interface
13
14uses
15 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
16 StdCtrls, Buttons,
17 {Broker units}
18 Trpcb, Hash;
19
20type
21 TVCEdit = class(TComponent)
22 private
23 FRPCBroker : TRPCBroker;
24 FOldVC : string;
25 FConfirmFailCnt : integer; //counts failed confirms.
26 FHelp : string;
27 FOldVCSet: Boolean; // Shows whether old code was passed in, even if NULL
28 procedure NoChange(reason : string);
29 protected
30 public
31 constructor Create(AOwner: TComponent); override;
32 destructor Destroy; override;
33 function ChangeVCKnowOldVC(strOldVC : string) : Boolean;
34 function ChangeVC : Boolean;
35 published
36 property RPCBroker : TRPCBroker read FRPCBroker write FRPCBroker;
37 end;
38
39
40
41 TfrmVCEdit = class(TForm)
42 lblOldVC: TLabel;
43 lblNewVC: TLabel;
44 lblConfirmVC: TLabel;
45 edtOldVC: TEdit;
46 edtNewVC: TEdit;
47 edtConfirmVC: TEdit;
48 btnOK: TBitBtn;
49 btnCancel: TBitBtn;
50 btnHelp: TBitBtn;
51 procedure btnOKClick(Sender: TObject);
52 procedure btnHelpClick(Sender: TObject);
53 procedure edtNewVCExit(Sender: TObject);
54 procedure edtOldVCChange(Sender: TObject);
55 protected
56 { Private declarations }
57 FVCEdit : TVCEdit; //Links form to instance of VCEdit.
58 public
59 { Public declarations }
60 end;
61
62function ChangeVerify(RPCBroker: TRPCBroker): Boolean;
63function SilentChangeVerify(RPCBroker: TRPCBroker; OldVerify, NewVerify1, NewVerify2: String; var Reason: String): Boolean;
64
65var
66 frmVCEdit: TfrmVCEdit;
67
68const
69 MAX_CONFIRM_FAIL : integer = 3;
70 U = '^';
71
72{procedure Register;}
73
74implementation
75
76{$R *.DFM}
77
78function ChangeVerify(RPCBroker: TRPCBroker): Boolean;
79var
80 VCEdit1: TVCEdit;
81begin
82// Str := '';
83 VCEdit1 := TVCEdit.Create(Application);
84 try
85 VCEdit1.RPCBroker := RPCBroker;
86 if VCEdit1.ChangeVC then //invoke VCEdit form. //VC changed.
87 Result := True
88 else
89 Result := False;
90 finally
91 VCEdit1.Free;
92 end;
93end;
94
95function SilentChangeVerify(RPCBroker: TRPCBroker; OldVerify, NewVerify1, NewVerify2: String; var Reason: String): Boolean;
96var
97 OrigContext: String;
98begin
99 Result := False;
100 Reason := '';
101 if UpperCase(OldVerify) = UpperCase(NewVerify1) then
102 Reason := 'The new code is the same as the current one.'
103 else
104 if UpperCase(NewVerify1) <> UpperCase(NewVerify2) then
105 Reason := 'The confirmation code does not match.';
106 if Reason = '' then
107 try
108 with RPCBroker do
109 begin
110 OrigContext := CurrentContext;
111 CreateContext('XUS SIGNON');
112 RemoteProcedure := 'XUS CVC';
113 Param[0].PType := literal;
114 Param[0].Value := Encrypt(UpperCase(OldVerify))
115 + U + Encrypt(UpperCase(NewVerify1))
116 + U + Encrypt(UpperCase(NewVerify2)) ;
117 Call;
118 Reason := '';
119 if Results[0] = '0' then
120 Result := True
121 else if Results.Count > 1 then
122 Reason := Results[1];
123 CreateContext(OrigContext);
124 end;
125 except
126 on E: Exception do
127 begin
128 RPCBroker.RPCBError := E.Message;
129 if Assigned(RPCBroker.OnRPCBFailure) then
130 RPCBroker.OnRPCBFailure(RPCBroker)
131 else if RPCBroker.ShowErrorMsgs = semRaise then
132 Raise;
133 end;
134 end;
135end;
136
137{------------------TVCEdit component------------------------------------}
138
139constructor TVCEDit.Create(AOwner: TComponent);
140begin
141 inherited Create(AOwner);
142 FOldVCSet := False;
143end;
144
145destructor TVCEDit.Destroy;
146begin
147 inherited Destroy;
148end;
149
150
151function TVCEdit.ChangeVCKnowOldVC(strOldVC : string) : Boolean;
152begin
153 FOldVC := strOldVC;
154 FOldVCSet := True;
155 Result := ChangeVC;
156 FOldVCSet := False; // set it back to false in case we come in again
157end;
158
159{--------------------------ChangeVC function---------------------------}
160function TVCEdit.ChangeVC : Boolean;
161var
162 OldHandle: THandle;
163begin
164 Result := False;
165 try
166 frmVCEDit := TfrmVCEDit.Create(application);
167 with frmVCEDit do
168 begin
169 FVCEdit := Self; //To link form to VCEdit instance.
170 if FOldVCSet then //If old VC known, stuff it & disable editing.
171 begin
172 edtOldVC.Color := clBtnFace;
173 edtOldVC.Enabled := False;
174 edtOldVC.Text := FOldVC;
175 end{if};
176// ShowApplicationAndFocusOK(Application);
177 OldHandle := GetForegroundWindow;
178 SetForegroundWindow(frmVCEdit.Handle);
179 if ShowModal = mrOK then //outcome of form.
180 Result := True;
181 SetForegroundWindow(OldHandle);
182 end{with};
183 frmVCEDit.Free;
184 except
185 on E: Exception do
186 begin
187 FRPCBroker.RPCBError := E.Message;
188 if Assigned(FRPCBroker.OnRPCBFailure) then
189 FRPCBroker.OnRPCBFailure(FRPCBroker)
190 else if FRPCBroker.ShowErrorMsgs = semRaise then
191 Raise;
192 end;
193 end{except};
194end;
195
196{------------------TVCEdit.NoChange-------------------------------------
197-----------Displays error messages when change fails.-------------------}
198procedure TVCEdit.NoChange(reason : string);
199begin
200 ShowMessage('Your VERIFY code was not changed.' + #13 +
201 reason + #13 );
202end;
203
204
205{-------------------------TfrmVCEdit methods-------------------------------}
206procedure TfrmVCEdit.btnOKClick(Sender: TObject);
207begin
208 with FVCEdit do
209 begin
210 if edtOldVC.Text = edtNewVC.Text then
211 begin
212 NoChange('The new code is the same as the current one.');
213 edtNewVC.Text := '';
214 edtConfirmVC.Text := '';
215 edtNewVC.SetFocus;
216 end
217 else
218 if edtNewVC.Text <> edtConfirmVC.Text then
219 begin
220 inc(FConfirmFailCnt);
221 if FConfirmFailCnt > MAX_CONFIRM_FAIL then
222 begin
223 edtNewVC.Text := '';
224 edtConfirmVC.Text := '';
225 NoChange('The confirmation code does not match.');
226 edtNewVC.SetFocus;
227 end
228 else
229 begin
230 edtConfirmVC.text := '';
231 NoChange('The confirmation code does not match. Try again.');
232 edtConfirmVC.SetFocus;
233 end;
234 end
235 else
236 with FRPCBroker do
237 begin
238 RemoteProcedure := 'XUS CVC';
239 Param[0].PType := literal;
240 Param[0].Value := Encrypt(UpperCase(edtOldVC.Text))
241 + U + Encrypt(UpperCase(edtNewVC.Text))
242 + U + Encrypt(UpperCase(edtConfirmVC.Text)) ;
243 Call;
244 if Results[0] = '0' then
245 begin
246 ShowMessage('Your VERIFY CODE has been changed');
247 ModalResult := mrOK; //Close form.
248 end
249 else
250 begin
251 if Results.Count > 1 then
252 NoChange(Results[1])
253 else
254 NoChange('');
255 edtNewVC.Text := '';
256 edtConfirmVC.Text := '';
257 edtNewVC.SetFocus;
258 end;
259 end;
260 end{with};
261end;
262
263procedure TfrmVCEdit.btnHelpClick(Sender: TObject);
264begin
265 with FVCEdit do
266 begin
267 if FHelp = '' then
268 begin
269 with FRPCBroker do
270 begin
271 RemoteProcedure := 'XUS AV HELP';
272 Call;
273 if Results.Count > 0 then
274 FHelp := Results[0];
275 FHelp := 'Enter a new verify code and then confirm it.'
276 + #13#13 + FHelp;
277 if FOldVC = '' then
278 FHelp := 'Enter your current verify code first.' + #13#10 + FHelp;
279 end{with};
280 end{if};
281 ShowMessage(FHelp);
282 end{with};
283end;
284
285procedure TfrmVCEdit.edtNewVCExit(Sender: TObject);
286begin
287 if edtNewVC.Modified then
288 begin
289 FVCEdit.FConfirmFailCnt := 0; //Reset counter.
290 edtNewVC.Modified := False;
291 end;
292end;
293
294procedure TfrmVCEdit.edtOldVCChange(Sender: TObject); //Also NewVC and ConfirmVC
295begin
296 btnOk.Default := ((edtNewVC.Text <> '') and //Update status of OK btn.
297 (edtOldVC.Text <> '') and
298 (edtConfirmVC.Text <> '') );
299end;
300
301end.
Note: See TracBrowser for help on using the repository browser.