unit uPSRuntime;

SysUtils, uPSUtils{$IFDEF DELPHI6UP}, variants{$ENDIF}{$IFDEF MACOS},uPSCMac{$ELSE}{$IFNDEF PS_NOIDISPATCH}{$IFDEF DELPHI3UP}, ActiveX, Windows{$ELSE}, Ole2{$ENDIF}{$ENDIF}{$ENDIF};

TPSExec = class;

TPSStack = class;

TPSRuntimeAttributes = class;

TPSRuntimeAttribute = class;

TPSError = (ErNoError, erCannotImport, erInvalidType, ErInternalError,

erInvalidHeader, erInvalidOpcode, erInvalidOpcodeParameter, erNoMainProc,

erOutOfGlobalVarsRange, erOutOfProcRange, ErOutOfRange, erOutOfStackRange,

ErTypeMismatch, erUnexpectedEof, erVersionError, ErDivideByZero, ErMathError,

erCouldNotCallProc, erOutofRecordRange, erOutOfMemory, erException,

erNullPointerException, erNullVariantError, erInterfaceNotSupported, erCustomError);

TPSStatus = (isNotLoaded, isLoaded, isRunning, isPaused);

PByteArray = ^TByteArray;

TByteArray = array[0..1023] of Byte;

PDWordArray = ^TDWordArray;

TDWordArray = array[0..1023] of Cardinal;

TPSProcRec = class;

TIFProcRec = TPSProcRec;

TPSExternalProcRec = class;

TIFPSExternalProcRec = TPSExternalProcRec;

TIFExternalProcRec = TPSExternalProcRec;

PIFProcRec = TPSProcRec;

PProcRec = ^TProcRec;

TPSProcPtr = function(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;

TPSFreeProc = procedure (Caller: TPSExec; p: PProcRec);

TPSProcRec = class

private

FAttributes: TPSRuntimeAttributes;

public

constructor Create(Owner: TPSExec);

destructor Destroy; override;

property Attributes: TPSRuntimeAttributes read FAttributes;

end;

TPSExternalProcRec = class(TPSProcRec)

private

FExt1: Pointer;

FExt2: Pointer;

FName: tbtstring;

FProcPtr: TPSProcPtr;

FDecl: tbtstring;

public

property Name: tbtstring read FName write FName;

property Decl: tbtstring read FDecl write FDecl;

property Ext1: Pointer read FExt1 write FExt1;

property Ext2: Pointer read FExt2 write FExt2;

property ProcPtr: TPSProcPtr read FProcPtr write FProcPtr;

end;

TPSInternalProcRec = class(TPSProcRec)

private

FData: PByteArray;

FLength: Cardinal;

FExportNameHash: Longint;

FExportDecl: tbtstring;

FExportName: tbtstring;

public

property Data: PByteArray read FData;

property Length: Cardinal read FLength;

property ExportNameHash: Longint read FExportNameHash;

property ExportName: tbtstring read FExportName write FExportName;

property ExportDecl: tbtstring read FExportDecl write FExportDecl;

destructor Destroy; override;

end;

TProcRec = record

Name: ShortString;

Hash: Longint;

ProcPtr: TPSProcPtr;

FreeProc: TPSFreeProc;

Ext1, Ext2: Pointer;

end;

PBTReturnAddress = ^TBTReturnAddress;

TBTReturnAddress = packed record

ProcNo: TPSInternalProcRec;

Position, StackBase: Cardinal;

end;

TPSTypeRec = class

private

FExportNameHash: Longint;

FExportName: tbtstring;

FBaseType: TPSBaseType;

FAttributes: TPSRuntimeAttributes;

protected

FRealSize: Cardinal;

public

property RealSize: Cardinal read FRealSize;

property BaseType: TPSBaseType read FBaseType write FBaseType;

property ExportName: tbtstring read FExportName write FExportName;

property ExportNameHash: Longint read FExportNameHash write FExportNameHash;

property Attributes: TPSRuntimeAttributes read FAttributes write FAttributes;

procedure CalcSize; virtual;

constructor Create(Owner: TPSExec);

destructor Destroy; override;

end;

TPSTypeRec_ProcPtr = class(TPSTypeRec)

private

FParamInfo: tbtstring;

public

property ParamInfo: tbtstring read FParamInfo write FParamInfo;

procedure CalcSize; override;

end;

PIFTypeRec = TPSTypeRec;

TPSTypeRec_Class = class(TPSTypeRec)

private

FCN: tbtstring;

public

property CN: tbtstring read FCN write FCN;

end;

TPSTypeRec_Interface = class(TPSTypeRec)

private

FGuid: TGUID;

public

property Guid: TGUID read FGuid write FGuid;

end;

TPSTypeRec_Array = class(TPSTypeRec)

private

FArrayType: TPSTypeRec;

public

property ArrayType: TPSTypeRec read FArrayType write FArrayType;

procedure CalcSize; override;

end;

TPSTypeRec_StaticArray = class(TPSTypeRec_Array)

private

FSize: Longint;

FStartOffset: LongInt;

public

property Size: Longint read FSize write FSize;

property StartOffset: LongInt read FStartOffset write FStartOffset;

procedure CalcSize; override;

end;

TPSTypeRec_Set = class(TPSTypeRec)

private

FBitSize: Longint;

FByteSize: Longint;

public

{The number of bytes this would require (same as realsize)}

property aByteSize: Longint read FByteSize write FByteSize;

property aBitSize: Longint read FBitSize write FBitSize;

procedure CalcSize; override;

end;

TPSTypeRec_Record = class(TPSTypeRec)

private

FFieldTypes: TPSList;

FRealFieldOffsets: TPSList;

public

property FieldTypes: TPSList read FFieldTypes;

property RealFieldOffsets: TPSList read FRealFieldOffsets;

procedure CalcSize; override;

constructor Create(Owner: TPSExec);

destructor Destroy; override;

end;

PPSVariant = ^TPSVariant;

PIFVariant = PPSVariant;

TPSVariant = packed record

FType: TPSTypeRec;

end;

PPSVariantData = ^TPSVariantData;

TPSVariantData = packed record

VI: TPSVariant;

Data: array[0..0] of Byte;

end;

PPSVariantU8 = ^TPSVariantU8;

TPSVariantU8 = packed record

VI: TPSVariant;

Data: tbtU8;

end;

PPSVariantS8 = ^TPSVariantS8;

TPSVariantS8 = packed record

VI: TPSVariant;

Data: tbts8;

end;

PPSVariantU16 = ^TPSVariantU16;

TPSVariantU16 = packed record

VI: TPSVariant;

Data: tbtU16;

end;

PPSVariantS16 = ^TPSVariantS16;

TPSVariantS16 = packed record

VI: TPSVariant;

Data: tbts16;

end;

PPSVariantU32 = ^TPSVariantU32;

TPSVariantU32 = packed record

VI: TPSVariant;

Data: tbtU32;

end;

PPSVariantS32 = ^TPSVariantS32;

TPSVariantS32 = packed record

VI: TPSVariant;

Data: tbts32;

end;

PPSVariantS64 = ^TPSVariantS64;

TPSVariantS64 = packed record

VI: TPSVariant;

Data: tbts64;

end;

PPSVariantAChar = ^TPSVariantAChar;

TPSVariantAChar = packed record

VI: TPSVariant;

Data: tbtChar;

end;

PPSVariantWChar = ^TPSVariantWChar;

TPSVariantWChar = packed record

VI: TPSVariant;

Data: tbtWideChar;

end;

PPSVariantAString = ^TPSVariantAString;

TPSVariantAString = packed record

VI: TPSVariant;

Data: tbtString;

end;

PPSVariantWString = ^TPSVariantWString;

TPSVariantWString = {$IFNDEF DELPHI2009UP}packed {$ENDIF}record

VI: TPSVariant;

Data: tbtWideString;

end;

PPSVariantUString = ^TPSVariantUString;

TPSVariantUString = {$IFNDEF DELPHI2009UP}packed {$ENDIF}record

VI: TPSVariant;

Data: tbtunicodestring;

end;

PPSVariantSingle = ^TPSVariantSingle;

TPSVariantSingle = packed record

VI: TPSVariant;

Data: tbtsingle;

end;

PPSVariantDouble = ^TPSVariantDouble;

TPSVariantDouble = packed record

VI: TPSVariant;

Data: tbtDouble;

end;

PPSVariantExtended = ^TPSVariantExtended;

TPSVariantExtended = packed record

VI: TPSVariant;

Data: tbtExtended;

end;

PPSVariantCurrency = ^TPSVariantCurrency;

TPSVariantCurrency = packed record

VI: TPSVariant;

Data: tbtCurrency;

end;

PPSVariantSet = ^TPSVariantSet;

TPSVariantSet = packed record

VI: TPSVariant;

Data: array[0..0] of Byte;

end;

PPSVariantInterface = ^TPSVariantInterface;

TPSVariantInterface = packed record

VI: TPSVariant;

Data: IUnknown;

end;

PPSVariantClass = ^TPSVariantClass;

TPSVariantClass = packed record

VI: TPSVariant;

Data: TObject;

end;

PPSVariantRecord = ^TPSVariantRecord;

TPSVariantRecord = packed record

VI: TPSVariant;

data: array[0..0] of byte;

end;

PPSVariantDynamicArray = ^TPSVariantDynamicArray;

TPSVariantDynamicArray = packed record

VI: TPSVariant;

Data: Pointer;

end;

PPSVariantStaticArray = ^TPSVariantStaticArray;

TPSVariantStaticArray = packed record

VI: TPSVariant;

data: array[0..0] of byte;

end;

PPSVariantPointer = ^TPSVariantPointer;

TPSVariantPointer = packed record

VI: TPSVariant;

DataDest: Pointer;

DestType: TPSTypeRec;

FreeIt: LongBool;

end;

PPSVariantReturnAddress = ^TPSVariantReturnAddress;

TPSVariantReturnAddress = packed record

VI: TPSVariant;

Addr: TBTReturnAddress;

end;

PPSVariantVariant = ^TPSVariantVariant;

TPSVariantVariant = packed record

VI: TPSVariant;

Data: Variant;

end;

PPSVariantProcPtr = ^TPSVariantProcPtr;

TPSVariantProcPtr = packed record

VI: TPSVariant;

ProcNo: Cardinal;

Self: Pointer;

Ptr: Pointer;

{

end;

TPSVarFreeType = (

vtNone,

vtTempVar

);

TPSResultData = packed record

P: Pointer;

aType: TPSTypeRec;

FreeType: TPSVarFreeType;

end;

PPSResource = ^TPSResource;

TPSResource = record

Proc: Pointer;

P: Pointer;

end;

TPSAttributeUseProc = function (Sender: TPSExec; const AttribType: tbtstring; Attr: TPSRuntimeAttribute): Boolean;

TPSAttributeType = class

private

FTypeName: tbtstring;

FUseProc: TPSAttributeUseProc;

FTypeNameHash: Longint;

public

property UseProc: TPSAttributeUseProc read FUseProc write FUseProc;

property TypeName: tbtstring read FTypeName write FTypeName;

property TypeNameHash: Longint read FTypeNameHash write FTypeNameHash;

end;

PClassItem = ^TClassItem;

TClassItem = record

FName: tbtstring;

FNameHash: Longint;

b: byte;

case byte of

0: (Ptr: Pointer);

1: (PointerInList: Pointer);

3: (FReadFunc, FWriteFunc: Pointer); {Property Helper}

4: (Ptr2: Pointer);

5: (PointerInList2: Pointer);

6: (); {Property helper, like 3}

7: (); {Property helper that will pass it's name}

8: (ProcPtr: TPSProcPtr; Ext1, Ext2: Pointer);

9: (ReadProcPtr, WriteProcPtr: TPSProcPtr; ExtRead1, ExtRead2, ExtWrite1, ExtWrite2: Pointer); {Property Helper}

end;

PPSVariantIFC = ^TPSVariantIFC;

{Temporary variant into record}

TPSVariantIFC = packed record

Dta: Pointer;

aType: TPSTypeRec;

VarParam: Boolean;

end;

PIFPSVariantIFC = PPSVariantIFC;

TIFPSVariantIFC = TPSVariantIFC;

TPSRuntimeAttribute = class(TObject)

private

FValues: TPSStack;

FAttribType: tbtstring;

FOwner: TPSRuntimeAttributes;

FAttribTypeHash: Longint;

function GetValue(I: Longint): PIFVariant;

function GetValueCount: Longint;

public

property Owner: TPSRuntimeAttributes read FOwner;

property AttribType: tbtstring read FAttribType write FAttribType;

property AttribTypeHash: Longint read FAttribTypeHash write FAttribTypeHash;

property ValueCount: Longint read GetValueCount;

property Value[I: Longint]: PIFVariant read GetValue;

function AddValue(aType: TPSTypeRec): PPSVariant;

procedure DeleteValue(i: Longint);

procedure AdjustSize;

constructor Create(Owner: TPSRuntimeAttributes);

destructor Destroy; override;

end;

TPSRuntimeAttributes = class(TObject)

private

FAttributes: TPSList;

FOwner: TPSExec;

function GetCount: Longint;

function GetItem(I: Longint): TPSRuntimeAttribute;

public

property Owner: TPSExec read FOwner;

property Count: Longint read GetCount;

property Items[I: Longint]: TPSRuntimeAttribute read GetItem; default;

procedure Delete(I: Longint);

function Add: TPSRuntimeAttribute;

function FindAttribute(const Name: tbtstring): TPSRuntimeAttribute;

constructor Create(AOwner: TPSExec);

destructor Destroy; override;

end;

TPSOnGetNVariant = function (Sender: TPSExec; const Name: tbtstring): Variant;

TPSOnSetNVariant = procedure (Sender: TPSExec; const Name: tbtstring; V: Variant);

TPSOnLineEvent = procedure(Sender: TPSExec);

TPSOnSpecialProcImport = function (Sender: TPSExec; p: TPSExternalProcRec; Tag: Pointer): Boolean;

TPSOnException = procedure (Sender: TPSExec; ExError: TPSError; const ExParam: tbtstring; ExObject: TObject; ProcNo, Position: Cardinal);

TPSExec = class(TObject)

Private

FOnGetNVariant: TPSOnGetNVariant;

FOnSetNVariant: TPSOnSetNVariant;

FId: Pointer;

FJumpFlag: Boolean;

FCallCleanup: Boolean;

FOnException: TPSOnException;

function ReadData(var Data; Len: Cardinal): Boolean;

function ReadLong(var b: Cardinal): Boolean;

function DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; CalcType: Cardinal): Boolean;

function DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, intotype: TPSTypeRec; Cmd: Cardinal): Boolean;

function SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeRec): Boolean;

function ReadVariable(var Dest: TPSResultData; UsePointer: Boolean): Boolean;

function DoBooleanNot(Dta: Pointer; aType: TPSTypeRec): Boolean;

function DoMinus(Dta: Pointer; aType: TPSTypeRec): Boolean;

function DoIntegerNot(Dta: Pointer; aType: TPSTypeRec): Boolean;

procedure RegisterStandardProcs;

Protected

FReturnAddressType: TPSTypeRec;

FVariantType: TPSTypeRec;

FVariantArrayType: TPSTypeRec;

FAttributeTypes: TPSList;

FExceptionStack: TPSList;

FResources: TPSList;

FExportedVars: TPSList;

FTypes: TPSList;

FProcs: TPSList;

FGlobalVars: TPSStack;

FTempVars: TPSStack;

FStack: TPSStack;

FMainProc: Cardinal;

FStatus: TPSStatus;

FCurrProc: TPSInternalProcRec;

FData: PByteArray;

FDataLength: Cardinal;

FCurrentPosition: Cardinal;

FCurrStackBase: Cardinal;

FOnRunLine: TPSOnLineEvent;

FSpecialProcList: TPSList;

FRegProcs: TPSList;

ExObject: TObject;

ExProc: Cardinal;

ExPos: Cardinal;

ExEx: TPSError;

ExParam: tbtstring;

function InvokeExternalMethod(At: TPSTypeRec_ProcPtr; Slf, Ptr: Pointer): Boolean;

function InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;

procedure RunLine; virtual;

function ImportProc(const Name: ShortString; proc: TPSExternalProcRec): Boolean; Virtual;

procedure ExceptionProc(proc, Position: Cardinal; Ex: TPSError; const s: tbtstring; NewObject: TObject); Virtual;

function FindSpecialProcImport(P: TPSOnSpecialProcImport): pointer;

Public

function LastEx: TPSError;

function LastExParam: tbtstring;

function LastExProc: Integer;

function LastExPos: Integer;

function LastExObject: TObject;

procedure CMD_Err(EC: TPSError);

procedure CMD_Err2(EC: TPSError; const Param: tbtstring);

procedure CMD_Err3(EC: TPSError; const Param: tbtstring; ExObject: TObject);

property Id: Pointer read FID write FID;

class function About: tbtstring;

function RunProc(Params: TPSList; ProcNo: Cardinal): Boolean;

function RunProcP(const Params: array of Variant; const Procno: Cardinal): Variant;

function RunProcPVar(var Params: array of Variant; const Procno: Cardinal): Variant;

function RunProcPN(const Params: array of Variant; const ProcName: tbtstring): Variant;

function FindType(StartAt: Cardinal; BaseType: TPSBaseType; var l: Cardinal): PIFTypeRec;

function FindType2(BaseType: TPSBaseType): PIFTypeRec;

function GetTypeNo(l: Cardinal): PIFTypeRec;

function GetType(const Name: tbtstring): Cardinal;

function GetProc(const Name: tbtstring): Cardinal;

function GetVar(const Name: tbtstring): Cardinal;

function GetVar2(const Name: tbtstring): PIFVariant;

function GetVarNo(C: Cardinal): PIFVariant;

function GetProcNo(C: Cardinal): PIFProcRec;

function GetProcCount: Cardinal;

function GetVarCount: Longint;

function GetTypeCount: Longint;

constructor Create;

destructor Destroy; Override;

function RunScript: Boolean;

function LoadData(const s: tbtstring): Boolean; virtual;

procedure Clear; Virtual;

procedure Cleanup; Virtual;

procedure Stop; Virtual;

procedure Pause; Virtual;

property CallCleanup: Boolean read FCallCleanup write FCallCleanup;

property Status: TPSStatus Read FStatus;

property OnRunLine: TPSOnLineEvent Read FOnRunLine Write FOnRunLine;

procedure ClearspecialProcImports;

procedure AddSpecialProcImport(const FName: tbtstring; P: TPSOnSpecialProcImport; Tag: Pointer);

function RegisterFunctionName(const Name: tbtstring; ProcPtr: TPSProcPtr;

Ext1, Ext2: Pointer): PProcRec;

procedure RegisterDelphiFunction(ProcPtr: Pointer; const Name: tbtstring; CC: TPSCallingConvention);

procedure RegisterDelphiMethod(Slf, ProcPtr: Pointer; const Name: tbtstring; CC: TPSCallingConvention);

function GetProcAsMethod(const ProcNo: Cardinal): TMethod;

function GetProcAsMethodN(const ProcName: tbtstring): TMethod;

procedure RegisterAttributeType(useproc: TPSAttributeUseProc; const TypeName: tbtstring);

procedure ClearFunctionList;

property ExceptionProcNo: Cardinal Read ExProc;

property ExceptionPos: Cardinal Read ExPos;

property ExceptionCode: TPSError Read ExEx;

property ExceptionString: tbtstring read ExParam;

property ExceptionObject: TObject read ExObject write ExObject;

procedure AddResource(Proc, P: Pointer);

function IsValidResource(Proc, P: Pointer): Boolean;

procedure DeleteResource(P: Pointer);

function FindProcResource(Proc: Pointer): Pointer;

function FindProcResource2(Proc: Pointer; var StartAt: Longint): Pointer;

procedure RaiseCurrentException;

property OnException: TPSOnException read FOnException write FOnException;

property OnGetNVariant: TPSOnGetNVariant read FOnGetNVariant write FOnGetNVariant;

property OnSetNVariant: TPSOnSetNVariant read FOnSetNVariant write FOnSetNVariant;

end;

TPSStack = class(TPSList)

private

FDataPtr: Pointer;

FCapacity,

FLength: Longint;

function GetItem(I: Longint): PPSVariant;

procedure SetCapacity(const Value: Longint);

procedure AdjustLength;

public

property DataPtr: Pointer read FDataPtr;

property Capacity: Longint read FCapacity write SetCapacity;

property Length: Longint read FLength;

constructor Create;

destructor Destroy; override;

procedure Clear; {$IFDEF DELPHI5UP} reintroduce;{$ELSE} override; {$ENDIF}

function Push(TotalSize: Longint): PPSVariant;

function PushType(aType: TPSTypeRec): PPSVariant;

procedure Pop;

function GetInt(ItemNo: Longint): Longint;

function GetUInt(ItemNo: Longint): Cardinal;

function GetInt64(ItemNo: Longint): Int64;

function GetString(ItemNo: Longint): string; // calls the native method

function GetAnsiString(ItemNo: Longint): tbtstring;

function GetWideString(ItemNo: Longint): tbtWideString;

function GetUnicodeString(ItemNo: Longint): tbtunicodestring;

function GetReal(ItemNo: Longint): Extended;

function GetCurrency(ItemNo: Longint): Currency;

function GetBool(ItemNo: Longint): Boolean;

function GetClass(ItemNo: Longint): TObject;

procedure SetInt(ItemNo: Longint; const Data: Longint);

procedure SetUInt(ItemNo: Longint; const Data: Cardinal);

procedure SetInt64(ItemNo: Longint; const Data: Int64);

procedure SetString(ItemNo: Longint; const Data: string);

procedure SetAnsiString(ItemNo: Longint; const Data: tbtstring);

procedure SetWideString(ItemNo: Longint; const Data: tbtWideString);

procedure SetUnicodeString(ItemNo: Longint; const Data: tbtunicodestring);

procedure SetReal(ItemNo: Longint; const Data: Extended);

procedure SetCurrency(ItemNo: Longint; const Data: Currency);

procedure SetBool(ItemNo: Longint; const Data: Boolean);

procedure SetClass(ItemNo: Longint; const Data: TObject);

property Items[I: Longint]: PPSVariant read GetItem; default;

end;

function PSErrorToString(x: TPSError; const Param: tbtstring): tbtstring;

function TIFErrorToString(x: TPSError; const Param: tbtstring): tbtstring;

function CreateHeapVariant(aType: TPSTypeRec): PPSVariant;

procedure DestroyHeapVariant(v: PPSVariant);

procedure FreePIFVariantList(l: TPSList);

procedure FreePSVariantList(l: TPSList);

ENoError = ERNoError;

function PIFVariantToVariant(Src: PIFVariant; var Dest: Variant): Boolean;

function VariantToPIFVariant(Exec: TPSExec; const Src: Variant; Dest: PIFVariant): Boolean;

function PSGetRecField(const avar: TPSVariantIFC; Fieldno: Longint): TPSVariantIFC;

function PSGetArrayField(const avar: TPSVariantIFC; Fieldno: Longint): TPSVariantIFC;

function NewTPSVariantRecordIFC(avar: PPSVariant; Fieldno: Longint): TPSVariantIFC;

function NewTPSVariantIFC(avar: PPSVariant; varparam: boolean): TPSVariantIFC;

function NewPPSVariantIFC(avar: PPSVariant; varparam: boolean): PPSVariantIFC;

procedure DisposePPSVariantIFC(aVar: PPSVariantIFC);

procedure DisposePPSVariantIFCList(list: TPSList);

function PSGetObject(Src: Pointer; aType: TPSTypeRec): TObject;

function PSGetUInt(Src: Pointer; aType: TPSTypeRec): Cardinal;

function PSGetInt64(Src: Pointer; aType: TPSTypeRec): Int64;

function PSGetReal(Src: Pointer; aType: TPSTypeRec): Extended;

function PSGetCurrency(Src: Pointer; aType: TPSTypeRec): Currency;

function PSGetInt(Src: Pointer; aType: TPSTypeRec): Longint;

function PSGetString(Src: Pointer; aType: TPSTypeRec): string;

function PSGetAnsiString(Src: Pointer; aType: TPSTypeRec): tbtString;

function PSGetWideString(Src: Pointer; aType: TPSTypeRec): tbtWideString;

function PSGetUnicodeString(Src: Pointer; aType: TPSTypeRec): tbtunicodestring;

procedure PSSetObject(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; Const val: TObject);

procedure PSSetUInt(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Cardinal);

procedure PSSetInt64(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Int64);

procedure PSSetReal(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Extended);

procedure PSSetCurrency(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Currency);

procedure PSSetInt(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Longint);

procedure PSSetString(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: String);

procedure PSSetAnsiString(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: tbtString);

procedure PSSetWideString(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: tbtWideString);

procedure PSSetUnicodeString(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: tbtunicodestring);

procedure VNSetPointerTo(const Src: TPSVariantIFC; Data: Pointer; aType: TPSTypeRec);

function VNGetUInt(const Src: TPSVariantIFC): Cardinal;

function VNGetInt64(const Src: TPSVariantIFC): Int64;

function VNGetReal(const Src: TPSVariantIFC): Extended;

function VNGetCurrency(const Src: TPSVariantIFC): Currency;

function VNGetInt(const Src: TPSVariantIFC): Longint;

function VNGetString(const Src: TPSVariantIFC): String;

function VNGetAnsiString(const Src: TPSVariantIFC): tbtString;

function VNGetWideString(const Src: TPSVariantIFC): tbtWideString;

function VNGetUnicodeString(const Src: TPSVariantIFC): tbtunicodestring;

procedure VNSetUInt(const Src: TPSVariantIFC; const Val: Cardinal);

procedure VNSetInt64(const Src: TPSVariantIFC; const Val: Int64);

procedure VNSetReal(const Src: TPSVariantIFC; const Val: Extended);

procedure VNSetCurrency(const Src: TPSVariantIFC; const Val: Currency);

procedure VNSetInt(const Src: TPSVariantIFC; const Val: Longint);

procedure VNSetString(const Src: TPSVariantIFC; const Val: String);

procedure VNSetAnsiString(const Src: TPSVariantIFC; const Val: tbtString);

procedure VNSetWideString(const Src: TPSVariantIFC; const Val: tbtWideString);

procedure VNSetUnicodeString(const Src: TPSVariantIFC; const Val: tbtunicodestring);

function VGetUInt(const Src: PIFVariant): Cardinal;

function VGetInt64(const Src: PIFVariant): Int64;

function VGetReal(const Src: PIFVariant): Extended;

function VGetCurrency(const Src: PIFVariant): Currency;

function VGetInt(const Src: PIFVariant): Longint;

function VGetString(const Src: PIFVariant): String;

function VGetAnsiString(const Src: PIFVariant): tbtString;

function VGetWideString(const Src: PIFVariant): tbtWideString;

function VGetUnicodeString(const Src: PIFVariant): tbtunicodestring;

procedure VSetPointerTo(const Src: PIFVariant; Data: Pointer; aType: TPSTypeRec);

procedure VSetUInt(const Src: PIFVariant; const Val: Cardinal);

procedure VSetInt64(const Src: PIFVariant; const Val: Int64);

procedure VSetReal(const Src: PIFVariant; const Val: Extended);

procedure VSetCurrency(const Src: PIFVariant; const Val: Currency);

procedure VSetInt(const Src: PIFVariant; const Val: Longint);

procedure VSetString(const Src: PIFVariant; const Val: string);

procedure VSetAnsiString(const Src: PIFVariant; const Val: tbtString);

procedure VSetWideString(const Src: PIFVariant; const Val: tbtWideString);

procedure VSetUnicodeString(const Src: PIFVariant; const Val: tbtunicodestring);

EPSException = class(Exception)

private

FProcPos: Cardinal;

FProcNo: Cardinal;

FExec: TPSExec;

public

constructor Create(const Error: tbtstring; Exec: TPSExec; Procno, ProcPos: Cardinal);

property ProcNo: Cardinal read FProcNo;

property ProcPos: Cardinal read FProcPos;

property Exec: TPSExec read FExec;

end;

TPSRuntimeClass = class

protected

FClassName: tbtstring;

FClassNameHash: Longint;