| 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 |
|
|---|
| 10 | unit RpcSLogin;
|
|---|
| 11 |
|
|---|
| 12 | interface
|
|---|
| 13 |
|
|---|
| 14 | Uses
|
|---|
| 15 | Sysutils, Classes, Messages, WinProcs, IniFiles,
|
|---|
| 16 | Dialogs, Registry,
|
|---|
| 17 | trpcb, ccowrpcbroker;
|
|---|
| 18 |
|
|---|
| 19 |
|
|---|
| 20 | {------ TVistaSession------} //hold attributes of a session {p13}
|
|---|
| 21 | {TVistaSession = class(TObject)
|
|---|
| 22 | private
|
|---|
| 23 | FServerIPAddress: string;
|
|---|
| 24 | FDateTimeLogin: String;
|
|---|
| 25 | FPollingInterval: integer;
|
|---|
| 26 | public
|
|---|
| 27 | property ServerIPAddresss: String;
|
|---|
| 28 | property DateTimeLogin: String;
|
|---|
| 29 | property PollingInterval (BAT): integer;
|
|---|
| 30 | procedure CreateHandle;
|
|---|
| 31 | function ValidateHandle;
|
|---|
| 32 | end; }
|
|---|
| 33 |
|
|---|
| 34 | function SilentLogIn(SLBroker: TRPCBroker): boolean;
|
|---|
| 35 | procedure GetUserInfo(ConnectedBroker: TRPCBroker);
|
|---|
| 36 | procedure 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);
|
|---|
| 40 | procedure StartProgSLogin(const ProgLine: String; ConnectedBroker: TRPCBroker; WindowType: Integer = SW_SHOWNORMAL);
|
|---|
| 41 | function CheckCmdLine(SLBroker: TRPCBroker): Boolean;
|
|---|
| 42 |
|
|---|
| 43 | implementation
|
|---|
| 44 |
|
|---|
| 45 | uses wsockc, loginfrm, rpcberr, seldiv, hash;
|
|---|
| 46 |
|
|---|
| 47 | //validate a/v codes
|
|---|
| 48 | function ValidAVCodes(SLBroker: TRPCBroker): boolean;
|
|---|
| 49 | begin
|
|---|
| 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;
|
|---|
| 73 | end;
|
|---|
| 74 |
|
|---|
| 75 | //validate application Handle
|
|---|
| 76 | function ValidAppHandle(SLBroker: TRPCBroker): boolean;
|
|---|
| 77 | begin
|
|---|
| 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;
|
|---|
| 100 | end;
|
|---|
| 101 |
|
|---|
| 102 | function ValidNTToken(SLBroker: TRPCBroker): boolean;
|
|---|
| 103 | begin
|
|---|
| 104 | Result := False;
|
|---|
| 105 | end;
|
|---|
| 106 |
|
|---|
| 107 | {IF 2, PASS CONTROL TO AUTHENTICATION PROXY - WHAT DOES IT NEED? }
|
|---|
| 108 |
|
|---|
| 109 | {:
|
|---|
| 110 | This function is used to initiate a silent login with the RPCBroker. It uses the information
|
|---|
| 111 | stored in the Login property of the TRPCBroker to make the connection.
|
|---|
| 112 | }
|
|---|
| 113 | function SilentLogIn(SLBroker: TRPCBroker): boolean;
|
|---|
| 114 | begin
|
|---|
| 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;
|
|---|
| 170 | end;
|
|---|
| 171 |
|
|---|
| 172 | procedure GetUserInfo(ConnectedBroker: TRPCBroker); //get info for TVistaUser;
|
|---|
| 173 | begin
|
|---|
| 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;
|
|---|
| 198 | end;
|
|---|
| 199 |
|
|---|
| 200 | procedure GetSessionInfo(ConnectedBroker: TRPCBroker); //get info for TVistaSession;
|
|---|
| 201 | begin
|
|---|
| 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;
|
|---|
| 219 | end;
|
|---|
| 220 |
|
|---|
| 221 | {:
|
|---|
| 222 | This procedure can be used to start a second application and pass on the command line the data
|
|---|
| 223 | which would be needed to initiate a silent login using a LoginHandle value. It is assumed that
|
|---|
| 224 | the command line would be read using the CheckCmdLine procedure or one similar to it as the form
|
|---|
| 225 | for the new application was loaded. This procedure can also be used to start a non-RPCBroker
|
|---|
| 226 | application. If the value for ConnectedBroker is nil, the application specified in ProgLine
|
|---|
| 227 | will be started and any command line included in ProgLine will be passed to the application.
|
|---|
| 228 | }
|
|---|
| 229 | procedure StartProgSLogin(const ProgLine: String; ConnectedBroker: TRPCBroker; WindowType: Integer = SW_SHOWNORMAL);
|
|---|
| 230 | var
|
|---|
| 231 | StartupInfo: TStartupInfo;
|
|---|
| 232 | ProcessInfo: TProcessInformation;
|
|---|
| 233 | AppHandle: String;
|
|---|
| 234 | CmndLine: String;
|
|---|
| 235 | //
|
|---|
| 236 | currHandle1: THandle;
|
|---|
| 237 | begin
|
|---|
| 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);
|
|---|
| 270 | end;
|
|---|
| 271 |
|
|---|
| 272 | {:
|
|---|
| 273 | This procedure can be used to check whether the command line contains information on the broker
|
|---|
| 274 | settings and can setup for a Silent Login using the LoginHandle value passed from another application.
|
|---|
| 275 | This procedure would normally be called within the code associated with FormCreate event. It assumes
|
|---|
| 276 | the Server, ListenerPort, Division, and LoginHandle values (if present) are indicated by s=, p=, d=, and
|
|---|
| 277 | h=, respectively. The argument is a reference to the TRPCBroker instance to be used.
|
|---|
| 278 | }
|
|---|
| 279 | function CheckCmdLine(SLBroker: TRPCBroker): Boolean;
|
|---|
| 280 | var
|
|---|
| 281 | j: Integer;
|
|---|
| 282 | begin
|
|---|
| 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
|
|---|
| 313 | end;
|
|---|
| 314 |
|
|---|
| 315 |
|
|---|
| 316 | end.
|
|---|
| 317 |
|
|---|
| 318 |
|
|---|
