source: cprs/branches/HealthSevak-CPRS/BDK50/BDK32_P50/Source/RpcSlogin.pas

Last change on this file was 1691, checked in by healthsevak, 9 years ago

Committing the files for first time to this new branch

File size: 10.3 KB
RevLine 
[1691]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, Joel Ivey
6 Description: Silent Login functionality.
7 Current Release: Version 1.1 Patch 47 (Jun. 17, 2008))
8*************************************************************** }
9
10unit RpcSLogin;
11
12interface
13
14Uses
15Sysutils, Classes, Messages, WinProcs, IniFiles,
16Dialogs, Registry,
17trpcb, ccowrpcbroker;
18
19
20{------ TVistaSession------} //hold attributes of a session {p13}
21{TVistaSession = class(TObject)
22private
23 FServerIPAddress: string;
24 FDateTimeLogin: String;
25 FPollingInterval: integer;
26public
27 property ServerIPAddresss: String;
28 property DateTimeLogin: String;
29 property PollingInterval (BAT): integer;
30 procedure CreateHandle;
31 function ValidateHandle;
32end; }
33
34function SilentLogIn(SLBroker: TRPCBroker): boolean;
35procedure GetUserInfo(ConnectedBroker: TRPCBroker);
36procedure GetSessionInfo(ConnectedBroker: TRPCBroker);
37// 080620 added WindowType argument to StartProgSLogin with SW_NORMAL as default
38// to allow SSH startup to specify a minimized window
39//procedure StartProgSLogin(const ProgLine: String; ConnectedBroker: TRPCBroker);
40procedure StartProgSLogin(const ProgLine: String; ConnectedBroker: TRPCBroker; WindowType: Integer = SW_SHOWNORMAL);
41function CheckCmdLine(SLBroker: TRPCBroker): Boolean;
42
43implementation
44
45uses wsockc, loginfrm, rpcberr, seldiv, hash;
46
47//validate a/v codes
48function ValidAVCodes(SLBroker: TRPCBroker): boolean;
49begin
50 try
51 with SLBroker do
52 begin
53 Param[0].Value := Encrypt(LogIn.AccessCode + ';' + LogIn.VerifyCode);
54 Param[0].PType := literal;
55 RemoteProcedure := 'XUS AV CODE';
56 Call;
57 if Results[0] > '0' then
58 begin
59 Login.DUZ := Results[0];
60 Result := True;
61 end
62 else
63 begin
64 Result := False;
65 if Results[2] = '1' then Login.ErrorText := 'Expired Verify Code' //vcode needs changing;
66 else if Results[0] = '0' then Login.ErrorText :='Invalid Access/Verify Codes' //no valid DUZ returned;
67 else Login.ErrorText := Results[3];
68 end;
69 end;
70 except
71 raise
72 end;
73end;
74
75//validate application Handle
76function ValidAppHandle(SLBroker: TRPCBroker): boolean;
77begin
78 Result := False;
79 try
80 with SLBroker do
81 begin
82 Param[0].Value := SLBroker.Login.LogInHandle;
83 Param[0].PType := literal;
84 RemoteProcedure := 'XUS AV CODE';
85 Call;
86// if StrToInt(SLBroker.Results[0]) > 0 then // JLI 050510
87// if Pos(SLBroker.Results[0][1],'123456789') > 0 then
88 if Pos(Copy(SLBroker.Results[0],1,1),'123456789') > 0 then
89 begin
90 Login.DUZ := Results[0];
91 Result := True;
92 end
93 else if Results[2] = '1' then Login.ErrorText := 'Expired Verify Code' //vcode needs changing;
94 else if Results[0] = '0' then Login.ErrorText :='Invalid Access/Verify Codes' //no valid DUZ returned;
95 else Login.ErrorText := Results[3];
96 end;
97 except
98 raise
99 end;
100end;
101
102function ValidNTToken(SLBroker: TRPCBroker): boolean;
103begin
104 Result := False;
105end;
106
107{IF 2, PASS CONTROL TO AUTHENTICATION PROXY - WHAT DOES IT NEED? }
108
109{:
110This function is used to initiate a silent login with the RPCBroker. It uses the information
111stored in the Login property of the TRPCBroker to make the connection.
112}
113function SilentLogIn(SLBroker: TRPCBroker): boolean;
114begin
115 Result := False;
116 //determine if signon is needed
117 try
118 with SLBroker do begin
119 RemoteProcedure := 'XUS SIGNON SETUP';
120 Call;
121 SLBroker.Login.IsProductionAccount := False;
122 SLBroker.Login.DomainName := '';
123 if SLBroker.Results.Count > 7 then
124 begin
125 SLBroker.Login.DomainName := SLBroker.Results[6];
126 if SLBroker.Results[7] = '1' then
127 SLBroker.Login.IsProductionAccount := True;
128 end;
129 if Results.Count > 5 then //Server sent auto signon info.
130 if SLBroker.Results[5] = '1' then //User already logged in
131 begin
132 Result := True;
133 GetUserInfo(SLBroker);
134 exit;
135 end;
136 if Login.Mode = lmAVCodes then //Access & Verify codes authentication
137 if ValidAVCodes(SLBroker) then Result := True;
138 if Login.Mode = lmAppHandle then
139 if ValidAppHandle(SLBroker)then Result := True;
140 if Login.Mode = lmNTToken then
141 if ValidNTToken(SLBroker) then Result := True;
142// if Result and (not (SLBroker is TCCOWRPCBroker)) then
143 IF Result and (SLBroker.Contextor = nil) then
144 begin
145 //determine if user is multidivisional - makes calls to Seldiv.
146 LogIn.MultiDivision := MultDiv(SLBroker);
147 if not LogIn.MultiDivision then
148 begin
149 Result := True;
150 exit;
151 end;
152 if LogIn.PromptDivision then
153 Result := SelectDivision(LogIn.DivList, SLBroker)
154 else if Login.Division <> '' then
155 Result := SetDiv(Login.Division, SLBroker)
156 else
157 begin
158 Result := False;
159 Login.ErrorText := 'No Division Selected';
160 end;
161 if not Result then
162 exit;
163 end;
164 if Result then
165 GetUserInfo(SLBroker);
166 end;
167 except
168 exit;
169 end;
170end;
171
172procedure GetUserInfo(ConnectedBroker: TRPCBroker); //get info for TVistaUser;
173begin
174 with ConnectedBroker do
175 begin
176 try
177 RemoteProcedure := 'XUS GET USER INFO';
178 Call;
179 if Results.Count > 0 then
180 with ConnectedBroker.User do
181 begin
182 DUZ := Results[0];
183 Name := Results[1];
184 StandardName := Results[2];
185 Division := Results[3];
186 Title := Results[4];
187 ServiceSection := Results[5];
188 Language := Results[6];
189 DTime := Results[7];
190 if Results.Count > 8 then
191 Vpid := Results[8]
192 else
193 Vpid := '';
194 end;
195 except
196 end;
197 end;
198end;
199
200procedure GetSessionInfo(ConnectedBroker: TRPCBroker); //get info for TVistaSession;
201begin
202 with ConnectedBroker do //get info for TVistaSession;
203 begin
204 try
205 RemoteProcedure := 'XWB GET SESSION INFO';
206 Call;
207 if Results.Count > 0 then
208 begin
209 {VistaSession.Create;
210 with VistaSession do
211 begin
212 DUZ := Results[0]
213 //other properties follow
214 end;}
215 end;
216 except
217 end;
218 end;
219end;
220
221{:
222This procedure can be used to start a second application and pass on the command line the data
223which would be needed to initiate a silent login using a LoginHandle value. It is assumed that
224the command line would be read using the CheckCmdLine procedure or one similar to it as the form
225for the new application was loaded. This procedure can also be used to start a non-RPCBroker
226application. If the value for ConnectedBroker is nil, the application specified in ProgLine
227will be started and any command line included in ProgLine will be passed to the application.
228}
229procedure StartProgSLogin(const ProgLine: String; ConnectedBroker: TRPCBroker; WindowType: Integer = SW_SHOWNORMAL);
230var
231 StartupInfo: TStartupInfo;
232 ProcessInfo: TProcessInformation;
233 AppHandle: String;
234 CmndLine: String;
235 //
236 currHandle1: THandle;
237begin
238 currHandle1 := GetCurrentProcess;
239 FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
240 with StartupInfo do
241 begin
242 cb := SizeOf(TStartupInfo);
243 dwFlags := STARTF_USESHOWWINDOW;
244// 080620 - removed code specific to SSH, replaced with new
245// parameter to specify window type with default of
246// SW_SHOWNORMAL
247{
248 wShowWindow := SW_SHOWNORMAL;
249 // 080618 following added to minimize SSH command box
250 if (Pos('SSH2',ProgLine) = 1) then
251 wShowWindow := SW_SHOWMINIMIZED;
252}
253 WShowWindow := WindowType;
254 end;
255 CmndLine := ProgLine;
256 if ConnectedBroker <> nil then
257 begin
258 AppHandle := GetAppHandle(ConnectedBroker);
259 CmndLine := CmndLine + ' s='+ConnectedBroker.Server + ' p='
260 + IntToStr(ConnectedBroker.ListenerPort) + ' h='
261 + AppHandle + ' d=' + ConnectedBroker.User.Division;
262 end;
263 CreateProcess(nil, PChar(CmndLine), nil, nil, False,
264 NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
265 // 080618 following added to handle closing of command box for SSH
266 CommandBoxProcessHandle := ProcessInfo.hProcess;
267 CommandBoxThreadHandle := ProcessInfo.hThread;
268 // 080618 make broker window active again, so user can type immediately
269 SetActiveWindow(currHandle1);
270end;
271
272{:
273This procedure can be used to check whether the command line contains information on the broker
274settings and can setup for a Silent Login using the LoginHandle value passed from another application.
275This procedure would normally be called within the code associated with FormCreate event. It assumes
276the Server, ListenerPort, Division, and LoginHandle values (if present) are indicated by s=, p=, d=, and
277h=, respectively. The argument is a reference to the TRPCBroker instance to be used.
278}
279function CheckCmdLine(SLBroker: TRPCBroker): Boolean;
280var
281 j: Integer;
282begin
283 with SLBroker do
284 begin
285 for j := 1 to ParamCount do // Iterate through possible command line arguments
286 begin
287 if Pos('p=',ParamStr(j)) > 0 then
288 ListenerPort := StrToInt(Copy(ParamStr(j),
289 (Pos('=',ParamStr(j))+1),length(ParamStr(j))));
290 if Pos('s=',ParamStr(j)) > 0 then
291 Server := Copy(ParamStr(j),
292 (Pos('=',ParamStr(j))+1),length(ParamStr(j)));
293 if Pos('h=',ParamStr(j)) > 0 then
294 begin
295 Login.LoginHandle := Copy(ParamStr(j),
296 (Pos('=',ParamStr(j))+1),length(ParamStr(j)));
297 if Login.LoginHandle <> '' then
298 begin
299 KernelLogin := False;
300 Login.Mode := lmAppHandle;
301 end;
302 end;
303 if Pos('d=',ParamStr(j)) > 0 then
304 Login.Division := Copy(ParamStr(j),
305 (Pos('=',ParamStr(j))+1),length(ParamStr(j)));
306 end; // for
307 if Login.Mode = lmAppHandle then
308 Connected := True; // Go ahead and make the connection
309 Result := False;
310 if Connected then
311 Result := True;
312 end; // with SLBroker
313end;
314
315
316end.
317
318
Note: See TracBrowser for help on using the repository browser.