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