source: cprs/trunk/BDK32/Source/RpcSLogin.pas@ 836

{ **************************************************************
        Package: XWB - Kernel RPCBroker
        Date Created: Sept 18, 1997 (Version 1.1)
        Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
        Developers: Danila Manapsal, Joel Ivey
        Description: Silent Login functionality.
        Current Release: Version 1.1 Patch 40 (January 7, 2005))
*************************************************************** }

unit RpcSLogin;

interface

Uses
Sysutils, Classes, Messages, WinProcs, IniFiles,
Dialogs, Registry,
trpcb, ccowrpcbroker;


{------ TVistaSession------}     //hold attributes of a session {p13}
{TVistaSession = class(TObject)
private
  FServerIPAddress: string;
  FDateTimeLogin: String;
  FPollingInterval: integer;
public
  property ServerIPAddresss: String;
  property DateTimeLogin: String;
  property PollingInterval (BAT): integer;
  procedure CreateHandle;
  function  ValidateHandle;
end; }

function SilentLogIn(SLBroker: TRPCBroker): boolean;
procedure GetUserInfo(ConnectedBroker: TRPCBroker);
procedure GetSessionInfo(ConnectedBroker: TRPCBroker);
procedure StartProgSLogin(const ProgLine: String; ConnectedBroker: TRPCBroker);
function CheckCmdLine(SLBroker: TRPCBroker): Boolean;

implementation

uses wsockc, loginfrm, rpcberr, seldiv, hash;

//validate a/v codes
function ValidAVCodes(SLBroker: TRPCBroker): boolean;
begin
  try
    with SLBroker do
    begin
      Param[0].Value := Encrypt(LogIn.AccessCode + ';' + LogIn.VerifyCode);
      Param[0].PType := literal;
      RemoteProcedure := 'XUS AV CODE';
      Call;
      if Results[0] > '0' then
      begin
        Login.DUZ := Results[0];
        Result := True;
      end
      else
      begin
        Result := False;
        if Results[2] = '1' then Login.ErrorText := 'Expired Verify Code' //vcode needs changing;
        else if Results[0] = '0' then Login.ErrorText :='Invalid Access/Verify Codes' //no valid DUZ returned;
        else Login.ErrorText := Results[3];
      end;
    end;
  except
    raise
  end;
end;

//validate application Handle
function ValidAppHandle(SLBroker: TRPCBroker): boolean;
begin
  Result := False;
  try
    with SLBroker do
    begin
      Param[0].Value := SLBroker.Login.LogInHandle;
      Param[0].PType := literal;
      RemoteProcedure := 'XUS AV CODE';
      Call;
      if StrToInt(SLBroker.Results[0]) > 0 then
      begin
        Login.DUZ := Results[0];
        Result := True;
      end
      else if Results[2] = '1' then Login.ErrorText := 'Expired Verify Code' //vcode needs changing;
      else if Results[0] = '0' then Login.ErrorText :='Invalid Access/Verify Codes' //no valid DUZ returned;
      else Login.ErrorText := Results[3];
    end;
  except
    raise
  end;
end;

function ValidNTToken(SLBroker: TRPCBroker): boolean;
begin
  Result := False;
end;

{IF 2, PASS CONTROL TO AUTHENTICATION PROXY - WHAT DOES IT NEED? }

{:
This function is used to initiate a silent login with the RPCBroker.  It uses the information
stored in the Login property of the TRPCBroker to make the connection.
}
function SilentLogIn(SLBroker: TRPCBroker): boolean;
begin
  Result := False;
  //determine if signon is needed
  try
    with SLBroker do begin
      RemoteProcedure := 'XUS SIGNON SETUP';
      Call;
      SLBroker.Login.IsProductionAccount := False;
      SLBroker.Login.DomainName := '';
      if SLBroker.Results.Count > 7 then
      begin
        SLBroker.Login.DomainName := SLBroker.Results[6];
        if SLBroker.Results[7] = '1' then
          SLBroker.Login.IsProductionAccount := True;
      end;
      if Results.Count > 5 then    //Server sent auto signon info.
        if SLBroker.Results[5] = '1' then   //User already logged in
        begin
          Result := True;
          GetUserInfo(SLBroker);
          exit;
        end;
      if Login.Mode = lmAVCodes then //Access & Verify codes authentication
        if ValidAVCodes(SLBroker) then Result := True;
      if Login.Mode = lmAppHandle then
        if ValidAppHandle(SLBroker)then Result := True;
      if Login.Mode = lmNTToken then
          if ValidNTToken(SLBroker) then Result := True;
      if Result and (not (SLBroker is TCCOWRPCBroker)) then
      begin
        //determine if user is multidivisional - makes calls to Seldiv.
        LogIn.MultiDivision := MultDiv(SLBroker);
        if not LogIn.MultiDivision then
          begin
          Result := True;
          exit;
          end;
        if LogIn.PromptDivision then
          Result := SelectDivision(LogIn.DivList, SLBroker)
        else if Login.Division <> '' then
          Result := SetDiv(Login.Division, SLBroker)
        else
        begin
          Result := False;
          Login.ErrorText := 'No Division Selected';
        end;
        if not Result then
          exit;
      end;
      if Result then
        GetUserInfo(SLBroker);
    end;
  except
    exit;
  end;
end;

procedure GetUserInfo(ConnectedBroker: TRPCBroker); //get info for TVistaUser;
begin
  with ConnectedBroker do
  begin
    try
    RemoteProcedure := 'XUS GET USER INFO';
    Call;
    if Results.Count > 0 then
      with ConnectedBroker.User do
        begin
        DUZ := Results[0];
        Name := Results[1];
        StandardName := Results[2];
        Division := Results[3];
        Title := Results[4];
        ServiceSection := Results[5];
        Language := Results[6];
        DTime := Results[7];
        if Results.Count > 8 then
          Vpid := Results[8]
         else
          Vpid := '';
        end;
    except
    end;
  end;
end;

procedure GetSessionInfo(ConnectedBroker: TRPCBroker); //get info for TVistaSession;
begin
  with ConnectedBroker do   //get info for TVistaSession;
  begin
    try
    RemoteProcedure := 'XWB GET SESSION INFO';
    Call;
    if Results.Count > 0 then
      begin
      {VistaSession.Create;
      with VistaSession do
        begin
        DUZ := Results[0]
        //other properties follow
        end;}
      end;
    except
    end;
    end;
end;

{:
This procedure can be used to start a second application and pass on the command line the data
which would be needed to initiate a silent login using a LoginHandle value.  It is assumed that
the command line would be read using the CheckCmdLine procedure or one similar to it as the form
for the new application was loaded.  This procedure can also be used to start a non-RPCBroker 
application. If the value for ConnectedBroker is nil, the application specified in ProgLine 
will be started and any command line included in ProgLine will be passed to the application.
}
procedure StartProgSLogin(const ProgLine: String; ConnectedBroker: TRPCBroker);
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  AppHandle: String;
  CmndLine: String;
begin
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  with StartupInfo do
  begin
    cb := SizeOf(TStartupInfo);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := SW_SHOWNORMAL;
  end;
  CmndLine := ProgLine;
  if ConnectedBroker <> nil then
  begin
    AppHandle := GetAppHandle(ConnectedBroker);
    CmndLine := CmndLine + ' s='+ConnectedBroker.Server + ' p=' 
                         + IntToStr(ConnectedBroker.ListenerPort) + ' h=' 
                         + AppHandle + ' d=' + ConnectedBroker.User.Division;
  end;
  CreateProcess(nil, PChar(CmndLine), nil, nil, False,
      NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
end;

{:
This procedure can be used to check whether the command line contains information on the broker 
settings and can setup for a Silent Login using the LoginHandle value passed from another application.  
This procedure would normally be called within the code associated with FormCreate event.  It assumes
the Server, ListenerPort, Division, and LoginHandle values (if present) are indicated by s=, p=, d=, and
h=, respectively.  The argument is a reference to the TRPCBroker instance to be used.
}
function CheckCmdLine(SLBroker: TRPCBroker): Boolean;
var
 j: Integer;
begin
  with SLBroker do
  begin
    for j := 1 to ParamCount do    // Iterate through possible command line arguments
    begin
      if Pos('p=',ParamStr(j)) > 0 then
        ListenerPort := StrToInt(Copy(ParamStr(j),
                         (Pos('=',ParamStr(j))+1),length(ParamStr(j))));
      if Pos('s=',ParamStr(j)) > 0 then
        Server := Copy(ParamStr(j),
                         (Pos('=',ParamStr(j))+1),length(ParamStr(j)));
      if Pos('h=',ParamStr(j)) > 0 then
      begin
        Login.LoginHandle := Copy(ParamStr(j),
                         (Pos('=',ParamStr(j))+1),length(ParamStr(j)));
        if Login.LoginHandle <> '' then
        begin
          KernelLogin := False;
          Login.Mode := lmAppHandle;
        end;
      end;
      if Pos('d=',ParamStr(j)) > 0 then
        Login.Division := Copy(ParamStr(j),
                         (Pos('=',ParamStr(j))+1),length(ParamStr(j)));
    end;    // for
    if Login.Mode = lmAppHandle then
      Connected := True;      // Go ahead and make the connection
    Result := False;
    if Connected then
      Result := True;
  end;    // with SLBroker
end;


end.