home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Doc / SYSTEM.INT < prev    next >
Encoding:
Text File  |  1999-08-11  |  31.1 KB  |  900 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Runtime Library                  }
  5. {       System Unit                                     }
  6. {                                                       }
  7. {       Copyright (C) 1988,99 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit System; { Predefined constants, types, procedures, }
  12.              { and functions (such as True, Integer, or }
  13.              { Writeln) do not have actual declarations.}
  14.              { Instead they are built into the compiler }
  15.              { and are treated as if they were declared }
  16.              { at the beginning of the System unit.     }
  17.  
  18. {$H+,I-,S-}
  19.  
  20. { L- should never be specified.
  21.  
  22.   The IDE needs to find debug hook (through the C++
  23.   compiler sometimes) for integrated debugging to
  24.   function properly.
  25.  
  26.   ILINK will generate debug info for DebugHook if
  27.   the object module has not been compiled with debug info.
  28.  
  29.   ILINK will not generate debug info for DebugHook if
  30.   the object module has been compiled with debug info.
  31.  
  32.   Thus, the Pascal compiler must be responsible for
  33.   generating the debug information for that symbol
  34.   when a debug-enabled object file is produced.
  35. }
  36.  
  37. interface
  38.  
  39. const
  40.  
  41. { Variant type codes (wtypes.h) }
  42.  
  43.   varEmpty    = $0000; { vt_empty       }
  44.   varNull     = $0001; { vt_null        }
  45.   varSmallint = $0002; { vt_i2          }
  46.   varInteger  = $0003; { vt_i4          }
  47.   varSingle   = $0004; { vt_r4          }
  48.   varDouble   = $0005; { vt_r8          }
  49.   varCurrency = $0006; { vt_cy          }
  50.   varDate     = $0007; { vt_date        }
  51.   varOleStr   = $0008; { vt_bstr        }
  52.   varDispatch = $0009; { vt_dispatch    }
  53.   varError    = $000A; { vt_error       }
  54.   varBoolean  = $000B; { vt_bool        }
  55.   varVariant  = $000C; { vt_variant     }
  56.   varUnknown  = $000D; { vt_unknown     }
  57.                        { vt_decimal $e  }
  58.                        { undefined  $f  }
  59.                        { vt_i1      $10 }
  60.   varByte     = $0011; { vt_ui1         }
  61.                        { vt_ui2     $12 }
  62.                        { vt_ui4     $13 }
  63.                        { vt_i8      $14 }
  64.   { if adding new items, update varLast, BaseTypeMap and OpTypeMap }
  65.   varStrArg   = $0048; { vt_clsid    }
  66.   varString   = $0100; { Pascal string; not OLE compatible }
  67.   varAny      = $0101;
  68.   varTypeMask = $0FFF;
  69.   varArray    = $2000;
  70.   varByRef    = $4000;
  71.  
  72. { TVarRec.VType values }
  73.  
  74.   vtInteger    = 0;
  75.   vtBoolean    = 1;
  76.   vtChar       = 2;
  77.   vtExtended   = 3;
  78.   vtString     = 4;
  79.   vtPointer    = 5;
  80.   vtPChar      = 6;
  81.   vtObject     = 7;
  82.   vtClass      = 8;
  83.   vtWideChar   = 9;
  84.   vtPWideChar  = 10;
  85.   vtAnsiString = 11;
  86.   vtCurrency   = 12;
  87.   vtVariant    = 13;
  88.   vtInterface  = 14;
  89.   vtWideString = 15;
  90.   vtInt64      = 16;
  91.  
  92. { Virtual method table entries }
  93.  
  94.   vmtSelfPtr           = -76;
  95.   vmtIntfTable         = -72;
  96.   vmtAutoTable         = -68;
  97.   vmtInitTable         = -64;
  98.   vmtTypeInfo          = -60;
  99.   vmtFieldTable        = -56;
  100.   vmtMethodTable       = -52;
  101.   vmtDynamicTable      = -48;
  102.   vmtClassName         = -44;
  103.   vmtInstanceSize      = -40;
  104.   vmtParent            = -36;
  105.   vmtSafeCallException = -32;
  106.   vmtAfterConstruction = -28;
  107.   vmtBeforeDestruction = -24;
  108.   vmtDispatch          = -20;
  109.   vmtDefaultHandler    = -16;
  110.   vmtNewInstance       = -12;
  111.   vmtFreeInstance      = -8;
  112.   vmtDestroy           = -4;
  113.  
  114.   vmtQueryInterface    = 0;
  115.   vmtAddRef            = 4;
  116.   vmtRelease           = 8;
  117.   vmtCreateObject      = 12;
  118.  
  119. type
  120.  
  121.   TObject = class;
  122.  
  123.   TClass = class of TObject;
  124.  
  125.   {$EXTERNALSYM HRESULT}
  126.   HRESULT = type Longint;  { from WTYPES.H }
  127.  
  128. {$EXTERNALSYM IUnknown}
  129. {$EXTERNALSYM IDispatch}
  130.  
  131.   PGUID = ^TGUID;
  132.   TGUID = packed record
  133.     D1: LongWord;
  134.     D2: Word;
  135.     D3: Word;
  136.     D4: array[0..7] of Byte;
  137.   end;
  138.  
  139.   PInterfaceEntry = ^TInterfaceEntry;
  140.   TInterfaceEntry = packed record
  141.     IID: TGUID;
  142.     VTable: Pointer;
  143.     IOffset: Integer;
  144.     ImplGetter: Integer;
  145.   end;
  146.  
  147.   PInterfaceTable = ^TInterfaceTable;
  148.   TInterfaceTable = packed record
  149.     EntryCount: Integer;
  150.     Entries: array[0..9999] of TInterfaceEntry;
  151.   end;
  152.  
  153.   TObject = class
  154.     constructor Create;
  155.     procedure Free;
  156.     class function InitInstance(Instance: Pointer): TObject;
  157.     procedure CleanupInstance;
  158.     function ClassType: TClass;
  159.     class function ClassName: ShortString;
  160.     class function ClassNameIs(const Name: string): Boolean;
  161.     class function ClassParent: TClass;
  162.     class function ClassInfo: Pointer;
  163.     class function InstanceSize: Longint;
  164.     class function InheritsFrom(AClass: TClass): Boolean;
  165.     class function MethodAddress(const Name: ShortString): Pointer;
  166.     class function MethodName(Address: Pointer): ShortString;
  167.     function FieldAddress(const Name: ShortString): Pointer;
  168.     function GetInterface(const IID: TGUID; out Obj): Boolean;
  169.     class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
  170.     class function GetInterfaceTable: PInterfaceTable;
  171.     function SafeCallException(ExceptObject: TObject;
  172.       ExceptAddr: Pointer): HResult; virtual;
  173.     procedure AfterConstruction; virtual;
  174.     procedure BeforeDestruction; virtual;
  175.     procedure Dispatch(var Message); virtual;
  176.     procedure DefaultHandler(var Message); virtual;
  177.     class function NewInstance: TObject; virtual;
  178.     procedure FreeInstance; virtual;
  179.     destructor Destroy; virtual;
  180.   end;
  181.  
  182.   IUnknown = interface
  183.     ['{00000000-0000-0000-C000-000000000046}']
  184.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  185.     function _AddRef: Integer; stdcall;
  186.     function _Release: Integer; stdcall;
  187.   end;
  188.  
  189.   IDispatch = interface(IUnknown)
  190.     ['{00020400-0000-0000-C000-000000000046}']
  191.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  192.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  193.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  194.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  195.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  196.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  197.   end;
  198.  
  199.   TInterfacedObject = class(TObject, IUnknown)
  200.   protected
  201.     FRefCount: Integer;
  202.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  203.     function _AddRef: Integer; stdcall;
  204.     function _Release: Integer; stdcall;
  205.   public
  206.     procedure AfterConstruction; override;
  207.     procedure BeforeDestruction; override;
  208.     class function NewInstance: TObject; override;
  209.     property RefCount: Integer;
  210.   end;
  211.  
  212.   TInterfacedClass = class of TInterfacedObject;
  213.  
  214.   TVarArrayBound = packed record
  215.     ElementCount: Integer;
  216.     LowBound: Integer;
  217.   end;
  218.  
  219.   PVarArray = ^TVarArray;
  220.   TVarArray = packed record
  221.     DimCount: Word;
  222.     Flags: Word;
  223.     ElementSize: Integer;
  224.     LockCount: Integer;
  225.     Data: Pointer;
  226.     Bounds: array[0..255] of TVarArrayBound;
  227.   end;
  228.  
  229.   PVarData = ^TVarData;
  230.   TVarData = packed record
  231.     VType: Word;
  232.     Reserved1, Reserved2, Reserved3: Word;
  233.     case Integer of
  234.       varSmallint: (VSmallint: Smallint);
  235.       varInteger:  (VInteger: Integer);
  236.       varSingle:   (VSingle: Single);
  237.       varDouble:   (VDouble: Double);
  238.       varCurrency: (VCurrency: Currency);
  239.       varDate:     (VDate: Double);
  240.       varOleStr:   (VOleStr: PWideChar);
  241.       varDispatch: (VDispatch: Pointer);
  242.       varError:    (VError: LongWord);
  243.       varBoolean:  (VBoolean: WordBool);
  244.       varUnknown:  (VUnknown: Pointer);
  245.       varByte:     (VByte: Byte);
  246.       varString:   (VString: Pointer);
  247.       varAny:      (VAny: Pointer);
  248.       varArray:    (VArray: PVarArray);
  249.       varByRef:    (VPointer: Pointer);
  250.   end;
  251.  
  252.   PShortString = ^ShortString;
  253.   PAnsiString = ^AnsiString;
  254.   PWideString = ^WideString;
  255.   PString = PAnsiString;
  256.  
  257.   PExtended = ^Extended;
  258.   PCurrency = ^Currency;
  259.   PVariant = ^Variant;
  260.   POleVariant = ^OleVariant;
  261.   PInt64 = ^Int64;
  262.  
  263.   TDateTime = type Double;
  264.   PDateTime = ^TDateTime;
  265.  
  266.   PVarRec = ^TVarRec;
  267.   TVarRec = record { do not pack this record; it is compiler-generated }
  268.     case Byte of
  269.       vtInteger:    (VInteger: Integer; VType: Byte);
  270.       vtBoolean:    (VBoolean: Boolean);
  271.       vtChar:       (VChar: Char);
  272.       vtExtended:   (VExtended: PExtended);
  273.       vtString:     (VString: PShortString);
  274.       vtPointer:    (VPointer: Pointer);
  275.       vtPChar:      (VPChar: PChar);
  276.       vtObject:     (VObject: TObject);
  277.       vtClass:      (VClass: TClass);
  278.       vtWideChar:   (VWideChar: WideChar);
  279.       vtPWideChar:  (VPWideChar: PWideChar);
  280.       vtAnsiString: (VAnsiString: Pointer);
  281.       vtCurrency:   (VCurrency: PCurrency);
  282.       vtVariant:    (VVariant: PVariant);
  283.       vtInterface:  (VInterface: Pointer);
  284.       vtWideString: (VWideString: Pointer);
  285.       vtInt64:      (VInt64: PInt64);
  286.   end;
  287.  
  288.   PMemoryManager = ^TMemoryManager;
  289.   TMemoryManager = record
  290.     GetMem: function(Size: Integer): Pointer;
  291.     FreeMem: function(P: Pointer): Integer;
  292.     ReallocMem: function(P: Pointer; Size: Integer): Pointer;
  293.   end;
  294.  
  295.   THeapStatus = record
  296.     TotalAddrSpace: Cardinal;
  297.     TotalUncommitted: Cardinal;
  298.     TotalCommitted: Cardinal;
  299.     TotalAllocated: Cardinal;
  300.     TotalFree: Cardinal;
  301.     FreeSmall: Cardinal;
  302.     FreeBig: Cardinal;
  303.     Unused: Cardinal;
  304.     Overhead: Cardinal;
  305.     HeapErrorCode: Cardinal;
  306.   end;
  307.  
  308.   PackageUnitEntry = packed record
  309.     Init, FInit : procedure;
  310.   end;
  311.  
  312.   { Compiler generated table to be processed sequentially to init & finit all package units }
  313.   { Init: 0..Max-1; Final: Last Initialized..0                                              }
  314.   UnitEntryTable = array [0..9999999] of PackageUnitEntry;
  315.   PUnitEntryTable = ^UnitEntryTable;
  316.  
  317.   PackageInfoTable = packed record
  318.     UnitCount : Integer;      { number of entries in UnitInfo array; always > 0 }
  319.     UnitInfo : PUnitEntryTable;
  320.   end;
  321.  
  322.   PackageInfo = ^PackageInfoTable;
  323.  
  324.   { Each package exports a '@GetPackageInfoTable' which can be used to retrieve }
  325.   { the table which contains compiler generated information about the package DLL }
  326.   GetPackageInfoTable = function : PackageInfo;
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343. function RaiseList: Pointer;  { Stack of current exception objects }
  344. function SetRaiseList(NewPtr: Pointer): Pointer;  { returns previous value }
  345. procedure SetInOutRes(NewValue: Integer);
  346.  
  347. var
  348.  
  349.   ExceptProc: Pointer;    { Unhandled exception handler }
  350.   ErrorProc: Pointer;     { Error handler procedure }
  351.   ExceptClsProc: Pointer; { Map an OS Exception to a Delphi class reference }
  352.   ExceptObjProc: Pointer; { Map an OS Exception to a Delphi class instance }
  353.   ExceptionClass: TClass; { Exception base class (must be Exception) }
  354.   SafeCallErrorProc: Pointer; { Safecall error handler }
  355.   AssertErrorProc: Pointer; { Assertion error handler }
  356.   AbstractErrorProc: Pointer; { Abstract method error handler }
  357.   HPrevInst: LongWord;    { Handle of previous instance - HPrevInst cannot be tested for multiple instances in Win32}
  358.   MainInstance: LongWord; { Handle of the main(.EXE) HInstance }
  359.   MainThreadID: LongWord; { ThreadID of thread that module was initialized in }
  360.   IsLibrary: Boolean;     { True if module is a DLL }
  361.   CmdShow: Integer;       { CmdShow parameter for CreateWindow }
  362.   CmdLine: PChar;         { Command line pointer }
  363.   InitProc: Pointer;      { Last installed initialization procedure }
  364.   ExitCode: Integer;      { Program result }
  365.   ExitProc: Pointer;      { Last installed exit procedure }
  366.   ErrorAddr: Pointer;     { Address of run-time error }
  367.   RandSeed: Longint;      { Base for random number generator }
  368.   IsConsole: Boolean;     { True if compiled as console app }
  369.   IsMultiThread: Boolean; { True if more than one thread }
  370.   FileMode: Byte;         { Standard mode for opening files }
  371.   Test8086: Byte;         { Will always be 2 (386 or later) }
  372.   Test8087: Byte;         { Will always be 3 (387 or later) }
  373.   TestFDIV: Shortint;     { -1: Flawed Pentium, 0: Not determined, 1: Ok }
  374.   Input: Text;            { Standard input }
  375.   Output: Text;           { Standard output }
  376.  
  377.   ClearAnyProc: Pointer;  { Handler clearing a varAny }
  378.   ChangeAnyProc: Pointer; { Handler to change any to variant }
  379.   RefAnyProc: Pointer;    { Handler to add a reference to an varAny }
  380.  
  381. var
  382.   Default8087CW: Word = $1332;{ Default 8087 control word.  FPU control
  383.                                 register is set to this value.
  384.                                 CAUTION:  Setting this to an invalid value
  385.                                           could cause unpredictable behavior. }
  386.  
  387.   HeapAllocFlags: Word = 2;   { Heap allocation flags, gmem_Moveable }
  388.   DebugHook: Byte = 0;        { 1 to notify debugger of non-Delphi exceptions
  389.                                 >1 to notify debugger of exception unwinding }
  390.   JITEnable: Byte = 0;        { 1 to call UnhandledExceptionFilter if the exception
  391.                                   is not a Pascal exception.
  392.                                 >1 to call UnhandledExceptionFilter for all exceptions }
  393.   NoErrMsg: Boolean = False;  { True causes the base RTL to not display the message box
  394.                                 when a run-time error occurs }
  395.  
  396. var
  397.   Unassigned: Variant;    { Unassigned standard constant }
  398.   Null: Variant;          { Null standard constant }
  399.   EmptyParam: OleVariant; { "Empty parameter" standard constant which can be
  400.                             passed as an optional parameter on a dual interface. }
  401.  
  402.   AllocMemCount: Integer; { Number of allocated memory blocks }
  403.   AllocMemSize: Integer;  { Total size of allocated memory blocks }
  404.  
  405. { Memory manager support }
  406.  
  407. procedure GetMemoryManager(var MemMgr: TMemoryManager);
  408. procedure SetMemoryManager(const MemMgr: TMemoryManager);
  409. function IsMemoryManagerSet: Boolean;
  410.  
  411. function SysGetMem(Size: Integer): Pointer;
  412. function SysFreeMem(P: Pointer): Integer;
  413. function SysReallocMem(P: Pointer; Size: Integer): Pointer;
  414.  
  415. function GetHeapStatus: THeapStatus;
  416.  
  417. { Thread support }
  418. type
  419.   TThreadFunc = function(Parameter: Pointer): Integer;
  420.  
  421. function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord;
  422.   ThreadFunc: TThreadFunc; Parameter: Pointer; CreationFlags: LongWord;
  423.   var ThreadId: LongWord): Integer;
  424.  
  425. procedure EndThread(ExitCode: Integer);
  426.  
  427. { Standard procedures and functions }
  428.  
  429. procedure _ChDir(const S: string);
  430. procedure __Flush(var F: Text);
  431. procedure _LGetDir(D: Byte; var S: string);
  432. procedure _SGetDir(D: Byte; var S: ShortString);
  433. function IOResult: Integer;
  434. procedure _MkDir(const S: string);
  435. procedure Move(const Source; var Dest; Count: Integer);
  436. function ParamCount: Integer;
  437. function ParamStr(Index: Integer): string;
  438. procedure Randomize;
  439. procedure _RmDir(const S: string);
  440. function UpCase(Ch: Char): Char;
  441.  
  442. { Control 8087 control word }
  443.  
  444. procedure Set8087CW(NewCW: Word);
  445.  
  446. { Wide character support procedures and functions }
  447.  
  448. function WideCharToString(Source: PWideChar): string;
  449. function WideCharLenToString(Source: PWideChar; SourceLen: Integer): string;
  450. procedure WideCharToStrVar(Source: PWideChar; var Dest: string);
  451. procedure WideCharLenToStrVar(Source: PWideChar; SourceLen: Integer;
  452.   var Dest: string);
  453. function StringToWideChar(const Source: string; Dest: PWideChar;
  454.   DestSize: Integer): PWideChar;
  455.  
  456. { OLE string support procedures and functions }
  457.  
  458. function OleStrToString(Source: PWideChar): string;
  459. procedure OleStrToStrVar(Source: PWideChar; var Dest: string);
  460. function StringToOleStr(const Source: string): PWideChar;
  461.  
  462. { Variant support procedures and functions }
  463.  
  464. procedure _VarClear(var V : Variant);
  465. procedure _VarCopy(var Dest : Variant; const Source: Variant);
  466. procedure _VarCast(var Dest : Variant; const Source: Variant; VarType: Integer);
  467. procedure _VarCastOle(var Dest : Variant; const Source: Variant; VarType: Integer);
  468. procedure VarCopyNoInd(var Dest: Variant; const Source: Variant);
  469. function VarType(const V: Variant): Integer;
  470. function VarAsType(const V: Variant; VarType: Integer): Variant;
  471. function VarIsEmpty(const V: Variant): Boolean;
  472. function VarIsNull(const V: Variant): Boolean;
  473. function VarToStr(const V: Variant): string;
  474. function VarFromDateTime(DateTime: TDateTime): Variant;
  475. function VarToDateTime(const V: Variant): TDateTime;
  476.  
  477. { Variant array support procedures and functions }
  478.  
  479. function VarArrayCreate(const Bounds: array of Integer;
  480.   VarType: Integer): Variant;
  481. function VarArrayOf(const Values: array of Variant): Variant;
  482. procedure _VarArrayRedim(var A : Variant; HighBound: Integer);
  483. function VarArrayDimCount(const A: Variant): Integer;
  484. function VarArrayLowBound(const A: Variant; Dim: Integer): Integer;
  485. function VarArrayHighBound(const A: Variant; Dim: Integer): Integer;
  486. function VarArrayLock(const A: Variant): Pointer;
  487. procedure VarArrayUnlock(const A: Variant);
  488. function VarArrayRef(const A: Variant): Variant;
  489. function VarIsArray(const A: Variant): Boolean;
  490.  
  491. { Variant IDispatch call support }
  492.  
  493. procedure _DispInvokeError;
  494.  
  495. var
  496.   VarDispProc: Pointer = @_DispInvokeError;
  497.   DispCallByIDProc: Pointer = @_DispInvokeError;
  498.  
  499. { Package/Module registration and unregistration }
  500.  
  501. type
  502.   PLibModule = ^TLibModule;
  503.   TLibModule = record
  504.     Next: PLibModule;
  505.     Instance: LongWord;
  506.     CodeInstance: LongWord;
  507.     DataInstance: LongWord;
  508.     ResInstance: LongWord;
  509.     Reserved: Integer;
  510.   end;
  511.  
  512.   TEnumModuleFunc = function (HInstance: Integer; Data: Pointer): Boolean;
  513.   {$EXTERNALSYM TEnumModuleFunc}
  514.   TEnumModuleFuncLW = function (HInstance: LongWord; Data: Pointer): Boolean;
  515.   {$EXTERNALSYM TEnumModuleFuncLW}
  516.   TModuleUnloadProc = procedure (HInstance: Integer);
  517.   {$EXTERNALSYM TModuleUnloadProc}
  518.   TModuleUnloadProcLW = procedure (HInstance: LongWord);
  519.   {$EXTERNALSYM TModuleUnloadProcLW}
  520.  
  521.   PModuleUnloadRec = ^TModuleUnloadRec;
  522.   TModuleUnloadRec = record
  523.     Next: PModuleUnloadRec;
  524.     Proc: TModuleUnloadProcLW;
  525.   end;
  526.  
  527. var
  528.   LibModuleList: PLibModule = nil;
  529.   ModuleUnloadList: PModuleUnloadRec = nil;
  530.  
  531. procedure RegisterModule(LibModule: PLibModule);
  532. procedure UnregisterModule(LibModule: PLibModule);
  533. function FindHInstance(Address: Pointer): LongWord;
  534. function FindClassHInstance(ClassType: TClass): LongWord;
  535. function FindResourceHInstance(Instance: LongWord): LongWord;
  536. function LoadResourceModule(ModuleName: PChar): LongWord;
  537. procedure EnumModules(Func: TEnumModuleFunc; Data: Pointer); overload;
  538. procedure EnumResourceModules(Func: TEnumModuleFunc; Data: Pointer); overload;
  539. procedure EnumModules(Func: TEnumModuleFuncLW; Data: Pointer); overload;
  540. procedure EnumResourceModules(Func: TEnumModuleFuncLW; Data: Pointer); overload;
  541. procedure AddModuleUnloadProc(Proc: TModuleUnloadProc); overload;
  542. procedure RemoveModuleUnloadProc(Proc: TModuleUnloadProc); overload;
  543. procedure AddModuleUnloadProc(Proc: TModuleUnloadProcLW); overload;
  544. procedure RemoveModuleUnloadProc(Proc: TModuleUnloadProcLW); overload;
  545.  
  546. { ResString support function/record }
  547.  
  548. type
  549.   PResStringRec = ^TResStringRec;
  550.   TResStringRec = packed record
  551.     Module: ^Longint;
  552.     Identifier: Integer;
  553.   end;
  554.  
  555. function LoadResString(ResStringRec: PResStringRec): string;
  556.  
  557. { Procedures and functions that need compiler magic }
  558.  
  559. procedure _COS;
  560. procedure _EXP;
  561. procedure _INT;
  562. procedure _SIN;
  563. procedure _FRAC;
  564. procedure _ROUND;
  565. procedure _TRUNC;
  566.  
  567. procedure _AbstractError;
  568. procedure _Assert(const Message, Filename: AnsiString; LineNumber: Integer);
  569. procedure _Append;
  570. procedure _Assign(var T: Text; S: ShortString);
  571. procedure _BlockRead;
  572. procedure _BlockWrite;
  573. procedure _Close;
  574. procedure _PStrCat;
  575. procedure _PStrNCat;
  576. procedure _PStrCpy;
  577. procedure _PStrNCpy;
  578. procedure _EofFile;
  579. procedure _EofText;
  580. procedure _Eoln;
  581. procedure _Erase;
  582. procedure _FilePos;
  583. procedure _FileSize;
  584. procedure _FillChar;
  585. procedure _FreeMem;
  586. procedure _GetMem;
  587. procedure _ReallocMem;
  588. procedure _Halt;
  589. procedure _Halt0;
  590. procedure _Mark;
  591. procedure _PStrCmp;
  592. procedure _AStrCmp;
  593. procedure _RandInt;
  594. procedure _RandExt;
  595. procedure _ReadRec;
  596. procedure _ReadChar;
  597. procedure _ReadLong;
  598. procedure _ReadString;
  599. procedure _ReadCString;
  600. procedure _ReadLString;
  601. procedure _ReadExt;
  602. procedure _ReadLn;
  603. procedure _Rename;
  604. procedure _Release;
  605. procedure _ResetText(var T: Text);
  606. procedure _ResetFile;
  607. procedure _RewritText(var T: Text);
  608. procedure _RewritFile;
  609. procedure _RunError;
  610. procedure _Run0Error;
  611. procedure _Seek;
  612. procedure _SeekEof;
  613. procedure _SeekEoln;
  614. procedure _SetTextBuf;
  615. procedure _StrLong;
  616. procedure _Str0Long;
  617. procedure _Truncate;
  618. procedure _ValLong;
  619. procedure _WriteRec;
  620. procedure _WriteChar;
  621. procedure _Write0Char;
  622. procedure _WriteBool;
  623. procedure _Write0Bool;
  624. procedure _WriteLong;
  625. procedure _Write0Long;
  626. procedure _WriteString;
  627. procedure _Write0String;
  628. procedure _WriteCString;
  629. procedure _Write0CString;
  630. procedure _WriteLString;
  631. procedure _Write0LString;
  632. function _WriteVariant(var T: Text; const V: Variant; Width: Integer): Pointer;
  633. function _Write0Variant(var T: Text; const V: Variant): Pointer;
  634. procedure _Write2Ext;
  635. procedure _Write1Ext;
  636. procedure _Write0Ext;
  637. procedure _WriteLn;
  638.  
  639. procedure __CToPasStr;
  640. procedure __CLenToPasStr;
  641. procedure __ArrayToPasStr;
  642. procedure __PasToCStr;
  643.  
  644. procedure __IOTest;
  645. procedure _Flush(var F: Text);
  646.  
  647. procedure _SetElem;
  648. procedure _SetRange;
  649. procedure _SetEq;
  650. procedure _SetLe;
  651. procedure _SetIntersect;
  652. procedure _SetIntersect3; { BEG only }
  653. procedure _SetUnion;
  654. procedure _SetUnion3; { BEG only }
  655. procedure _SetSub;
  656. procedure _SetSub3; { BEG only }
  657. procedure _SetExpand;
  658.  
  659. procedure _Str2Ext;
  660. procedure _Str0Ext;
  661. procedure _Str1Ext;
  662. procedure _ValExt;
  663. procedure _Pow10;
  664. procedure _Real2Ext;
  665. procedure _Ext2Real;
  666.  
  667. procedure _ObjSetup;
  668. procedure _ObjCopy;
  669. procedure _Fail;
  670. procedure _BoundErr;
  671. procedure _IntOver;
  672. procedure _StartExe;
  673. procedure _StartLib;
  674. procedure _PackageLoad  (const Table : PackageInfo);
  675. procedure _PackageUnload(const Table : PackageInfo);
  676. procedure _InitResStrings;
  677. procedure _InitResStringImports;
  678. procedure _InitImports;
  679. procedure _InitWideStrings;
  680.  
  681. procedure _ClassCreate;
  682. procedure _ClassDestroy;
  683. procedure _AfterConstruction;
  684. procedure _BeforeDestruction;
  685. procedure _IsClass;
  686. procedure _AsClass;
  687.  
  688. procedure _RaiseExcept;
  689. procedure _RaiseAgain;
  690. procedure _DoneExcept;
  691. procedure _TryFinallyExit;
  692.  
  693. procedure _CallDynaInst;
  694. procedure _CallDynaClass;
  695. procedure _FindDynaInst;
  696. procedure _FindDynaClass;
  697.  
  698. procedure _LStrClr(var S: AnsiString);
  699. procedure _LStrArrayClr{var str: AnsiString; cnt: longint};
  700. procedure _LStrAsg{var dest: AnsiString; source: AnsiString};
  701. procedure _LStrLAsg{var dest: AnsiString; source: AnsiString};
  702. procedure _LStrFromPCharLen(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
  703. procedure _LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
  704. procedure _LStrFromChar(var Dest: AnsiString; Source: AnsiChar);
  705. procedure _LStrFromWChar(var Dest: AnsiString; Source: WideChar);
  706. procedure _LStrFromPChar(var Dest: AnsiString; Source: PAnsiChar);
  707. procedure _LStrFromPWChar(var Dest: AnsiString; Source: PWideChar);
  708. procedure _LStrFromString(var Dest: AnsiString; const Source: ShortString);
  709. procedure _LStrFromArray(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
  710. procedure _LStrFromWArray(var Dest: AnsiString; Source: PWideChar; Length: Integer);
  711. procedure _LStrFromWStr(var Dest: AnsiString; const Source: WideString);
  712. procedure _LStrToString{(var Dest: ShortString; const Source: AnsiString; MaxLen: Integer)};
  713. function _LStrLen{str: AnsiString}: Longint;
  714. procedure _LStrCat{var dest: AnsiString; source: AnsiString};
  715. procedure _LStrCat3{var dest:AnsiString; source1: AnsiString; source2: AnsiString};
  716. procedure _LStrCatN{var dest:AnsiString; argCnt: Integer; ...};
  717. procedure _LStrCmp{left: AnsiString; right: AnsiString};
  718. procedure _LStrAddRef{str: AnsiString};
  719. procedure _LStrToPChar{str: AnsiString): PChar};
  720. procedure _Copy{ s : ShortString; index, count : Integer ) : ShortString};
  721. procedure _Delete{ var s : openstring; index, count : Integer };
  722. procedure _Insert{ source : ShortString; var s : openstring; index : Integer };
  723. procedure _Pos{ substr : ShortString; s : ShortString ) : Integer};
  724. procedure _SetLength{var s: ShortString; newLength: Integer};
  725. procedure _SetString{var s: ShortString: buffer: PChar; len: Integer};
  726.  
  727. procedure UniqueString(var str: string);
  728. procedure _NewAnsiString{length: Longint};      { for debugger purposes only }
  729.  
  730. procedure _LStrCopy  { const s : AnsiString; index, count : Integer) : AnsiString};
  731. procedure _LStrDelete{ var s : AnsiString; index, count : Integer };
  732. procedure _LStrInsert{ const source : AnsiString; var s : AnsiString; index : Integer };
  733. procedure _LStrPos{ const substr : AnsiString; const s : AnsiString ) : Integer};
  734. procedure _LStrSetLength{ var str: AnsiString; newLength: Integer};
  735. procedure _LStrOfChar{ c: Char; count: Integer): AnsiString };
  736.  
  737. procedure _WStrClr(var S: WideString);
  738. procedure _WStrArrayClr(var StrArray; Count: Integer);
  739. procedure _WStrAsg(var Dest: WideString; const Source: WideString);
  740. procedure _WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
  741. procedure _WStrFromPWCharLen(var Dest: WideString; Source: PWideChar; Length: Integer);
  742. procedure _WStrFromChar(var Dest: WideString; Source: AnsiChar);
  743. procedure _WStrFromWChar(var Dest: WideString; Source: WideChar);
  744. procedure _WStrFromPChar(var Dest: WideString; Source: PAnsiChar);
  745. procedure _WStrFromPWChar(var Dest: WideString; Source: PWideChar);
  746. procedure _WStrFromString(var Dest: WideString; const Source: ShortString);
  747. procedure _WStrFromArray(var Dest: WideString; Source: PAnsiChar; Length: Integer);
  748. procedure _WStrFromWArray(var Dest: WideString; Source: PWideChar; Length: Integer);
  749. procedure _WStrFromLStr(var Dest: WideString; const Source: AnsiString);
  750. procedure _WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
  751. function _WStrToPWChar(const S: WideString): PWideChar;
  752. function _WStrLen(const S: WideString): Integer;
  753. procedure _WStrCat(var Dest: WideString; const Source: WideString);
  754. procedure _WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
  755. procedure _WStrCatN{var dest:WideString; argCnt: Integer; ...};
  756. procedure _WStrCmp{left: WideString; right: WideString};
  757. function _NewWideString(Length: Integer): PWideChar;
  758. function _WStrCopy(const S: WideString; Index, Count: Integer): WideString;
  759. procedure _WStrDelete(var S: WideString; Index, Count: Integer);
  760. procedure _WStrInsert(const Source: WideString; var Dest: WideString; Index: Integer);
  761. procedure _WStrPos{ const substr : WideString; const s : WideString ) : Integer};
  762. procedure _WStrSetLength(var S: WideString; NewLength: Integer);
  763. function _WStrOfWChar(Ch: WideChar; Count: Integer): WideString;
  764. procedure _WStrAddRef{var str: WideString};
  765.  
  766. procedure _Initialize;
  767. procedure _InitializeArray;
  768. procedure _InitializeRecord;
  769. procedure _Finalize;
  770. procedure _FinalizeArray;
  771. procedure _FinalizeRecord;
  772. procedure _AddRef;
  773. procedure _AddRefArray;
  774. procedure _AddRefRecord;
  775. procedure _CopyArray;
  776. procedure _CopyRecord;
  777. procedure _CopyObject;
  778.  
  779. procedure _New;
  780. procedure _Dispose;
  781.  
  782. procedure _DispInvoke; cdecl;
  783. procedure _IntfDispCall; cdecl;
  784. procedure _IntfVarCall; cdecl;
  785.  
  786. procedure _VarToInt;
  787. procedure _VarToBool;
  788. procedure _VarToReal;
  789. procedure _VarToCurr;
  790. procedure _VarToPStr(var S; const V: Variant);
  791. procedure _VarToLStr(var S: string; const V: Variant);
  792. procedure _VarToWStr(var S: WideString; const V: Variant);
  793. procedure _VarToIntf(var Unknown: IUnknown; const V: Variant);
  794. procedure _VarToDisp(var Dispatch: IDispatch; const V: Variant);
  795. procedure _VarToDynArray(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
  796.  
  797. procedure _VarFromInt;
  798. procedure _VarFromBool;
  799. procedure _VarFromReal;
  800. procedure _VarFromTDateTime;
  801. procedure _VarFromCurr;
  802. procedure _VarFromPStr(var V: Variant; const Value: ShortString);
  803. procedure _VarFromLStr(var V: Variant; const Value: string);
  804. procedure _VarFromWStr(var V: Variant; const Value: WideString);
  805. procedure _VarFromIntf(var V: Variant; const Value: IUnknown);
  806. procedure _VarFromDisp(var V: Variant; const Value: IDispatch);
  807. procedure _VarFromDynArray(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
  808. procedure _OleVarFromPStr(var V: OleVariant; const Value: ShortString);
  809. procedure _OleVarFromLStr(var V: OleVariant; const Value: string);
  810. procedure _OleVarFromVar(var V: OleVariant; const Value: Variant);
  811.  
  812. procedure _VarAdd;
  813. procedure _VarSub;
  814. procedure _VarMul;
  815. procedure _VarDiv;
  816. procedure _VarMod;
  817. procedure _VarAnd;
  818. procedure _VarOr;
  819. procedure _VarXor;
  820. procedure _VarShl;
  821. procedure _VarShr;
  822. procedure _VarRDiv;
  823. procedure _VarCmp;
  824.  
  825. procedure _VarNeg;
  826. procedure _VarNot;
  827.  
  828. procedure _VarCopyNoInd;
  829. procedure _VarClr;
  830. procedure _VarAddRef;
  831.  
  832. { 64-bit Integer helper routines }
  833.  
  834. procedure __llmul;
  835. procedure __lldiv;
  836. procedure __lludiv;
  837. procedure __llmod;
  838. procedure __llmulo;
  839. procedure __lldivo;
  840. procedure __llmodo;
  841. procedure __llumod;
  842. procedure __llshl;
  843. procedure __llushr;
  844. procedure _WriteInt64;
  845. procedure _Write0Int64;
  846. procedure _ReadInt64;
  847. function _StrInt64(val: Int64; width: Integer): ShortString;
  848. function _Str0Int64(val: Int64): ShortString;
  849. function _ValInt64(const s: AnsiString; var code: Integer): Int64;
  850.  
  851. { Dynamic array helper functions }
  852.  
  853. procedure _DynArrayHigh;
  854. procedure _DynArrayClear(var a: Pointer; typeInfo: Pointer);
  855. procedure _DynArrayLength;
  856. procedure _DynArraySetLength;
  857. procedure _DynArrayCopy(a: Pointer; typeInfo: Pointer; var Result: Pointer);
  858. procedure _DynArrayCopyRange(a: Pointer; typeInfo: Pointer; index, count : Integer; var Result: Pointer);
  859. procedure _DynArrayAsg;
  860. procedure _DynArrayAddRef;
  861. procedure  DynArrayToVariant(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
  862. procedure  DynArrayFromVariant(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
  863.  
  864. procedure _IntfClear(var Dest: IUnknown);
  865. procedure _IntfCopy(var Dest: IUnknown; const Source: IUnknown);
  866. procedure _IntfCast(var Dest: IUnknown; const Source: IUnknown; const IID: TGUID);
  867. procedure _IntfAddRef(const Dest: IUnknown);
  868.  
  869. function _VarArrayGet(var A: Variant; IndexCount: Integer;
  870.   Indices: Integer): Variant; cdecl;
  871. procedure _VarArrayPut(var A: Variant; const Value: Variant;
  872.   IndexCount: Integer; Indices: Integer); cdecl;
  873.  
  874. procedure _HandleAnyException;
  875. procedure _HandleOnException;
  876. procedure _HandleFinally;
  877. procedure _HandleAutoException;
  878.  
  879. procedure _FSafeDivide;
  880. procedure _FSafeDivideR;
  881.  
  882. procedure _CheckAutoResult;
  883.  
  884. procedure FPower10;
  885.  
  886. procedure TextStart;
  887.  
  888. function  CompToDouble(acomp: Comp): Double; cdecl;
  889. procedure DoubleToComp(adouble: Double; var result: Comp); cdecl;
  890. function  CompToCurrency(acomp: Comp): Currency; cdecl;
  891. procedure CurrencyToComp(acurrency: Currency; var result: Comp); cdecl;
  892.  
  893. function GetMemory(Size: Integer): Pointer; cdecl;
  894. function FreeMemory(P: Pointer): Integer; cdecl;
  895. function ReallocMemory(P: Pointer; Size: Integer): Pointer; cdecl;
  896.  
  897. (* =================================================================== *)
  898.  
  899. implementation
  900.