{ ************************************************************** Package: XWB - Kernel RPCBroker Date Created: Sept 18, 1997 (Version 1.1) Site Name: Oakland, OI Field Office, Dept of Veteran Affairs Developers: Wally Fort, Joel Ivey, Herlan Westra Description: Contains DLL functions that allow Delphi as well as non-Delphi programs to use the Broker. Unit: Remote Procedure Call Broker DLL. Current Release: Version 1.1 Patch 71 *************************************************************** } { ************************************************** Changes in v1.1.71 (RGG 08/06/2019) XWB*1.1*71 1. Edited and recomipled for version XWB*1.1*71 Changes in v1.1.65 (HGW 03/07/2017) XWB*1.1*65 1. Added support for SSOi token from IAM. 2. Forced default 8-bit Ansi string output to match original Bapi32.dll. Delphi changed the default strings from 8-bit to 16-bit in Delphi 2009, and recompiling the Bapi32.dll with newer versions of Delphi changed the output. 3. Added 16-bit string functions/procedures (suffix "W") to match all 8-bit versions. Changes in v1.1.60 (HGW 09/30/2014) XWB*1.1*60 1. Recompiled with BDK XWB*1.1*60 to support SSH connections and use of WinSock 2.2 IPv4/IPv6 dual-stack APIs. 2. Removed support for deprecated old-style broker. ************************************************** } unit Bapi71; interface uses {System} System.SysUtils, System.AnsiStrings, {Vcl} Vcl.Dialogs, {VA} Trpcb, RpcSLogin, RpcConf1, MFunStr, XWBHash, VERGENCECONTEXTORLib_TLB, XlfSid, XWBSSOi; type PTOnRpcbFailure = ^TOnRpcbFailure; PTOnPulseError = ^TOnPulseError; PTOnLoginFailure = ^TOnLoginFailure; PTContextorControl = ^TContextorControl; {---- exported procedures and functions ----} procedure RpcbCall(const RPCBroker: TRPCBroker; CallResult: PAnsiChar); stdcall; procedure RpcbCallW(const RPCBroker: TRPCBroker; CallResult: PChar); stdcall; function RpcbCreate: TRPCBroker; stdcall; function RpcbCreateContext(const RPCBroker: TRPCBroker; const Context: PAnsiChar): boolean; stdcall; function RpcbCreateContextW(const RPCBroker: TRPCBroker; const Context: PChar): boolean; stdcall; procedure RpcbFree(RPCBroker: TRPCBroker); stdcall; procedure RpcbMultItemGet(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript: PAnsiChar; Value: PAnsiChar); stdcall; procedure RpcbMultItemGetW(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript: PChar; Value: PChar); stdcall; procedure RpcbMultPropGet(const RPCBroker: TRPCBroker; ParamIndex: integer; Prop: PAnsiChar; Value: PAnsiChar); stdcall; procedure RpcbMultPropGetW(const RPCBroker: TRPCBroker; ParamIndex: integer; Prop: PChar; Value: PChar); stdcall; procedure RpcbMultSet(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript: PAnsiChar; Value: PAnsiChar); stdcall; procedure RpcbMultSetW(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript: PChar; Value: PChar); stdcall; procedure RpcbMultSortedSet(const RPCBroker: TRPCBroker; ParamIndex: integer; Value: boolean); stdcall; procedure RpcbParamGet(const RPCBroker: TRPCBroker; ParamIndex: integer; var ParamType: TParamType; ParamValue: PAnsiChar); stdcall; procedure RpcbParamGetW(const RPCBroker: TRPCBroker; ParamIndex: integer; var ParamType: TParamType; ParamValue: PChar); stdcall; procedure RpcbParamSet(const RPCBroker: TRPCBroker; const ParamIndex: integer; const ParamType: TParamType; const ParamValue: PAnsiChar); stdcall; procedure RpcbParamSetW(const RPCBroker: TRPCBroker; const ParamIndex: integer; const ParamType: TParamType; const ParamValue: PChar); stdcall; procedure RpcbPropGet(const RPCBroker: TRPCBroker; const Prop: PAnsiChar; Value: PAnsiChar); stdcall; procedure RpcbPropGetW(const RPCBroker: TRPCBroker; const Prop: PChar; Value: PChar); stdcall; procedure RpcbPropSet(const RPCBroker: TRPCBroker; Prop: PAnsiChar; Value: PAnsiChar); stdcall; procedure RpcbPropSetW(const RPCBroker: TRPCBroker; Prop: PChar; Value: PChar); stdcall; procedure RpcbLoginPropGet(const RPCBroker: TRPCBroker; const Prop: PAnsiChar; Value: PAnsiChar); stdcall; procedure RpcbLoginPropGetW(const RPCBroker: TRPCBroker; const Prop: PChar; Value: PChar); stdcall; procedure RpcbLoginPropSet(const RPCBroker: TRPCBroker;Prop: PAnsiChar; Value: PAnsiChar); stdcall; procedure RpcbLoginPropSetW(const RPCBroker: TRPCBroker;Prop: PChar; Value: PChar); stdcall; procedure RpcbMultOrder(const RPCBroker: TRPCBroker; ParamIndex: integer; StartSubscript: PAnsiChar; Direction: integer; Value: PAnsiChar); stdcall; procedure RpcbMultOrderW(const RPCBroker: TRPCBroker; ParamIndex: integer; StartSubscript: PChar; Direction: integer; Value: PChar); stdcall; procedure RpcbMultSubscript(const RPCBroker: TRPCBroker; ParamIndex: integer; Position: integer; Value: PAnsiChar); stdcall; procedure RpcbMultSubscriptW(const RPCBroker: TRPCBroker; ParamIndex: integer; Position: integer; Value: PChar); stdcall; procedure RpcbMultPosition( const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript: PAnsiChar; var Value: integer); procedure RpcbMultPositionW( const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript: PChar; var Value: integer); procedure RpcbUserPropGet(const RPCBroker: TRPCBroker; const Prop: PAnsiChar; Value: PAnsiChar); stdcall; procedure RpcbUserPropGetW(const RPCBroker: TRPCBroker; const Prop: PChar; Value: PChar); stdcall; procedure RpcbUserPropSet(const RPCBroker: TRPCBroker; Prop: PAnsiChar; Value: PAnsiChar); stdcall; procedure RpcbUserPropSetW(const RPCBroker: TRPCBroker; Prop: PChar; Value: PChar); stdcall; procedure RpcbOnRpcbFailureSet(const RPCBroker: TRPCBroker; Value: PTOnRpcbFailure); stdcall; function RpcbSilentLogIn(const RPCBroker: TRPCBroker): boolean; stdcall; procedure RpcbGetUserInfo(const RPCBroker: TRPCBroker); stdcall; procedure RpcbGetSessionInfo(const RPCBroker: TRPCBroker); stdcall; procedure RpcbStartProgSLogin(ProgLine: PAnsiChar; const RPCBroker: TRPCBroker); stdcall; procedure RpcbStartProgSLoginW(ProgLine: PChar; const RPCBroker: TRPCBroker); stdcall; function RpcbCheckCmdLine(const RPCBroker: TRPCBroker): boolean; stdcall; procedure RpcbGetServerInfo(Server,Port: PAnsiChar; var Value: integer); stdcall; procedure RpcbGetServerInfoW(Server,Port: PChar; var Value: integer); stdcall; procedure RpcbPiece(x: PAnsiChar; del: PAnsiChar; const piecenum: integer; Value: PAnsiChar); stdcall; procedure RpcbPieceW(x: PChar; del: PChar; const piecenum: integer; Value: PChar); stdcall; procedure RpcbTranslate(passedString, identifier, associator, Value: PAnsiChar); stdcall; procedure RpcbTranslateW(passedString, identifier, associator, Value: PChar); stdcall; procedure RpcbRemoveCRLF(aString, Value: PAnsiChar); stdcall; procedure RpcbRemoveCRLFW(aString, Value: PChar); stdcall; procedure RpcbEncode(NormalText, Value: PAnsiChar); stdcall; procedure RpcbEncodeW(NormalText, Value: PChar); stdcall; procedure RpcbDecode(EncodedText, Value: PAnsiChar); stdcall; procedure RpcbDecodeW(EncodedText, Value: PChar); stdcall; procedure RpcbProcessExecute(Command: PAnsiChar; cShow: WORD; var Value: Integer); stdcall; procedure RpcbProcessExecuteW(Command: PChar; cShow: WORD; var Value: Integer); stdcall; procedure RpcbGetNTLogonUser(Value: PAnsiChar); stdcall; procedure RpcbGetNTLogonUserW(Value: PChar); stdcall; procedure RpcbGetNTLogonSid(Value: PAnsiChar); stdcall; procedure RpcbGetNTLogonSidW(Value: PChar); stdcall; function MySsoToken: PAnsiChar; stdcall; function MySsoTokenW: PChar; stdcall; function MySsoTokenVBA(StrBuff: PAnsiChar; StrLen: Integer): Integer; stdcall; {---- NOT exported (internal or future) procedures and functions ----} procedure RpcbOnPulseErrorSet(const RPCBroker: TRPCBroker; Value: TOnPulseError); stdcall; procedure RpcbOnFailedLoginSet(const RPCBroker: TRPCBroker; Value: TOnLoginFailure); stdcall; procedure RpcbContextorControlPropSet(const RPCBroker: TRPCBroker; Value: PTContextorControl); stdcall; procedure RpcbGetCCOWtoken(const RPCBroker: TRPCBroker; Contextor: PTContextorControl; Value: PChar); stdcall function RpcbIsUserCleared(const RPCBroker: TRPCBroker): Boolean; stdcall; function RpcbIsUserContextPending(const RPCBroker: TRPCBroker; aContextItemCollection: IContextItemCollection): Boolean; stdcall; function RpcbWasUserDefined(const RPCBroker: TRPCBroker): Boolean; stdcall; implementation {---------------------------- RpcbCall ---------------------------- Purpose: Makes the remote procedure call and fills the passed buffer with the data resulting from the call. Parameters: RPCBroker Handle of the Broker component which contains the name of the remote procedure and all of the required parameters. CallResult An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with the result of the call. ------------------------------------------------------------------} procedure RpcbCall(const RPCBroker: TRPCBroker; CallResult: PAnsiChar); var strResult: AnsiString; begin try try strResult := AnsiString(RPCBroker.pchCall); System.AnsiStrings.StrPCopy(CallResult, strResult); except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbCall: ' + E.Message); end; end; finally end; end; {---------------------------- RpcbCallW -------------------------- Purpose: Makes the remote procedure call and fills the passed buffer with the data resulting from the call. Parameters: RPCBroker Handle of the Broker component which contains the name of the remote procedure and all of the required parameters. CallResult An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with the result of the call. ------------------------------------------------------------------} procedure RpcbCallW(const RPCBroker: TRPCBroker; CallResult: PChar); var tmpPChar: PChar; begin tmpPChar := nil; try try tmpPChar := RPCBroker.pchCall; StrCopy(CallResult, tmpPChar); except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbCall: ' + E.Message); end; end; finally if tmpPChar <> nil then StrDispose(tmpPChar); end; end; {--------------------------- RpcbCreate --------------------------- Purpose: Creates a new Broker component for the application, which can then be used to connect to the server and call remote procedures. Parameters: None Returns: A handle of the newly created component. ------------------------------------------------------------------} function RpcbCreate: TRPCBroker; begin Result := nil; try Result := TRPCBroker.Create(nil); Result.ClearParameters := True; Result.ClearResults := True; except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbCreate: ' + E.Message); end; end; end; {----------------------- RpcbCreateContext ----------------------- Purpose: This procedure calls the RPC Broker component's CreateContext method to set up the environment on the server for subsequent RPCs. Parameters: RPCBroker Handle of the Broker component. Context Null-terminated string identifying the option on the server for which subsequent RPCs are registered. Returns: A boolean value, which will be True or 1 if the context was successfully created. Otherwise, False or 0 will be returned. ------------------------------------------------------------------} function RpcbCreateContext(const RPCBroker: TRPCBroker; const Context: PAnsiChar): boolean; var Str: String; begin Result := False; try Str := String(System.AnsiStrings.StrPas(Context)); Result := RPCBroker.CreateContext(Str); except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbCreateContext: ' + E.Message); end; end; end; {----------------------- RpcbCreateContextW ---------------------- Purpose: This procedure calls the RPC Broker component's CreateContext method to set up the environment on the server for subsequent RPCs. Parameters: RPCBroker Handle of the Broker component. Context Null-terminated string identifying the option on the server for which subsequent RPCs are registered. Returns: A boolean value, which will be True or 1 if the context was successfully created. Otherwise, False or 0 will be returned. ------------------------------------------------------------------} function RpcbCreateContextW(const RPCBroker: TRPCBroker; const Context: PChar): boolean; var Str: String; begin Result := False; try Str := StrPas(Context); Result := RPCBroker.CreateContext(Str); except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbCreateContext: ' + E.Message); end; end; end; {---------------------------- RpcbFree ---------------------------- Purpose: Destroys the Broker component and releases associated memory Parameters: RPCBroker Handle of the Broker component to destroy. ------------------------------------------------------------------} procedure RpcbFree(RPCBroker: TRPCBroker); begin RPCBroker.Free; end; {------------------------ RpcbMultItemGet ------------------------- Purpose: Retrieves a value of a multiple item of a RPC parameter. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Subscript Null-terminated string of the multiple element. Value An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with value of the multiple item. ------------------------------------------------------------------} procedure RpcbMultItemGet(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript, Value: PAnsiChar); var strSubscript: String; begin try strSubscript := RPCBroker.Param[ParamIndex].Mult[String(System.AnsiStrings.StrPas(Subscript))]; System.AnsiStrings.StrPCopy(Value, AnsiString(strSubscript)); except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultItemGet: ' + E.Message); end; end; end; {------------------------ RpcbMultItemGetW ------------------------ Purpose: Retrieves a value of a multiple item of a RPC parameter. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Subscript Null-terminated string of the multiple element. Value An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with value of the multiple item. ------------------------------------------------------------------} procedure RpcbMultItemGetW(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript, Value: PChar); begin try StrPCopy(Value, RPCBroker.Param[ParamIndex].Mult[StrPas(Subscript)]); except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultItemGet: ' + E.Message); end; end; end; {------------------------ RpcbMultPropGet ------------------------ Purpose: Returns a requested property of a multiple. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Prop Null-terminated string of the multiple property to get. Value An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with value of the multiple property that is in the Prop. ------------------------------------------------------------------} procedure RpcbMultPropGet(const RPCBroker: TRPCBroker; ParamIndex: integer; Prop,Value: PAnsiChar); var strProp: string; begin // System.AnsiStrings.StrPCopy(ParamValue, AnsiString(RPCBroker.Param[ParamIndex].Value)); try strProp := UpperCase(String(System.AnsiStrings.StrPas(Prop))); if strProp = 'COUNT' then begin System.AnsiStrings.StrPCopy(Value, AnsiString(IntToStr(RPCBroker.Param[ParamIndex].Mult.Count))); exit; end else if strProp = 'FIRST' then begin System.AnsiStrings.StrPCopy(Value, AnsiString(RPCBroker.Param[ParamIndex].Mult.First)); exit; end else if strProp = 'LAST' then begin System.AnsiStrings.StrPCopy(Value, AnsiString(RPCBroker.Param[ParamIndex].Mult.Last)); exit; end else if strProp = 'SORTED' then begin System.AnsiStrings.StrPCopy(Value, AnsiString(IntToStr(ord(RPCBroker.Param[ParamIndex].Mult.Sorted)))); exit; end else ShowMessage('Error RpcbMultPropGet!' + #13 + 'Unknown Broker Mult property: '+ strProp) except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultPropGet: ' + E.Message); end; end; {------------------------ RpcbMultPropGetW ----------------------- Purpose: Returns a requested property of a multiple. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Prop Null-terminated string of the multiple property to get. Value An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with value of the multiple property that is in the Prop. ------------------------------------------------------------------} procedure RpcbMultPropGetW(const RPCBroker: TRPCBroker; ParamIndex: integer; Prop,Value: PChar); var strProp: string; begin try strProp := UpperCase(StrPas(Prop)); if strProp = 'COUNT' then begin StrPCopy(Value, IntToStr(RPCBroker.Param[ParamIndex].Mult.Count)); exit; end else if strProp = 'FIRST' then begin StrPCopy(Value, RPCBroker.Param[ParamIndex].Mult.First); exit; end else if strProp = 'LAST' then begin StrPCopy(Value, RPCBroker.Param[ParamIndex].Mult.Last); exit; end else if strProp = 'SORTED' then begin StrPCopy(Value, IntToStr(ord(RPCBroker.Param[ParamIndex].Mult.Sorted))); exit; end else ShowMessage('Error RpcbMultPropGet!' + #13 + 'Unknown Broker Mult property: '+ strProp) except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultPropGet: ' + E.Message); end; end; {-------------------------- RpcbMultSet -------------------------- Purpose: Sets a multiple item to a value. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Subscript Null-terminated string of the multiple element to set. Value Null-terminated string containing the value that the multiple element should be set to. ------------------------------------------------------------------} procedure RpcbMultSet(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript, Value: PAnsiChar); var strValue: String; begin try strValue := UpperCase(String(System.AnsiStrings.StrPas(Value))); RPCBroker.Param[ParamIndex].Mult[String(System.AnsiStrings.StrPas(Subscript))] := strValue; except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultSet: ' + E.Message); end; end; {-------------------------- RpcbMultSetW ------------------------- Purpose: Sets a multiple item to a value. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Subscript Null-terminated string of the multiple element to set. Value Null-terminated string containing the value that the multiple element should be set to. ------------------------------------------------------------------} procedure RpcbMultSetW(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript, Value: PChar); begin try RPCBroker.Param[ParamIndex].Mult[StrPas(Subscript)] := StrPas(Value); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultSet: ' + E.Message); end; end; {----------------------- RpcbMultSortedSet ------------------------ Purpose: Sets the Sorted property of a multiple. In essence, sorts and keeps the Mult sorted or just leaves it in the order it is populated. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Value Can be either a boolean or, if the calling application language does not support boolean type, can be an integer. True or 1 will sort the Mult and keep it sorted thereafter when other elements are added. False or 0 will not sort the Mult and the elements will be stored in the order they are added. ------------------------------------------------------------------} procedure RpcbMultSortedSet(const RPCBroker: TRPCBroker; ParamIndex: integer; Value: boolean); begin try RPCBroker.Param[ParamIndex].Mult.Sorted := Value; except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultSortedSet: ' + E.Message); end; end; {-------------------------- RpcbParamGet ------------------------- Purpose: Retrieves and returns the Value and PType of a Param. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. ParamType This variable will be filled with PType property of a Param[ParamIndex]. The calling application should use an integer-type variable for this parameter ParamValue An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with Value of a Param[ParamIndex]. ------------------------------------------------------------------} procedure RpcbParamGet(const RPCBroker: TRPCBroker; ParamIndex: integer; var ParamType: TParamType; ParamValue: PAnsiChar); begin try ParamType := RPCBroker.Param[ParamIndex].PType; System.AnsiStrings.StrPCopy(ParamValue, AnsiString(RPCBroker.Param[ParamIndex].Value)); except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbParamGet: ' + E.Message); end; end; end; {-------------------------- RpcbParamGetW ------------------------ Purpose: Retrieves and returns the Value and PType of a Param. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. ParamType This variable will be filled with PType property of a Param[ParamIndex]. The calling application should use an integer-type variable for this parameter ParamValue An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with Value of a Param[ParamIndex]. ------------------------------------------------------------------} procedure RpcbParamGetW(const RPCBroker: TRPCBroker; ParamIndex: integer; var ParamType: TParamType; ParamValue: PChar); begin try ParamType := RPCBroker.Param[ParamIndex].PType; StrPCopy(ParamValue, RPCBroker.Param[ParamIndex].Value); except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbParamGet: ' + E.Message); end; end; end; {-------------------------- RpcbParamSet ------------------------- Purpose: Sets one Param's Value and PType properties in one shot. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. ParamType This variable should be one of the integer values that are valid as a PType. The following are valid and will be interpreted as: 0 = literal, 1 = reference, 2 = list ParamValue Null-terminated string containing the value of the Param. ------------------------------------------------------------------} procedure RpcbParamSet(const RPCBroker: TRPCBroker; const ParamIndex: integer; const ParamType: TParamType; const ParamValue: PAnsiChar); begin try RPCBroker.Param[ParamIndex].PType := ParamType; RPCBroker.Param[ParamIndex].Value := String(System.AnsiStrings.StrPas(ParamValue)); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbParamSet: ' + E.Message); end; end; {-------------------------- RpcbParamSetW ------------------------ Purpose: Sets one Param's Value and PType properties in one shot. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. ParamType This variable should be one of the integer values that are valid as a PType. The following are valid and will be interpreted as: 0 = literal, 1 = reference, 2 = list ParamValue Null-terminated string containing the value of the Param. ------------------------------------------------------------------} procedure RpcbParamSetW(const RPCBroker: TRPCBroker; const ParamIndex: integer; const ParamType: TParamType; const ParamValue: PChar); begin try RPCBroker.Param[ParamIndex].PType := ParamType; RPCBroker.Param[ParamIndex].Value := StrPas(ParamValue); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbParamSet: ' + E.Message); end; end; {-------------------------- RpcbPropGet -------------------------- Purpose: Returns a requested property of a RPCBroker component. Parameters: RPCBroker Handle of the Broker component. Prop Null-terminated string of the property to get. Value An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with value of the property that is in the Prop. This procedure takes care of all the necessary type conversions. ------------------------------------------------------------------} procedure RpcbPropGet(const RPCBroker: TRPCBroker; const Prop: PAnsiChar; Value: PAnsiChar); var strProp: AnsiString; AStr: AnsiString; intval: Integer; begin try strProp := UpperCase(System.AnsiStrings.StrPas(Prop)); if strProp = 'CLEARPARAMETERS' then begin AStr := AnsiString(IntToStr(ord(RPCBroker.ClearParameters))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'CLEARRESULTS' then begin AStr := AnsiString(IntToStr(ord(RPCBroker.ClearResults))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'CONNECTED' then begin AStr := AnsiString(IntToStr(ord(RPCBroker.Connected))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'CURRENTCONTEXT' then begin AStr := AnsiString(RPCBroker.CurrentContext); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'DEBUGMODE' then begin AStr := AnsiString(IntToStr(ord(RPCBroker.DebugMode))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'KERNELLOGIN' then begin AStr := AnsiString(IntToStr(ord(RPCBroker.KernelLogin))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'LISTENERPORT' then begin AStr := AnsiString(IntToStr(RPCBroker.ListenerPort)); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'REMOTEPROCEDURE' then begin AStr := AnsiString(RPCBroker.RemoteProcedure); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'RPCBERROR' then begin AStr := AnsiString(RPCBroker.RPCBError); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'RPCTIMELIMIT' then begin AStr := AnsiString(IntToStr(RPCBroker.RpcTimeLimit)); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'RPCVERSION' then begin AStr := AnsiString(RPCBroker.RpcVersion); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'RESULTS' then begin AStr := AnsiString(RPCBroker.Results.GetText); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SERVER' then begin AStr := AnsiString(RPCBroker.Server); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SHOWERRORMSGS' then begin intval := 0; case RPCBroker.ShowErrorMsgs of // semRaise: intval := 0; semQuiet: intval := 1; end; // case AStr := AnsiString(IntToStr(intval)); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SOCKET' then begin AStr := AnsiString(IntToStr(RPCBroker.Socket)); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'BROKERVERSION' then begin AStr := AnsiString(RPCBroker.BrokerVersion); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SECURITYPHRASE' then begin AStr := AnsiString(RPCBroker.SecurityPhrase); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'CCOWLOGONIDNAME' then begin AStr := AnsiString(RPCBroker.CCOWLogonIDName); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'CCOWLOGONIDVALUE' then begin AStr := AnsiString(RPCBroker.CCOWLogonIDValue); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'CCOWLOGONNAME' then begin AStr := AnsiString(RPCBroker.CCOWLogonName); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'CCOWLOGONNAMEVALUE' then begin AStr := AnsiString(RPCBroker.CCOWLogonNameValue); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'CCOWLOGONVPID' then begin AStr := AnsiString(RPCBroker.CCOWLogonVpid); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'CCOWLOGONVPIDVALUE' then begin AStr := AnsiString(RPCBroker.CCOWLogonVpidValue); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SSOITOKEN' then begin AStr := AnsiString(RPCBroker.SSOiToken); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SSOISECID' then begin AStr := AnsiString(RPCBroker.SSOiSECID); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SSOIADUPN' then begin AStr := AnsiString(RPCBroker.SSOiADUPN); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SSOILOGONNAME' then begin AStr := AnsiString(RPCBroker.SSOiLogonName); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SSHHIDE' then begin AStr := AnsiString(IntToStr(ord(RPCBroker.SSHHide))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SSHUSER' then begin AStr := AnsiString(RPCBroker.SSHUser); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SSHPORT' then begin AStr := AnsiString(RPCBroker.SSHPort); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SSHPW' then begin AStr := AnsiString(RPCBroker.SSHpw); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'USESECURECONNECTION' then begin intval := 0; case RPCBroker.UseSecureConnection of // secureNone: intval := 0; secureAttachmate: intval := 1; securePlink: intval := 2; end; // case AStr := AnsiString(IntToStr(intval)); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else ShowMessage('Error RpcbPropGet!' + #13 + 'Unknown Broker property: '+ String(strProp)) except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbPropGet: ' + E.Message); end; end; end; {-------------------------- RpcbPropGetW ------------------------- Purpose: Returns a requested property of a RPCBroker component. Parameters: RPCBroker Handle of the Broker component. Prop Null-terminated string of the property to get. Value An empty buffer that the calling application must create (allocate memory for) before making this call. This buffer will be filled with value of the property that is in the Prop. This procedure takes care of all the necessary type conversions. ------------------------------------------------------------------} procedure RpcbPropGetW(const RPCBroker: TRPCBroker; const Prop: PChar; Value: PChar); var strProp: string; intval: Integer; begin try strProp := UpperCase(StrPas(Prop)); if strProp = 'CLEARPARAMETERS' then begin StrPCopy(Value, IntToStr(ord(RPCBroker.ClearParameters))); exit; end else if strProp = 'CLEARRESULTS' then begin StrPCopy(Value, IntToStr(ord(RPCBroker.ClearResults))); exit; end else if strProp = 'CONNECTED' then begin StrPCopy(Value, IntToStr(ord(RPCBroker.Connected))); exit; end else if strProp = 'CURRENTCONTEXT' then begin StrPCopy(Value, RPCBroker.CurrentContext); exit; end else if strProp = 'DEBUGMODE' then begin StrPCopy(Value, IntToStr(ord(RPCBroker.DebugMode))); exit; end else if strProp = 'KERNELLOGIN' then begin strPCopy(Value, IntToStr(ord(RPCBroker.KernelLogin))); exit; end else if strProp = 'LISTENERPORT' then begin StrPCopy(Value, IntToStr(RPCBroker.ListenerPort)); exit; end else if strProp = 'REMOTEPROCEDURE' then begin StrPCopy(Value, RPCBroker.RemoteProcedure); exit; end else if strProp = 'RPCBERROR' then begin StrPCopy(Value, RPCBroker.RPCBError); exit; end else if strProp = 'RPCTIMELIMIT' then begin StrPCopy(Value, IntToStr(RPCBroker.RpcTimeLimit)); exit; end else if strProp = 'RPCVERSION' then begin StrPCopy(Value, RPCBroker.RpcVersion); exit; end else if strProp = 'RESULTS' then begin StrPCopy(Value, RPCBroker.Results.GetText); exit; end else if strProp = 'SERVER' then begin StrPCopy(Value, RPCBroker.Server); exit; end else if strProp = 'SHOWERRORMSGS' then begin intval := 0; case RPCBroker.ShowErrorMsgs of // semRaise: intval := 0; semQuiet: intval := 1; end; // case StrPCopy(Value, IntToStr(intval)); exit; end else if strProp = 'SOCKET' then begin StrPCopy(Value, IntToStr(RPCBroker.Socket)); exit; end else if strProp = 'BROKERVERSION' then begin StrPCopy(Value, RPCBroker.BrokerVersion); exit; end else if strProp = 'SECURITYPHRASE' then begin StrPCopy(Value, RPCBroker.SecurityPhrase); exit; end else if strProp = 'CCOWLOGONIDNAME' then begin StrPCopy(Value, RPCBroker.CCOWLogonIDName); exit; end else if strProp = 'CCOWLOGONIDVALUE' then begin StrPCopy(Value, RPCBroker.CCOWLogonIDValue); exit; end else if strProp = 'CCOWLOGONNAME' then begin StrPCopy(Value, RPCBroker.CCOWLogonName); exit; end else if strProp = 'CCOWLOGONNAMEVALUE' then begin StrPCopy(Value, RPCBroker.CCOWLogonNameValue); exit; end else if strProp = 'CCOWLOGONVPID' then begin StrPCopy(Value, RPCBroker.CCOWLogonVpid); exit; end else if strProp = 'CCOWLOGONVPIDVALUE' then begin StrPCopy(Value, RPCBroker.CCOWLogonVpidValue); exit; end else if strProp = 'SSOITOKEN' then begin strPCopy(Value, RPCBroker.SSOiToken); exit; end else if strProp = 'SSOISECID' then begin strPCopy(Value, RPCBroker.SSOiSECID); exit; end else if strProp = 'SSOIADUPN' then begin strPCopy(Value, RPCBroker.SSOiADUPN); exit; end else if strProp = 'SSOILOGONNAME' then begin strPCopy(Value, RPCBroker.SSOiLogonName); exit; end else if strProp = 'SSHHIDE' then begin strPCopy(Value, IntToStr(ord(RPCBroker.SSHHide))); exit; end else if strProp = 'SSHUSER' then begin strPCopy(Value, RPCBroker.SSHUser); exit; end else if strProp = 'SSHPORT' then begin strPCopy(Value, RPCBroker.SSHPort); exit; end else if strProp = 'SSHPW' then begin strPCopy(Value, RPCBroker.SSHpw); exit; end else if strProp = 'USESECURECONNECTION' then begin intval := 0; case RPCBroker.UseSecureConnection of // secureNone: intval := 0; secureAttachmate: intval := 1; securePlink: intval := 2; end; // case StrPCopy(Value, IntToStr(intval)); exit; end else ShowMessage('Error RpcbPropGet!' + #13 + 'Unknown Broker property: '+ strProp) except on E: Exception do begin if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbPropGet: ' + E.Message); end; end; end; {-------------------------- RpcbPropSet --------------------------- Purpose: Sets a RPCBroker property to some value. Parameters: RPCBroker Handle of the Broker component. Prop Null-terminated string of the property to set. Value Null-terminated string of the value that the Prop property should be set to. This procedure takes care of converting the passed in value to whatever type the property expects. ------------------------------------------------------------------} procedure RpcbPropSet(const RPCBroker: TRPCBroker; Prop,Value: PAnsiChar); var strProp: AnsiString; intCode, intValue: integer; begin try strProp := UpperCase(System.AnsiStrings.StrPas(Prop)); if strProp = 'ACCESSVERIFYCODES' then begin RPCBroker.AccessVerifyCodes := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'CLEARPARAMETERS' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.ClearParameters := boolean(intValue); // set property as boolean exit; end else if strProp = 'CLEARRESULTS' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.ClearResults := boolean(intValue); // set property as boolean exit; end else if strProp = 'CONNECTED' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.Connected := boolean(intValue); // set property as boolean exit; end else if strProp = 'DEBUGMODE' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.DebugMode := boolean(intValue); // set property as boolean exit; end else if strProp = 'KERNELLOGIN' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.KernelLogin := boolean(intValue); exit end else if strProp = 'LISTENERPORT' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.ListenerPort := intValue; exit; end else if strProp = 'REMOTEPROCEDURE' then begin RPCBroker.RemoteProcedure := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'RPCTIMELIMIT' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.RpcTimeLimit := intValue; // set property as integer exit; end else if strProp = 'RPCVERSION' then begin RPCBroker.RpcVersion := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'SERVER' then begin RPCBroker.Server := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'SHOWERRORMSGS' then begin case StrToInt(String(System.AnsiStrings.StrPas(Value))) of 0: RPCBroker.ShowErrorMsgs := semRaise; 1: RPCBroker.ShowErrorMsgs := semQuiet; end; // case exit; end else if strProp = 'SECURITYPHRASE' then begin RPCBroker.SecurityPhrase := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'SSHHIDE' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.SSHHide := boolean(intValue); exit; end else if strProp = 'SSHUSER' then begin RPCBroker.SSHUser := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'SSHPORT' then begin RPCBroker.SSHPort := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'SSHPW' then begin RPCBroker.SSHpw := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'USESECURECONNECTION' then begin case StrToInt(String(System.AnsiStrings.StrPas(Value))) of 0: RPCBroker.UseSecureConnection := secureNone; 1: RPCBroker.UseSecureConnection := secureAttachmate; 2: RPCBroker.UseSecureConnection := securePlink; end; // case exit; end else ShowMessage('Error RpcbPropSet!' + #13 + 'Unknown Broker property: '+ String(strProp)); except on E: Exception do begin ShowMessage('Error RpcbPropSet: ' + Prop + ' : ' + String(System.AnsiStrings.StrPas(Value)) + E.Message); end; end; end; {-------------------------- RpcbPropSetW ------------------------- Purpose: Sets a RPCBroker property to some value. Parameters: RPCBroker Handle of the Broker component. Prop Null-terminated string of the property to set. Value Null-terminated string of the value that the Prop property should be set to. This procedure takes care of converting the passed in value to whatever type the property expects. ------------------------------------------------------------------} procedure RpcbPropSetW(const RPCBroker: TRPCBroker; Prop,Value: PChar); var strProp: string; intCode, intValue: integer; begin try strProp := UpperCase(StrPas(Prop)); if strProp = 'ACCESSVERIFYCODES' then begin // added in p17 for backward compatability RPCBroker.AccessVerifyCodes := StrPas(Value); // set property as string exit; end else if strProp = 'CLEARPARAMETERS' then begin val(Value, intValue, intCode); // convert Value to integer RPCBroker.ClearParameters := boolean(intValue); // set property as boolean exit; end else if strProp = 'CLEARRESULTS' then begin val(Value, intValue, intCode); // convert Value to integer RPCBroker.ClearResults := boolean(intValue); // set property as boolean exit; end else if strProp = 'CONNECTED' then begin val(Value, intValue, intCode); // convert Value to integer RPCBroker.Connected := boolean(intValue); // set property as boolean exit; end else if strProp = 'DEBUGMODE' then begin val(Value, intValue, intCode); // convert Value to integer RPCBroker.DebugMode := boolean(intValue); // set property as boolean exit; end else if strProp = 'KERNELLOGIN' then begin // XWB*1.1*17 val(Value, intValue, intCode); RPCBroker.KernelLogin := boolean(intValue); exit end else if strProp = 'LISTENERPORT' then begin val(Value, intValue, intCode); // convert Value to integer RPCBroker.ListenerPort := intValue; // set property as integer exit; end else if strProp = 'REMOTEPROCEDURE' then begin RPCBroker.RemoteProcedure := StrPas(Value); // set property as string exit; end else if strProp = 'RPCTIMELIMIT' then begin val(Value, intValue, intCode); // convert Value to integer RPCBroker.RpcTimeLimit := intValue; // set property as integer exit; end else if strProp = 'RPCVERSION' then begin RPCBroker.RpcVersion := StrPas(Value); // set property as string exit; end else if strProp = 'SERVER' then begin RPCBroker.Server := StrPas(Value); // set property as string exit; end else if strProp = 'SHOWERRORMSGS' then begin // p17 case StrToInt(Value) of // 0: RPCBroker.ShowErrorMsgs := semRaise; 1: RPCBroker.ShowErrorMsgs := semQuiet; end; // case exit; end else if strProp = 'SECURITYPHRASE' then begin RPCBroker.SecurityPhrase := StrPas(Value); exit; end else if strProp = 'SSHHIDE' then begin val(Value, intValue, intCode); RPCBroker.SSHHide := boolean(intValue); exit; end else if strProp = 'SSHUSER' then begin RPCBroker.SSHUser := StrPas(Value); exit; end else if strProp = 'SSHPORT' then begin RPCBroker.SSHPort := StrPas(Value); exit; end else if strProp = 'SSHPW' then begin RPCBroker.SSHpw := StrPas(Value); exit; end else if strProp = 'USESECURECONNECTION' then begin case StrToInt(Value) of // 0: RPCBroker.UseSecureConnection := secureNone; 1: RPCBroker.UseSecureConnection := secureAttachmate; 2: RPCBroker.UseSecureConnection := securePlink; end; // case exit; end else ShowMessage('Error RpcbPropSet!' + #13 + 'Unknown Broker property: '+ strProp); except on E: Exception do begin ShowMessage('Error RpcbPropSet: ' + Prop + ' : ' + Value + E.Message); end; end; end; {----------------------------- RpcbLoginPropGet ------------------------ Purpose: Get properties from the TVistALogin class. Parameters: RPCBroker Handle of the Broker component. -------------------------------------------------------------------------} procedure RpcbLoginPropGet(const RPCBroker: TRPCBroker; const Prop: PAnsiChar; Value: PAnsiChar); var strProp: AnsiString; AStr: AnsiString; begin try strProp := UpperCase(System.AnsiStrings.StrPas(Prop)); if strProp = 'LOGINHANDLE' then begin AStr := AnsiString(RPCBroker.Login.LoginHandle); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'NTTOKEN' then begin AStr := AnsiString(RPCBroker.Login.NTToken); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'ACCESSCODE' then begin AStr := AnsiString(RPCBroker.Login.AccessCode); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'VERIFYCODE' then begin AStr := AnsiString(RPCBroker.Login.VerifyCode); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'MODE' then begin AStr := AnsiString(IntToStr(ord(RPCBroker.Login.Mode))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'DIVISION' then begin AStr := AnsiString(RPCBroker.Login.Division); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'DIVLIST' then begin AStr := AnsiString(RPCBroker.Login.DivList.GetText); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'MULTIDIVISION' then begin AStr := AnsiString(IntToStr(ord(RPCBroker.Login.MultiDivision))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'DUZ' then begin AStr := AnsiString(RPCBroker.Login.DUZ); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'ERRORTEXT' then begin AStr := AnsiString(RPCBroker.Login.ErrorText); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'PROMPTDIVISION' then begin AStr := AnsiString(IntToStr(ord(RPCBroker.Login.PromptDivision))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else ShowMessage('Error RpcbLoginPropGet!' + #13 + 'Unknown Broker property: '+ String(strProp)) except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbLoginPropGet: ' + E.Message); end; end; {----------------------------- RpcbLoginPropGet ----------------------- Purpose: Get properties from the TVistALogin class. Parameters: RPCBroker Handle of the Broker component. -------------------------------------------------------------------------} procedure RpcbLoginPropGetW(const RPCBroker: TRPCBroker; const Prop: PChar; Value: PChar); var strProp: string; begin try strProp := UpperCase(StrPas(Prop)); if strProp = 'LOGINHANDLE' then begin StrPCopy(Value, RPCBroker.Login.LoginHandle); exit; end else if strProp = 'NTTOKEN' then begin StrPCopy(Value, RPCBroker.Login.NTToken); exit; end else if strProp = 'ACCESSCODE' then begin StrPCopy(Value, RPCBroker.Login.AccessCode); exit; end else if strProp = 'VERIFYCODE' then begin StrPCopy(Value, RPCBroker.Login.VerifyCode); exit; end else if strProp = 'MODE' then begin strPCopy(Value, IntToStr(ord(RPCBroker.Login.Mode))); exit; end else if strProp = 'DIVISION' then begin StrPCopy(Value, RPCBroker.Login.Division); exit; end else if strProp = 'DIVLIST' then begin StrPCopy(Value, RPCBroker.Login.DivList.GetText); exit; end else if strProp = 'MULTIDIVISION' then begin StrPCopy(Value, IntToStr(ord(RPCBroker.Login.MultiDivision))); exit; end else if strProp = 'DUZ' then begin StrPCopy(Value, RPCBroker.Login.DUZ); exit; end else if strProp = 'ERRORTEXT' then begin StrPCopy(Value, RPCBroker.Login.ErrorText); exit; end else if strProp = 'PROMPTDIVISION' then begin StrPCopy(Value, IntToStr(ord(RPCBroker.Login.PromptDivision))); exit; end else ShowMessage('Error RpcbLoginPropGet!' + #13 + 'Unknown Broker property: '+ strProp) except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbLoginPropGet: ' + E.Message); end; end; {-------------------------- RpcbLoginPropSet --------------------------- Purpose: Sets a RPCBroker property to some value. Parameters: RPCBroker Handle of the Broker component. Prop Null-terminated string of the property to set. Value Null-terminated string of the value that the Prop property should be set to. This procedure takes care of converting the passed in value to whatever type the property expects. ------------------------------------------------------------------------} procedure RpcbLoginPropSet(const RPCBroker: TRPCBroker; Prop,Value: PAnsiChar); var strProp: AnsiString; intCode, intValue: integer; begin try strProp := UpperCase(System.AnsiStrings.StrPas(Prop)); if strProp = 'LOGINHANDLE' then begin RPCBroker.Login.LoginHandle := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'NTTOKEN' then begin RPCBroker.Login.NTToken := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'ACCESSCODE' then begin RPCBroker.Login.AccessCode := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'VERIFYCODE' then begin RPCBroker.Login.VerifyCode := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'MODE' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.Login.Mode := TLoginMode(intValue); exit end else if strProp = 'DIVISION' then begin RPCBroker.Login.Division := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'MULTIDIVISION' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.Login.MultiDivision := boolean(intValue); exit; end else if strProp = 'DUZ' then begin RPCBroker.Login.DUZ := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'ERRORTEXT' then begin RPCBroker.Login.ErrorText := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'PROMPTDIVISION' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.Login.PromptDivision := boolean(intValue); exit; end else ShowMessage('Error RpcbLoginPropSet!' + #13 + 'Unknown Broker property: '+ String(strProp)); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbLoginPropSet: ' + E.Message); end; end; {-------------------------- RpcbLoginPropSetW --------------------------- Purpose: Sets a RPCBroker property to some value. Parameters: RPCBroker Handle of the Broker component. Prop Null-terminated string of the property to set. Value Null-terminated string of the value that the Prop property should be set to. This procedure takes care of converting the passed in value to whatever type the property expects. ------------------------------------------------------------------------} procedure RpcbLoginPropSetW(const RPCBroker: TRPCBroker; Prop,Value: PChar); var strProp: string; intCode, intValue: integer; begin try strProp := UpperCase(StrPas(Prop)); if strProp = 'LOGINHANDLE' then begin RPCBroker.Login.LoginHandle := StrPas(Value); exit; end else if strProp = 'NTTOKEN' then begin RPCBroker.Login.NTToken := StrPas(Value); exit; end else if strProp = 'ACCESSCODE' then begin RPCBroker.Login.AccessCode := StrPas(Value); exit; end else if strProp = 'VERIFYCODE' then begin RPCBroker.Login.VerifyCode := StrPas(Value); exit; end else if strProp = 'MODE' then begin // XWB*1.1*17 val(Value, intValue, intCode); RPCBroker.Login.Mode := TLoginMode(intValue); exit end else if strProp = 'DIVISION' then begin RPCBroker.Login.Division := StrPas(Value); exit; end else if strProp = 'MULTIDIVISION' then begin val(Value, intValue, intCode); RPCBroker.Login.MultiDivision := boolean(intValue); exit; end else if strProp = 'DUZ' then begin RPCBroker.Login.DUZ := StrPas(Value); exit; end else if strProp = 'ERRORTEXT' then begin RPCBroker.Login.ErrorText := StrPas(Value); // set property as string exit; end else if strProp = 'PROMPTDIVISION' then begin val(Value, intValue, intCode); RPCBroker.Login.PromptDivision := boolean(intValue); exit; end else ShowMessage('Error RpcbLoginPropSet!' + #13 + 'Unknown Broker property: '+ strProp); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbLoginPropSet: ' + E.Message); end; end; {-------------------------------- RpcbMultOrder ----------------------- Purpose: Returns the next subscript in the MULT array given the StartSubscript. The next subscript may be before or after as determined by the Direction parameter. A null value is returned when the end (or beginning) of the MULT array is passed. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. StartSubscript The text subscript from which the ordering through the MULT array is to start (or continue). WARNING: The specified StartSubscript MUST be present in the MULT array to prevent an error. Direction An indicator for the direction that the ordering through the MULT array should proceed - an integer value of one or greater indicates the forward direction, a value of zero (or less) indicates the reverse direction. -------------------------------------------------------------------------} procedure RpcbMultOrder(const RPCBroker: TRPCBroker; ParamIndex: integer; StartSubscript: PAnsiChar; Direction: integer; Value: PAnsiChar); var Str: String; AStr: AnsiString; begin try Str := String(System.AnsiStrings.StrPas(StartSubscript)); AStr := AnsiString(RPCBroker.Param[ParamIndex].Mult.Order(Str, Direction)); System.AnsiStrings.StrPCopy(Value,AStr); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultOrder: ' + E.Message); end; end; {-------------------------------- RpcbMultOrderW ---------------------- Purpose: Returns the next subscript in the MULT array given the StartSubscript. The next subscript may be before or after as determined by the Direction parameter. A null value is returned when the end (or beginning) of the MULT array is passed. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. StartSubscript The text subscript from which the ordering through the MULT array is to start (or continue). WARNING: The specified StartSubscript MUST be present in the MULT array to prevent an error. Direction An indicator for the direction that the ordering through the MULT array should proceed - an integer value of one or greater indicates the forward direction, a value of zero (or less) indicates the reverse direction. -------------------------------------------------------------------------} procedure RpcbMultOrderW(const RPCBroker: TRPCBroker; ParamIndex: integer; StartSubscript: PChar; Direction: integer; Value: PChar); begin try StrPCopy(Value,RPCBroker.Param[ParamIndex].Mult.Order(StartSubscript, Direction)); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultOrder: ' + E.Message); end; end; {--------------------------- RpcbMultSubscript ------------------------ Purpose: Returns the subscript value associated with the specified Position in the MULT array. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Position Integer value for location in the MULT array (range is zero to Count-1) -------------------------------------------------------------------------} procedure RpcbMultSubscript(const RPCBroker: TRPCBroker; ParamIndex: integer; Position: integer; Value: PAnsiChar); var AStr: AnsiString; begin try AStr := AnsiString(RPCBroker.Param[ParamIndex].Mult.Subscript(Position)); System.AnsiStrings.StrPCopy(Value,AStr); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultSubscript: ' + E.Message); end; end; {--------------------------- RpcbMultSubscriptW ----------------------- Purpose: Returns the subscript value associated with the specified Position in the MULT array. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Position Integer value for location in the MULT array (range is zero to Count-1) -------------------------------------------------------------------------} procedure RpcbMultSubscriptW(const RPCBroker: TRPCBroker; ParamIndex: integer; Position: integer; Value: PChar); begin try StrPCopy(Value, RPCBroker.Param[ParamIndex].Mult.Subscript(Position)); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error RpcbMultSubscript: ' + E.Message); end; end; {---------------------------- RpcbMultPosition ------------------------ Purpose: Returns an integer value in the range zero to Count-1 indicating the postion in the MULT array of the specified subscript. WARNING: The Subscript must be a valid subscript in the MULT array to avoid an error. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Subscript The Subscript value for which the position in the MULT array is to be determined. The Subscript must be a valid subscript in the MULT array to avoid an error. -------------------------------------------------------------------------} procedure RpcbMultPosition(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript: PAnsiChar; var Value: integer); var strVal: string; begin try strVal := String(System.AnsiStrings.StrPas(Subscript)); Value := RPCBroker.Param[ParamIndex].Mult.Position(StrVal); except on E: Exception do ShowMessage('Error RpcbMultPosition: ' + E.Message); end; end; {---------------------------- RpcbMultPositionW ----------------------- Purpose: Returns an integer value in the range zero to Count-1 indicating the postion in the MULT array of the specified subscript. WARNING: The Subscript must be a valid subscript in the MULT array to avoid an error. Parameters: RPCBroker Handle of the Broker component. ParamIndex Integer index of the parameter which contains the multiple. Subscript The Subscript value for which the position in the MULT array is to be determined. The Subscript must be a valid subscript in the MULT array to avoid an error. -------------------------------------------------------------------------} procedure RpcbMultPositionW(const RPCBroker: TRPCBroker; ParamIndex: integer; Subscript: PChar; var Value: integer); var strVal: string; begin try strVal := StrPas(Subscript); Value := RPCBroker.Param[ParamIndex].Mult.Position(StrVal); except on E: Exception do ShowMessage('Error RpcbMultPosition: ' + E.Message); end; end; {-------------------------------- RpcbUserPropGet --------------------- Purpose: Gets the value of a RPCBroker property. Parameters: RPCBroker Handle of the Broker component. -------------------------------------------------------------------------} procedure RpcbUserPropGet(const RPCBroker: TRPCBroker; const Prop: PAnsiChar; Value: PAnsiChar); var strProp: AnsiString; AStr: AnsiString; begin try strProp := UpperCase(System.AnsiStrings.StrPas(Prop)); if strProp = 'DUZ' then begin AStr := AnsiString(RPCBroker.User.DUZ); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'NAME' then begin AStr := AnsiString(RPCBroker.User.Name); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'STANDARDNAME' then begin AStr := AnsiString(RPCBroker.User.StandardName); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'DIVISION' then begin AStr := AnsiString(RPCBroker.User.Division); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'VERIFYCODECHNGD' then begin // XWB*1.1*17 AStr := AnsiString(IntToStr(ord(RPCBroker.User.VerifyCodeChngd))); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'TITLE' then begin AStr := AnsiString(RPCBroker.User.Title); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'SERVICESECTION' then begin AStr := AnsiString(RPCBroker.User.ServiceSection); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'LANGUAGE' then begin AStr := AnsiString(RPCBroker.User.Language); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else if strProp = 'DTIME' then begin AStr := AnsiString(RPCBroker.User.DTime); System.AnsiStrings.StrPCopy(Value, AStr); exit; end else ShowMessage('Error!' + #13 + 'Unknown Broker property: '+ String(strProp)) except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {-------------------------------- RpcbUserPropGetW -------------------- Purpose: Gets the value of a RPCBroker property. Parameters: RPCBroker Handle of the Broker component. -------------------------------------------------------------------------} procedure RpcbUserPropGetW(const RPCBroker: TRPCBroker; const Prop: PChar; Value: PChar); var strProp: string; begin try strProp := UpperCase(StrPas(Prop)); if strProp = 'DUZ' then begin StrPCopy(Value, RPCBroker.User.DUZ); exit; end else if strProp = 'NAME' then begin StrPCopy(Value, RPCBroker.User.Name); exit; end else if strProp = 'STANDARDNAME' then begin StrPCopy(Value, RPCBroker.User.StandardName); exit; end else if strProp = 'DIVISION' then begin StrPCopy(Value, RPCBroker.User.Division); exit; end else if strProp = 'VERIFYCODECHNGD' then begin // XWB*1.1*17 strPCopy(Value, IntToStr(ord(RPCBroker.User.VerifyCodeChngd))); exit; end else if strProp = 'TITLE' then begin StrPCopy(Value, RPCBroker.User.Title); exit; end else if strProp = 'SERVICESECTION' then begin StrPCopy(Value, RPCBroker.User.ServiceSection); exit; end else if strProp = 'LANGUAGE' then begin StrPCopy(Value, RPCBroker.User.Language); exit; end else if strProp = 'DTIME' then begin StrPCopy(Value, RPCBroker.User.DTime); exit; end else ShowMessage('Error!' + #13 + 'Unknown Broker property: '+ strProp) except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {-------------------------- RpcbUserPropSet --------------------------- Purpose: Sets a RPCBroker property to some value. Parameters: RPCBroker Handle of the Broker component. Prop Null-terminated string of the property to set. Value Null-terminated string of the value that the Prop property should be set to. This procedure takes care of converting the passed in value to whatever type the property expects. ------------------------------------------------------------------} procedure RpcbUserPropSet(const RPCBroker: TRPCBroker; Prop,Value: PAnsiChar); var strProp: AnsiString; intCode, intValue: integer; begin try strProp := UpperCase(System.AnsiStrings.StrPas(Prop)); if strProp = 'DUZ' then begin RPCBroker.User.DUZ := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'NAME' then begin RPCBroker.User.Name := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'STANDARDNAME' then begin RPCBroker.User.StandardName := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'DIVISION' then begin RPCBroker.User.Division := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'VERIFYCODECHNGD' then begin val(String(System.AnsiStrings.StrPas(Value)), intValue, intCode); RPCBroker.User.VerifyCodeChngd := boolean(intValue); exit end else if strProp = 'TITLE' then begin RPCBroker.User.Title := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'SERVICESECTION' then begin RPCBroker.User.ServiceSection := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'LANGUAGE' then begin RPCBroker.User.Language := String(System.AnsiStrings.StrPas(Value)); exit; end else if strProp = 'DTIME' then begin RPCBroker.User.DTime := String(System.AnsiStrings.StrPas(Value)); exit; end else ShowMessage('Error!' + #13 + 'Unknown Broker property: '+ String(strProp)); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {-------------------------- RpcbUserPropSetW --------------------- Purpose: Sets a RPCBroker property to some value. Parameters: RPCBroker Handle of the Broker component. Prop Null-terminated string of the property to set. Value Null-terminated string of the value that the Prop property should be set to. This procedure takes care of converting the passed in value to whatever type the property expects. ------------------------------------------------------------------} procedure RpcbUserPropSetW(const RPCBroker: TRPCBroker; Prop,Value: PChar); var strProp: string; intCode, intValue: integer; begin try strProp := UpperCase(StrPas(Prop)); if strProp = 'DUZ' then begin RPCBroker.User.DUZ := StrPas(Value); exit; end else if strProp = 'NAME' then begin RPCBroker.User.Name := StrPas(Value); exit; end else if strProp = 'STANDARDNAME' then begin RPCBroker.User.StandardName := StrPas(Value); exit; end else if strProp = 'DIVISION' then begin RPCBroker.User.Division := StrPas(Value); exit; end else if strProp = 'VERIFYCODECHNGD' then begin // XWB*1.1*17 val(Value, intValue, intCode); RPCBroker.User.VerifyCodeChngd := boolean(intValue); exit end else if strProp = 'TITLE' then begin RPCBroker.User.Title := StrPas(Value); exit; end else if strProp = 'SERVICESECTION' then begin RPCBroker.User.ServiceSection := StrPas(Value); //set property as string exit; end else if strProp = 'LANGUAGE' then begin RPCBroker.User.Language := StrPas(Value); exit; end else if strProp = 'DTIME' then begin RPCBroker.User.DTime := StrPas(Value); // set property as string exit; end else ShowMessage('Error!' + #13 + 'Unknown Broker property: '+ strProp); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbOnRpcbFailureSet ---------------- Purpose: Set the OnRpcbFailureSet property. Parameters: Instance of RPCBroker, TOnRpcbFailure value. Returns: None. ------------------------------------------------------------------} procedure RpcbOnRpcbFailureSet(const RPCBroker: TRPCBroker; Value: PTOnRpcbFailure); var PVal: Pointer; CVal: Cardinal; begin try PVal := Value; CVal := Cardinal(PVal); ShowMessage(IntToStr(CVal)); ShowMessage(IntToStr(CVal)); RPCBroker.OnRpcbFailure := Value^; except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbOnPulseErrorSet ----------------- Purpose: Set the OnPulseError property. Parameters: Instance of RPCBroker, TOnPulseError value. Returns: None. ------------------------------------------------------------------} procedure RpcbOnPulseErrorSet(const RPCBroker: TRPCBroker; Value: TOnPulseError); begin try RPCBroker.OnPulseError := Value; except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbSilentLogIn --------------------- Purpose: Authenticate user with credentials passed as parameters in the RPCBroker instance. Parameters: Instance of RPCBroker Returns: None. ------------------------------------------------------------------} function RpcbSilentLogIn(const RPCBroker: TRPCBroker): boolean; begin Result := False; try Result := SilentLogin(RPCBroker); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbGetUserInfo --------------------- Purpose: Get information for TVistaUser class (Tobject) using RPC 'XUS GET USER INFO'. Parameters: Instance of RPCBroker Returns: None. ------------------------------------------------------------------} procedure RpcbGetUserInfo(const RPCBroker: TRPCBroker); begin try GetUserInfo(RPCBroker); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbGetSessionInfo ------------------ Purpose: Get information for TVistaSession class (Tobject) using RPC 'XUS GET SESSION INFO'. Parameters: Instance of RPCBroker Returns: None. ------------------------------------------------------------------} procedure RpcbGetSessionInfo(const RPCBroker: TRPCBroker); begin try GetSessionInfo(RPCBroker); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbStartProgSLogin ----------------- Purpose: Start a second application using a login handle. Parameters: PChar (string) containing program line. Returns: Instance of RPCBroker if the application uses a Broker connection. ------------------------------------------------------------------} procedure RpcbStartProgSLogin(ProgLine: PAnsiChar; const RPCBroker: TRPCBroker); var ProgStr: String; begin try ProgStr := String(ProgLine); StartProgSLogin(ProgStr, RPCBroker); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbStartProgSLoginW ---------------- Purpose: Start a second application using a login handle. Parameters: PChar (string) containing program line. Returns: Instance of RPCBroker if the application uses a Broker connection. ------------------------------------------------------------------} procedure RpcbStartProgSLoginW(ProgLine: PChar; const RPCBroker: TRPCBroker); begin try StartProgSLogin(StrPas(ProgLine), RPCBroker); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbCheckCmdLine ------------------- Purpose: Check command line for information on broker settings, and make a silent login if configured to do so. Parameters: None Returns: Boolean value for connection status (1=connected) ------------------------------------------------------------------} function RpcbCheckCmdLine(const RPCBroker: TRPCBroker): Boolean; begin Result := False; try Result := CheckCmdLine(RPCBroker); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbGetServerInfo ------------------- Purpose: Get VistA server info from Windows registry. Parameters: None Returns: PAnsiChar (string) values for server and port. Value is status (1=okay) ------------------------------------------------------------------} procedure RpcbGetServerInfo(Server,Port: PAnsiChar; var Value: integer); var ServStr: String; PortStr: String; AStr1, AStr2: AnsiString; begin try Value := GetServerInfo(ServStr,PortStr); AStr1 := AnsiString(ServStr); System.AnsiStrings.StrPCopy(Server,AStr1); AStr2 := AnsiString(PortStr); System.AnsiStrings.StrPCopy(Port,AStr2); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbGetServerInfoW ------------------ Purpose: Get VistA server info from Windows registry. Parameters: None Returns: PAnsiChar (string) values for server and port. Value is status (1=okay) ------------------------------------------------------------------} procedure RpcbGetServerInfoW(Server,Port: PChar; var Value: integer); var ServStr: String; PortStr: String; begin try Value := GetServerInfo(ServStr,PortStr); StrPCopy(Server,ServStr); StrPCopy(Port,PortStr); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbPiece --------------------------- Purpose: String manipulation utility. Parameters: None Returns: A PAnsiChar (string) containing encoded value of the input. ------------------------------------------------------------------} procedure RpcbPiece(x: PAnsiChar; del: PAnsiChar; const piecenum: integer; Value: PAnsiChar); var Str: String; AStr, AStr1, AStr2: AnsiString; begin try AStr1 := System.AnsiStrings.StrPas(x); AStr2 := System.AnsiStrings.StrPas(del); Str := Piece(String(AStr1), String(AStr2), piecenum); AStr := AnsiString(Str); System.AnsiStrings.StrPCopy(Value, AStr); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbPieceW -------------------------- Purpose: String manipulation utility. Parameters: None Returns: A PWideChar (string) containing encoded value of the input. ------------------------------------------------------------------} procedure RpcbPieceW(x: PChar; del: PChar; const piecenum: integer; Value: PChar); var Str: String; begin try Str := Piece(StrPas(x), StrPas(del), piecenum); StrPCopy(Value,Str); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbTranslate ----------------------- Purpose: String manipulation utility. Parameters: None Returns: A PAnsiChar (string) containing encoded value of the input. ------------------------------------------------------------------} procedure RpcbTranslate(passedString, identifier, associator, Value: PAnsiChar); var Str: String; AStr, AStr1, AStr2, AStr3: AnsiString; begin try AStr1 := System.AnsiStrings.StrPas(passedString); AStr2 := System.AnsiStrings.StrPas(identifier); AStr3 := System.AnsiStrings.StrPas(associator); Str := Translate(String(AStr1), String(AStr2), String(AStr3)); AStr := AnsiString(Str); System.AnsiStrings.StrPCopy(Value, AStr); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbTranslateW ---------------------- Purpose: String manipulation utility. Parameters: None Returns: A PWideChar (string) containing encoded value of the input. ------------------------------------------------------------------} procedure RpcbTranslateW(passedString, identifier, associator, Value: PChar); var Str: String; begin try Str := Translate(StrPas(passedString),StrPas(identifier), StrPas(associator)); StrPCopy(Value,Str); except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbRemoveCRLF ---------------------- Purpose: String manipulation utility. Parameters: None Returns: A PAnsiChar (string) containing the input with carriage returns and line feeds removed. ------------------------------------------------------------------} procedure RpcbRemoveCRLF(aString, Value: PAnsiChar); var Str: String; AStr: AnsiString; begin AStr := System.AnsiStrings.StrPas(aString); Str := RemoveCRLF(String(AStr)); AStr := AnsiString(Str); System.AnsiStrings.StrPCopy(Value, AStr); end; {--------------------------- RpcbRemoveCRLFW --------------------- Purpose: String manipulation utility. Parameters: None Returns: A PWideChar (string) containing the input with carriage returns and line feeds removed. ------------------------------------------------------------------} procedure RpcbRemoveCRLFW(aString, Value: PChar); var Str: String; begin Str := RemoveCRLF(StrPas(aString)); StrPCopy(Value,Str); end; {--------------------------- RpcbEncode -------------------------- Purpose: Encryption utility. Parameters: None Returns: A PAnsiChar (string) containing encoded value of the input. ------------------------------------------------------------------} procedure RpcbEncode(NormalText, Value: PAnsiChar); var Str: String; AStr: AnsiString; begin AStr := System.AnsiStrings.StrPas(NormalText); Str := Encrypt(String(AStr)); AStr := AnsiString(Str); System.AnsiStrings.StrPCopy(Value, AStr); end; {--------------------------- RpcbEncodeW ------------------------- Purpose: Encryption utility. Parameters: None Returns: A PWideChar (string) containing encoded value of the input. ------------------------------------------------------------------} procedure RpcbEncodeW(NormalText, Value: PChar); var Str: String; begin Str := Encrypt(StrPas(NormalText)); StrPCopy(Value, Str); end; {--------------------------- RpcbDecode -------------------------- Purpose: Encryption utility. Parameters: None Returns: A PAnsiChar (string) containing decoded value of the input. ------------------------------------------------------------------} procedure RpcbDecode(EncodedText, Value: PAnsiChar); var Str: String; AStr: AnsiString; begin AStr := System.AnsiStrings.StrPas(EncodedText); Str := Decrypt(String(AStr)); AStr := AnsiString(Str); System.AnsiStrings.StrPCopy(Value, AStr); end; {--------------------------- RpcbDecodeW ------------------------- Purpose: Encryption utility. Parameters: None Returns: A PWideChar (string) containing decoded value of the input. ------------------------------------------------------------------} procedure RpcbDecodeW(EncodedText, Value: PChar); var Str: String; begin Str := Decrypt(StrPas(EncodedText)); StrPCopy(Value, Str); end; {--------------------------- RpcbProcessExecute ------------------ Purpose: Start or execute a Windows process. Parameters: The Command parameter (PAnsiChar string) specifies the pathname of the file to execute. The cShow parameter specifies one of the SW_XXXX constants which specifies how to display the window. This value is assigned to the sShowWindow field of the TStartupInfo structure. Returns: An integer result of the Windows CreateProcess command. ------------------------------------------------------------------} procedure RpcbProcessExecute(Command: PAnsiChar; cShow: WORD; var Value: Integer); begin Value := ProcessExecute(String(Command), cShow); end; {--------------------------- RpcbProcessExecuteW ----------------- Purpose: Start or execute a Windows process. Parameters: The Command parameter (PWideChar string) specifies the pathname of the file to execute. The cShow parameter specifies one of the SW_XXXX constants which specifies how to display the window. This value is assigned to the sShowWindow field of the TStartupInfo structure. Returns: An integer result of the Windows CreateProcess command. ------------------------------------------------------------------} procedure RpcbProcessExecuteW(Command: PChar; cShow: WORD; var Value: Integer); begin Value := ProcessExecute(Command, cShow); end; {--------------------------- RpcbGetNTLogonUser ------------------ Purpose: Windows Thread or Process security. Parameters: None Returns: A PAnsiChar (string) containing the Domain\Username that authenticated the user. ------------------------------------------------------------------} procedure RpcbGetNTLogonUser(Value: PAnsiChar); stdcall; var Result: PChar; begin Result := ''; RpcbGetNTLogonUserW(Result); Value := PAnsiChar(Result); end; {--------------------------- RpcbGetNTLogonUserW ----------------- Purpose: Windows Thread or Process security. Parameters: None Returns: A PWideChar (string) containing the Domain\Username that authenticated the user. ------------------------------------------------------------------} procedure RpcbGetNTLogonUserW(Value: PChar); stdcall; begin StrPCopy(Value, GetNTLogonUser); end; {--------------------------- RpcbGetNTLogonSid ------------------- Purpose: Windows Thread or Process security. Parameters: None Returns: A PAnsiChar (string) containing the user's SID. ------------------------------------------------------------------} procedure RpcbGetNTLogonSid(Value: PAnsiChar); stdcall; var Result: PChar; begin Result := ''; RpcbGetNTLogonSidW(Result); Value := PAnsiChar(Result); end; {--------------------------- RpcbGetNTLogonSidW ------------------ Purpose: Windows Thread or Process security. Parameters: None Returns: A PWideChar (string) containing the user's SID. ------------------------------------------------------------------} procedure RpcbGetNTLogonSidW(Value: PChar); stdcall; begin StrPCopy(Value, GetNTLogonSid); end; {--------------------------- MySsoToken -------------------------- Purpose: Obtain a SAML token from Identity and Access Management. Parameters: None Returns: A PAnsiChar (string) containing XML. ------------------------------------------------------------------} function MySsoToken: PAnsiChar; stdcall; begin Result := ''; Result := PAnsiChar(MySsoTokenW); end; {--------------------------- MySsoTokenW ------------------------- Purpose: Obtain a SAML token from Identity and Access Management. Parameters: None Returns: A PWideChar (string) containing XML. ------------------------------------------------------------------} function MySsoTokenW: PChar; stdcall; var Str: String; PtrToken: TXWBSSOiToken; begin Result := ''; PtrToken := nil; try PtrToken := TXWBSSOiToken.Create(nil); except end; Str := PtrToken.SSOiToken; PtrToken.Free; Result := PChar(Str); end; {--------------------------- MySsoTokenVBA ----------------------- Purpose: Obtain a SAML token from Identity and Access Management. Parameters: None Returns: StrBuff = PAnsiChar (string) containing XML, StrLen = maximum length of string to be returned. Returns integer length of string returned. ------------------------------------------------------------------} function MySsoTokenVBA(StrBuff: PAnsiChar; StrLen: Integer): Integer; stdcall; var Str: AnsiString; PtrToken: TXWBSSOiToken; begin //Result := ''; PtrToken := nil; try PtrToken := TXWBSSOiToken.Create(nil); except end; Str := AnsiString(PtrToken.SSOiToken); PtrToken.Free; System.AnsiStrings.StrPLCopy(StrBuff, Str, StrLen); Result := Length(Str); end; {--------------------------- RpcbOnFailedLoginSet ---------------- ------------------------------------------------------------------} procedure RpcbOnFailedLoginSet(const RPCBroker: TRPCBroker; Value: TOnLoginFailure); stdcall; begin try RPCBroker.Login.OnFailedLogin := Value; except on E: Exception do if not (pos('Sign-on was not completed',E.Message) > 0 )then ShowMessage('Error: ' + E.Message); end; end; {--------------------------- RpcbContextorControlPropSet --------- Purpose: CCOW - Set CCOW contextor control property. Parameters: Instance of RPCBroker Returns: A pointer to a CCOW contextor. ------------------------------------------------------------------} procedure RpcbContextorControlPropSet(const RPCBroker: TRPCBroker; Value: PTContextorControl); begin RPCBroker.Contextor := Value^; end; {--------------------------- RpcbGetCCOWtoken ------------------- Purpose: CCOW - Obtain a VistA CCOW token. Parameters: Instance of RPCBroker, CCOW context Returns: A PWideChar (string) containing CCOW token. ------------------------------------------------------------------} procedure RpcbGetCCOWtoken(const RPCBroker: TRPCBroker; Contextor: PTContextorControl; Value: PChar); begin StrPCopy(Value, RPCBroker.GetCCOWToken(Contextor^)); end; {--------------------------- RpcbIsUserCleared ------------------- Purpose: CCOW - Determine if user context is cleared. Parameters: Instance of RPCBroker (CCOW context must also exist) Returns: A Boolean result where 0=notcleared, 1=cleared. ------------------------------------------------------------------} function RpcbIsUserCleared(const RPCBroker: TRPCBroker): Boolean; begin Result := RPCBroker.IsUserCleared(); end; {--------------------------- RpcbIsUserContextPending ------------ Purpose: CCOW - Determine if user context has changed. Parameters: Instance of RPCBroker, CCOW context Returns: A Boolean result where 0=unchanged, 1=changed. ------------------------------------------------------------------} function RpcbIsUserContextPending(const RPCBroker: TRPCBroker; aContextItemCollection: IContextItemCollection): Boolean; begin Result := RPCBroker.IsUserContextPending(aContextItemCollection); end; {--------------------------- RpcbWasUserDefined ------------------ Purpose: CCOW - Determine if user context was defined. Parameters: Instance of RPCBroker Returns: A Boolean result where 0=undefined, 1=defined. ------------------------------------------------------------------} function RpcbWasUserDefined(const RPCBroker: TRPCBroker): Boolean; begin Result := RPCBroker.WasUserDefined(); end; end.