source: cprs/trunk/BDK50/BDK32_P50/Source/VCEdit.pas@ 1742

Last change on this file since 1742 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: 8.2 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 47 (Jun. 17, 2008))
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 OldVerify = NewVerify1 then
102 Reason := 'The new code is the same as the current one.'
103 else
104 if NewVerify1 <> 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(OldVerify)
115 + U + Encrypt(NewVerify1)
116 + U + Encrypt(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(edtOldVC.Text)
241 + U + Encrypt(edtNewVC.Text)
242 + U + Encrypt(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.