home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1996 August / VPR9608A.BIN / del20try / install / data.z / SYSTEM.INT < prev    next >
Text File  |  1996-05-08  |  17KB  |  538 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Runtime Library                          }
  4. {       System Unit                                     }
  5. {                                                       }
  6. {       Copyright (C) 1988,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit System;
  11.  
  12. {$H+,I-,S-}
  13.  
  14. interface
  15.  
  16. const
  17.  
  18. { Variant type codes }
  19.  
  20.   varEmpty    = $0000;
  21.   varNull     = $0001;
  22.   varSmallint = $0002;
  23.   varInteger  = $0003;
  24.   varSingle   = $0004;
  25.   varDouble   = $0005;
  26.   varCurrency = $0006;
  27.   varDate     = $0007;
  28.   varOleStr   = $0008;
  29.   varDispatch = $0009;
  30.   varError    = $000A;
  31.   varBoolean  = $000B;
  32.   varVariant  = $000C;
  33.   varUnknown  = $000D;
  34.   varByte     = $0011;
  35.   varString   = $0100;
  36.   varTypeMask = $0FFF;
  37.   varArray    = $2000;
  38.   varByRef    = $4000;
  39.  
  40. { TVarRec.VType values }
  41.  
  42.   vtInteger    = 0;
  43.   vtBoolean    = 1;
  44.   vtChar       = 2;
  45.   vtExtended   = 3;
  46.   vtString     = 4;
  47.   vtPointer    = 5;
  48.   vtPChar      = 6;
  49.   vtObject     = 7;
  50.   vtClass      = 8;
  51.   vtWideChar   = 9;
  52.   vtPWideChar  = 10;
  53.   vtAnsiString = 11;
  54.   vtCurrency   = 12;
  55.   vtVariant    = 13;
  56.  
  57. type
  58.  
  59.   TObject = class;
  60.  
  61.   TClass = class of TObject;
  62.  
  63.   TObject = class
  64.     constructor Create;
  65.     procedure Free;
  66.     class function InitInstance(Instance: Pointer): TObject;
  67.     procedure CleanupInstance;
  68.     function ClassType: TClass;
  69.     class function ClassName: ShortString;
  70.     class function ClassNameIs(const Name: string): Boolean;
  71.     class function ClassParent: TClass;
  72.     class function ClassInfo: Pointer;
  73.     class function InstanceSize: Longint;
  74.     class function InheritsFrom(AClass: TClass): Boolean;
  75.     procedure Dispatch(var Message);
  76.     class function MethodAddress(const Name: ShortString): Pointer;
  77.     class function MethodName(Address: Pointer): ShortString;
  78.     function FieldAddress(const Name: ShortString): Pointer;
  79.     procedure DefaultHandler(var Message); virtual;
  80.     class function NewInstance: TObject; virtual;
  81.     procedure FreeInstance; virtual;
  82.     destructor Destroy; virtual;
  83.   end;
  84.  
  85.   TVarArrayBound = record
  86.     ElementCount: Integer;
  87.     LowBound: Integer;
  88.   end;
  89.  
  90.   PVarArray = ^TVarArray;
  91.   TVarArray = record
  92.     DimCount: Word;
  93.     Flags: Word;
  94.     ElementSize: Integer;
  95.     LockCount: Integer;
  96.     Data: Pointer;
  97.     Bounds: array[0..255] of TVarArrayBound;
  98.   end;
  99.  
  100.   PVarData = ^TVarData;
  101.   TVarData = record
  102.     VType: Word;
  103.     Reserved1, Reserved2, Reserved3: Word;
  104.     case Integer of
  105.       varSmallint: (VSmallint: Smallint);
  106.       varInteger:  (VInteger: Integer);
  107.       varSingle:   (VSingle: Single);
  108.       varDouble:   (VDouble: Double);
  109.       varCurrency: (VCurrency: Currency);
  110.       varDate:     (VDate: Double);
  111.       varOleStr:   (VOleStr: PWideChar);
  112.       varDispatch: (VDispatch: Pointer);
  113.       varError:    (VError: Integer);
  114.       varBoolean:  (VBoolean: WordBool);
  115.       varUnknown:  (VUnknown: Pointer);
  116.       varByte:     (VByte: Byte);
  117.       varString:   (VString: Pointer);
  118.       varArray:    (VArray: PVarArray);
  119.       varByRef:    (VPointer: Pointer);
  120.   end;
  121.  
  122.   PShortString = ^ShortString;
  123.   PAnsiString = ^AnsiString;
  124.   PString = PAnsiString;
  125.  
  126.   PExtended = ^Extended;
  127.   PCurrency = ^Currency;
  128.   PVariant = ^Variant;
  129.  
  130.   TDateTime = type Double;
  131.  
  132.   PVarRec = ^TVarRec;
  133.   TVarRec = record
  134.     case Byte of
  135.       vtInteger:    (VInteger: Integer; VType: Byte);
  136.       vtBoolean:    (VBoolean: Boolean);
  137.       vtChar:       (VChar: Char);
  138.       vtExtended:   (VExtended: PExtended);
  139.       vtString:     (VString: PShortString);
  140.       vtPointer:    (VPointer: Pointer);
  141.       vtPChar:      (VPChar: PChar);
  142.       vtObject:     (VObject: TObject);
  143.       vtClass:      (VClass: TClass);
  144.       vtWideChar:   (VWideChar: WideChar);
  145.       vtPWideChar:  (VPWideChar: PWideChar);
  146.       vtAnsiString: (VAnsiString: Pointer);
  147.       vtCurrency:   (VCurrency: PCurrency);
  148.       vtVariant:    (VVariant: PVariant);
  149.   end;
  150.  
  151.   PMemoryManager = ^TMemoryManager;
  152.   TMemoryManager = record
  153.     GetMem: function(Size: Integer): Pointer;
  154.     FreeMem: function(P: Pointer): Integer;
  155.     ReallocMem: function(P: Pointer; Size: Integer): Pointer;
  156.   end;
  157.  
  158.   THeapStatus = record
  159.     TotalAddrSpace: Cardinal;
  160.     TotalUncommitted: Cardinal;
  161.     TotalCommitted: Cardinal;
  162.     TotalAllocated: Cardinal;
  163.     TotalFree: Cardinal;
  164.     FreeSmall: Cardinal;
  165.     FreeBig: Cardinal;
  166.     Unused: Cardinal;
  167.     Overhead: Cardinal;
  168.     HeapErrorCode: Cardinal;
  169.   end;
  170.  
  171. threadvar
  172.  
  173.   RaiseList: Pointer;     { Stack of current exception objects }
  174.   InOutRes: Integer;      { Result of I/O operations }
  175.  
  176. var
  177.  
  178.   ExceptProc: Pointer;    { Unhandled exception handler }
  179.   ErrorProc: Pointer;     { Error handler procedure }
  180.   ExceptClsProc: Pointer; { Map an OS Exception to a Delphi class reference }
  181.   ExceptObjProc: Pointer; { Map an OS Exception to a Delphi class instance }
  182.   ExceptionClass: TClass; { Exception base class (must be Exception) }
  183.   HPrevInst: Longint;     { Handle of previous instance }
  184.   HInstance: Longint;     { Handle of this instance }
  185.   CmdShow: Integer;       { CmdShow parameter for CreateWindow }
  186.   CmdLine: PChar;         { Command line pointer }
  187.     InitProc: Pointer;            { Last installed initialization procedure }
  188.   ExitCode: Integer;      { Program result }
  189.   ExitProc: Pointer;      { Last installed exit procedure }
  190.   ErrorAddr: Pointer;     { Address of run-time error }
  191.   DllProc: Pointer;       { Called whenever DLL entry point is called }
  192.   RandSeed: Longint;      { Base for random number generator }
  193.   IsLibrary: Boolean;     { True if module is a DLL }
  194.   IsConsole: Boolean;     { True if compiled as console app }
  195.   IsMultiThread: Boolean; { True if more than one thread }
  196.   FileMode: Byte;         { Standard mode for opening files }
  197.   Test8086: Byte;         { Will always be 2 (386 or later) }
  198.   Test8087: Byte;         { Will always be 3 (387 or later) }
  199.   TestFDIV: Shortint;     { -1: Flawed Pentium, 0: Not determined, 1: Ok }
  200.   Input: Text;            { Standard input }
  201.   Output: Text;           { Standard output }
  202.   TlsIndex: Integer;      { Thread local storage index }
  203.   TlsIndex4: Integer;     { Thread local storage index*4 }
  204.   TlsLast: Byte;          { Set by linker so its offset is last in TLS segment }
  205.  
  206. const
  207.   HeapAllocFlags: Word = 2;   { Heap allocation flags, gmem_Moveable }
  208.   DebugHook: Byte = 0;     {  1 to notify debugger of non-Delphi exceptions
  209.                              >1 to notify debugger of exception unwinding }
  210.  
  211. var
  212.   Unassigned: Variant;    { Unassigned standard constant }
  213.   Null: Variant;          { Null standard constant }
  214.  
  215.   AllocMemCount: Integer; { Number of allocated memory blocks }
  216.   AllocMemSize: Integer;  { Total size of allocated memory blocks }
  217.  
  218. { Memory manager support }
  219.  
  220. procedure GetMemoryManager(var MemMgr: TMemoryManager);
  221. procedure SetMemoryManager(const MemMgr: TMemoryManager);
  222.  
  223. function SysGetMem(Size: Integer): Pointer;
  224. function SysFreeMem(P: Pointer): Integer;
  225. function SysReallocMem(P: Pointer; Size: Integer): Pointer;
  226.  
  227. function GetHeapStatus: THeapStatus;
  228.  
  229. { Thread support }
  230. type
  231.   TThreadFunc = function(Parameter: Pointer): Integer;
  232.  
  233. function BeginThread(SecurityAttributes: Pointer; StackSize: Integer;
  234.                      ThreadFunc: TThreadFunc; Parameter: Pointer;
  235.                      CreationFlags: Integer; var ThreadId: Integer): Integer;
  236.  
  237. procedure EndThread(ExitCode: Integer);
  238.  
  239. { Standard procedures and functions }
  240.  
  241. procedure _ChDir(const S: string);
  242. procedure __Flush(var F: Text);
  243. procedure _LGetDir(D: Byte; var S: string);
  244. procedure _SGetDir(D: Byte; var S: ShortString);
  245. function IOResult: Integer;
  246. procedure _MkDir(const S: string);
  247. procedure Move(const Source; var Dest; Count: Integer);
  248. function ParamCount: Integer;
  249. function ParamStr(Index: Integer): string;
  250. procedure Randomize;
  251. procedure _RmDir(const S: string);
  252. function UpCase(Ch: Char): Char;
  253.  
  254. { Wide character support procedures and functions }
  255.  
  256. function WideCharToString(Source: PWideChar): string;
  257. function WideCharLenToString(Source: PWideChar; SourceLen: Integer): string;
  258. procedure WideCharToStrVar(Source: PWideChar; var Dest: string);
  259. procedure WideCharLenToStrVar(Source: PWideChar; SourceLen: Integer;
  260.   var Dest: string);
  261. function StringToWideChar(const Source: string; Dest: PWideChar;
  262.   DestSize: Integer): PWideChar;
  263.  
  264. { OLE string support procedures and functions }
  265.  
  266. function OleStrToString(Source: PWideChar): string;
  267. procedure OleStrToStrVar(Source: PWideChar; var Dest: string);
  268. function StringToOleStr(const Source: string): PWideChar;
  269.  
  270. { Variant support procedures and functions }
  271.  
  272. procedure VarClear(var V: Variant);
  273. procedure VarCopy(var Dest: Variant; const Source: Variant);
  274. procedure VarCast(var Dest: Variant; const Source: Variant; VarType: Integer);
  275. function VarType(const V: Variant): Integer;
  276. function VarAsType(const V: Variant; VarType: Integer): Variant;
  277. function VarIsEmpty(const V: Variant): Boolean;
  278. function VarIsNull(const V: Variant): Boolean;
  279. function VarToStr(const V: Variant): string;
  280. function VarFromDateTime(DateTime: TDateTime): Variant;
  281. function VarToDateTime(const V: Variant): TDateTime;
  282.  
  283. { Variant array support procedures and functions }
  284.  
  285. function VarArrayCreate(const Bounds: array of Integer;
  286.   VarType: Integer): Variant;
  287. function VarArrayOf(const Values: array of Variant): Variant;
  288. procedure VarArrayRedim(var A: Variant; HighBound: Integer);
  289. function VarArrayDimCount(const A: Variant): Integer;
  290. function VarArrayLowBound(const A: Variant; Dim: Integer): Integer;
  291. function VarArrayHighBound(const A: Variant; Dim: Integer): Integer;
  292. function VarArrayLock(const A: Variant): Pointer;
  293. procedure VarArrayUnlock(const A: Variant);
  294. function VarIsArray(const A: Variant): Boolean;
  295.  
  296. { Variant IDispatch call support }
  297.  
  298. procedure _DispInvokeError;
  299.  
  300. const
  301.   VarDispProc: Pointer = @_DispInvokeError;
  302.  
  303. { Procedures and functions that need compiler magic }
  304.  
  305. procedure _COS;
  306. procedure _EXP;
  307. procedure _INT;
  308. procedure _SIN;
  309. procedure _FRAC;
  310. procedure _ROUND;
  311. procedure _TRUNC;
  312.  
  313. procedure _AbstractError;
  314. procedure _Append;
  315. procedure _Assign(var T: Text; S: ShortString);
  316. procedure _BlockRead;
  317. procedure _BlockWrite;
  318. procedure _Close;
  319. procedure _PStrCat;
  320. procedure _PStrNCat;
  321. procedure _PStrCpy;
  322. procedure _PStrNCpy;
  323. procedure _EofFile;
  324. procedure _EofText;
  325. procedure _Eoln;
  326. procedure _Erase;
  327. procedure _FilePos;
  328. procedure _FileSize;
  329. procedure _FillChar;
  330. procedure _FreeMem;
  331. procedure _GetMem;
  332. procedure _ReallocMem;
  333. procedure _Halt;
  334. procedure _Halt0;
  335. procedure _Mark;
  336. procedure _PStrCmp;
  337. procedure _AStrCmp;
  338. procedure _RandInt;
  339. procedure _RandExt;
  340. procedure _ReadRec;
  341. procedure _ReadChar;
  342. procedure _ReadLong;
  343. procedure _ReadString;
  344. procedure _ReadCString;
  345. procedure _ReadLString;
  346. procedure _ReadExt;
  347. procedure _ReadLn;
  348. procedure _Rename;
  349. procedure _Release;
  350. procedure _ResetText(var T: Text);
  351. procedure _ResetFile;
  352. procedure _RewritText(var T: Text);
  353. procedure _RewritFile;
  354. procedure _RunError;
  355. procedure _Run0Error;
  356. procedure _Seek;
  357. procedure _SeekEof;
  358. procedure _SeekEoln;
  359. procedure _SetTextBuf;
  360. procedure _StrLong;
  361. procedure _Str0Long;
  362. procedure _Truncate;
  363. procedure _ValLong;
  364. procedure _WriteRec;
  365. procedure _WriteChar;
  366. procedure _Write0Char;
  367. procedure _WriteBool;
  368. procedure _Write0Bool;
  369. procedure _WriteLong;
  370. procedure _Write0Long;
  371. procedure _WriteString;
  372. procedure _Write0String;
  373. procedure _WriteCString;
  374. procedure _Write0CString;
  375. procedure _WriteLString;
  376. procedure _Write0LString;
  377. function _WriteVariant(var T: Text; const V: Variant; Width: Integer): Pointer;
  378. function _Write0Variant(var T: Text; const V: Variant): Pointer;
  379. procedure _Write2Ext;
  380. procedure _Write1Ext;
  381. procedure _Write0Ext;
  382. procedure _WriteLn;
  383.  
  384. procedure __CToPasStr;
  385. procedure __CLenToPasStr;
  386. procedure __PasToCStr;
  387.  
  388. procedure __IOTest;
  389. procedure _Flush(var F: Text);
  390.  
  391. procedure _SetElem;
  392. procedure _SetRange;
  393. procedure _SetEq;
  394. procedure _SetLe;
  395. procedure _SetIntersect;
  396. procedure _SetUnion;
  397. procedure _SetSub;
  398. procedure _SetExpand;
  399.  
  400. procedure _Str2Ext;
  401. procedure _Str0Ext;
  402. procedure _Str1Ext;
  403. procedure _ValExt;
  404. procedure _Pow10;
  405. procedure _Real2Ext;
  406. procedure _Ext2Real;
  407.  
  408. procedure _ObjSetup;
  409. procedure _ObjCopy;
  410. procedure _Fail;
  411. procedure _BoundErr;
  412. procedure _IntOver;
  413. procedure _InitExe;
  414. procedure _InitDll;
  415.  
  416. procedure _ClassCreate;
  417. procedure _ClassDestroy;
  418. procedure _IsClass;
  419. procedure _AsClass;
  420.  
  421. procedure _RaiseExcept;
  422. procedure _RaiseAgain;
  423. procedure _DoneExcept;
  424. procedure _TryFinallyExit;
  425.  
  426. procedure _CallDynaInst;
  427. procedure _CallDynaClass;
  428. procedure _FindDynaInst;
  429. procedure _FindDynaClass;
  430.  
  431. procedure _LStrClr{var str: AnsiString};
  432. procedure _LStrArrayClr{var str: AnsiString; cnt: longint};
  433. procedure _LStrAsg{var dest: AnsiString; source: AnsiString};
  434. procedure _LStrLAsg{var dest: AnsiString; source: AnsiString};
  435. procedure _LStrFromLenStr{var dest: AnsiString; source: Pointer; length: Longint};
  436. procedure _LStrFromChar{var dest: AnsiString; source: char};
  437. procedure _LStrFromString{var dest: AnsiString; source: ShortString};
  438. procedure _LStrFromPChar{var dest: AnsiString; source: PChar};
  439. procedure _LStrFromArray{{var dest: AnsiString; source: Pointer; length: Longint};
  440. procedure _LStrToString{ var result: ShortString; s: AnsiString; resultLen: Integer};
  441. function _LStrLen{str: AnsiString}: Longint;
  442. procedure _LStrCat{var dest: AnsiString; source: AnsiString};
  443. procedure _LStrCat3{var dest:AnsiString; source1: AnsiString; source2: AnsiString};
  444. procedure _LStrCatN{var dest:AnsiString; argCnt: Integer; ...};
  445. procedure _LStrCmp{left: AnsiString; right: AnsiString};
  446. procedure _LStrAddRef{str: AnsiString};
  447. procedure _LStrToPChar{str: AnsiString): PChar};
  448. procedure _Copy{ s : ShortString; index, count : Integer ) : ShortString};
  449. procedure _Delete{ var s : openstring; index, count : Integer };
  450. procedure _Insert{ source : ShortString; var s : openstring; index : Integer };
  451. procedure _Pos{ substr : ShortString; s : ShortString ) : Integer};
  452. procedure _SetLength{var s: ShortString; newLength: Integer};
  453. procedure _SetString{var s: ShortString: buffer: PChar; len: Integer};
  454.  
  455. procedure UniqueString(var str: string);
  456. procedure _NewAnsiString{length: Longint};      { for debugger purposes only }
  457.  
  458. procedure _LStrCopy  { const s : AnsiString; index, count : Integer) : AnsiString};
  459. procedure _LStrDelete{ var s : AnsiString; index, count : Integer };
  460. procedure _LStrInsert{ const source : AnsiString; var s : AnsiString; index : Integer };
  461. procedure _LStrPos{ const substr : AnsiString; const s : AnsiString ) : Integer};
  462. procedure _LStrSetLength{ var str: AnsiString; newLength: Integer};
  463. procedure _LStrOfChar{ c: Char; count: Integer): AnsiString };
  464. procedure _Initialize;
  465. procedure _InitializeArray;
  466. procedure _InitializeRecord;
  467. procedure _Finalize;
  468. procedure _FinalizeArray;
  469. procedure _FinalizeRecord;
  470. procedure _AddRef;
  471. procedure _AddRefArray;
  472. procedure _AddRefRecord;
  473.  
  474. procedure _New;
  475. procedure _Dispose;
  476.  
  477. procedure _DispInvoke; cdecl;
  478.  
  479. procedure _VarToInt;
  480. procedure _VarToBool;
  481. procedure _VarToReal;
  482. procedure _VarToCurr;
  483. procedure _VarToPStr(var S; const V: Variant);
  484. procedure _VarToLStr(var S: string; const V: Variant);
  485.  
  486. procedure _VarFromInt;
  487. procedure _VarFromBool;
  488. procedure _VarFromReal;
  489. procedure _VarFromTDateTime;
  490. procedure _VarFromCurr;
  491. procedure _VarFromPStr(var V: Variant; const Value: ShortString);
  492. procedure _VarFromLStr(var V: Variant; const Value: string);
  493.  
  494. procedure _VarAdd;
  495. procedure _VarSub;
  496. procedure _VarMul;
  497. procedure _VarDiv;
  498. procedure _VarMod;
  499. procedure _VarAnd;
  500. procedure _VarOr;
  501. procedure _VarXor;
  502. procedure _VarShl;
  503. procedure _VarShr;
  504. procedure _VarRDiv;
  505. procedure _VarCmp;
  506.  
  507. procedure _VarNeg;
  508. procedure _VarNot;
  509.  
  510. procedure _VarCopy;
  511. procedure _VarClr;
  512. procedure _VarAddRef;
  513.  
  514. function _VarArrayGet(var A: Variant; IndexCount: Integer;
  515.   Indices: Integer): Variant; cdecl;
  516. procedure _VarArrayPut(var A: Variant; const Value: Variant;
  517.   IndexCount: Integer; Indices: Integer); cdecl;
  518.  
  519. procedure _HandleAnyException;
  520. procedure _HandleOnException;
  521. procedure _HandleFinally;
  522.  
  523. procedure _AddExitProc(PP: Pointer);
  524.  
  525. procedure _FSafeDivide;
  526. procedure _FSafeDivideR;
  527.  
  528. procedure _SafeCall;
  529.  
  530. procedure FPower10;
  531. procedure _GetTls;
  532.  
  533. procedure TextStart;
  534.  
  535. (* =================================================================== *)
  536.  
  537. implementation
  538.