D7的System.pas单元的声明部分
unit System; { Predefined constants, types, procedures, }
{ and functions (such as True, Integer, or }
{ Writeln) do not have actual declarations. }
{ Instead they are built into the compiler }
{ and are treated as if they were declared }
{ at the beginning of the System unit. }
{ $H+,I-,R-,O+,W- }
{ $WARN SYMBOL_PLATFORM OFF }
{ L- should never be specified.
The IDE needs to find DebugHook (through the C++ compiler sometimes) for integrated debugging to function properly.
ILINK will generate debug info for DebugHook if the object module has not been compiled with debug info.
ILINK will not generate debug info for DebugHook if the object module has been compiled with debug info.
Thus, the Pascal compiler must be responsible for generating the debug information for that symbol when a debug-enabled object file is produced.
}
interface
(* You can use RTLVersion in $IF expressions to test the runtime library version level independently of the compiler version level.
Example: {$IF RTLVersion >= 16.2 } ... { $IFEND } * )
const
RTLVersion = 15.00 ;
{ $EXTERNALSYM CompilerVersion }
(*
const
CompilerVersion = 0.0;
CompilerVersion is assigned a value by the compiler when
the system unit is compiled. It indicates the revision level of the
compiler features / language syntax, which may advance independently of
the RTLVersion. CompilerVersion can be tested in $IF expressions and
should be used instead of testing for the VERxxx conditional define.
Always test for greater than or less than a known revision level.
It's a bad idea to test for a specific revision level.
*)
{ Variant type codes (wtypes.h) }
varEmpty = $ 0000 ; { vt_empty 0 }
varNull = $ 0001 ; { vt_null 1 }
varSmallint = $ 0002 ; { vt_i2 2 }
varInteger = $ 0003 ; { vt_i4 3 }
varSingle = $ 0004 ; { vt_r4 4 }
varDouble = $ 0005 ; { vt_r8 5 }
varCurrency = $ 0006 ; { vt_cy 6 }
varDate = $ 0007 ; { vt_date 7 }
varOleStr = $ 0008 ; { vt_bstr 8 }
varDispatch = $ 0009 ; { vt_dispatch 9 }
varError = $000A; { vt_error 10 }
varBoolean = $000B; { vt_bool 11 }
varVariant = $000C; { vt_variant 12 }
varUnknown = $000D; { vt_unknown 13 }
//varDecimal = $000E; { vt_decimal 14 } { UNSUPPORTED as of v6.x code base }
//varUndef0F = $000F; { undefined 15 } { UNSUPPORTED per Microsoft }
varShortInt = $ 0010 ; { vt_i1 16 }
varByte = $ 0011 ; { vt_ui1 17 }
varWord = $ 0012 ; { vt_ui2 18 }
varLongWord = $ 0013 ; { vt_ui4 19 }
varInt64 = $ 0014 ; { vt_i8 20 }
//varWord64 = $ 0015 ; { vt_ui8 21 } { UNSUPPORTED as of v6.x code base }
{ if adding new items, update Variants' varLast, BaseTypeMap and OpTypeMap }
varStrArg = $ 0048 ; { vt_clsid 72 }
varString = $ 0100 ; { Pascal string 256 } { not OLE compatible }
varAny = $ 0101 ; { Corba any 257 } { not OLE compatible }
// custom types range from $ 110 ( 272 ) to $7FF ( 2047 )
varTypeMask = $0FFF;
varArray = $ 2000 ;
varByRef = $ 4000 ;
{ TVarRec.VType values }
vtInteger = 0 ;
vtBoolean = 1 ;
vtChar = 2 ;
vtExtended = 3 ;
vtString = 4 ;
vtPointer = 5 ;
vtPChar = 6 ;
vtObject = 7 ;
vtClass = 8 ;
vtWideChar = 9 ;
vtPWideChar = 10 ;
vtAnsiString = 11 ;
vtCurrency = 12 ;
vtVariant = 13 ;
vtInterface = 14 ;
vtWideString = 15 ;
vtInt64 = 16 ;
{ Virtual method table entries }
vmtSelfPtr = - 76 ;
vmtIntfTable = - 72 ;
vmtAutoTable = - 68 ;
vmtInitTable = - 64 ;
vmtTypeInfo = - 60 ;
vmtFieldTable = - 56 ;
vmtMethodTable = - 52 ;
vmtDynamicTable = - 48 ;
vmtClassName = - 44 ;
vmtInstanceSize = - 40 ;
vmtParent = - 36 ;
vmtSafeCallException = - 32 deprecated; // don ' t use these constants.
vmtAfterConstruction = - 28 deprecated; // use VMTOFFSET in asm code instead
vmtBeforeDestruction = - 24 deprecated;
vmtDispatch = - 20 deprecated;
vmtDefaultHandler = - 16 deprecated;
vmtNewInstance = - 12 deprecated;
vmtFreeInstance = - 8 deprecated;
vmtDestroy = - 4 deprecated;
vmtQueryInterface = 0 deprecated;
vmtAddRef = 4 deprecated;
vmtRelease = 8 deprecated;
vmtCreateObject = 12 deprecated;
type
TObject = class ;
TClass = class of TObject;
HRESULT = type Longint; { from WTYPES.H }
{ $EXTERNALSYM HRESULT }
PGUID = ^TGUID;
TGUID = packed record
D1: LongWord;
D2: Word;
D3: Word;
D4: array [ 0 .. 7 ] of Byte;
end ;
PInterfaceEntry = ^TInterfaceEntry;
TInterfaceEntry = packed record
IID: TGUID;
VTable: Pointer;
IOffset: Integer;
ImplGetter: Integer;
end ;
PInterfaceTable = ^TInterfaceTable;
TInterfaceTable = packed record
EntryCount: Integer;
Entries: array [ 0 .. 9999 ] of TInterfaceEntry;
end ;
TMethod = record
Code, Data: Pointer;
end ;
{ TObject.Dispatch accepts any data type as its Message parameter. The
first 2 bytes of the data are taken as the message id to search for
in the object's message methods. TDispatchMessage is an example of
such a structure with a word field for the message id.
}
TDispatchMessage = record
MsgID: Word;
end ;
TObject = class
constructor Create;
procedure Free;
class function InitInstance(Instance: Pointer): TObject;
procedure CleanupInstance;
function ClassType: TClass;
class function ClassName: ShortString;
class function ClassNameIs( const Name: string ): Boolean;
class function ClassParent: TClass;
class function ClassInfo: Pointer;
class function InstanceSize: Longint;
class function InheritsFrom(AClass: TClass): Boolean;
class function MethodAddress( const Name: ShortString): Pointer;
class function MethodName(Address: Pointer): ShortString;
function FieldAddress( const Name: ShortString): Pointer;
function GetInterface( const IID: TGUID; out Obj): Boolean;
class function GetInterfaceEntry( const IID: TGUID): PInterfaceEntry;
class function GetInterfaceTable: PInterfaceTable;
function SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): HResult; virtual ;
procedure AfterConstruction; virtual ;
procedure BeforeDestruction; virtual ;
procedure Dispatch( var Message); virtual ;
procedure DefaultHandler( var Message); virtual ;
class function NewInstance: TObject; virtual ;
procedure FreeInstance; virtual ;
destructor Destroy; virtual ;
end ;
const
S_OK = 0 ; { $EXTERNALSYM S_OK }
S_FALSE = $ 00000001 ; { $EXTERNALSYM S_FALSE }
E_NOINTERFACE = HRESULT($ 80004002 ); { $EXTERNALSYM E_NOINTERFACE }
E_UNEXPECTED = HRESULT($8000FFFF); { $EXTERNALSYM E_UNEXPECTED }
E_NOTIMPL = HRESULT($ 80004001 ); { $EXTERNALSYM E_NOTIMPL }
type
IInterface = interface
[ ' {00000000-0000-0000-C000-000000000046} ' ]
function QueryInterface( const IID: TGUID; out Obj): HResult; stdcall ;
function _AddRef: Integer; stdcall ;
function _Release: Integer; stdcall ;
end ;
IUnknown = IInterface;
{ $M+ }
IInvokable = interface (IInterface)
end ;
{ $M- }
IDispatch = interface (IUnknown)
[ ' {00020400-0000-0000-C000-000000000046} ' ]
function GetTypeInfoCount( out Count: Integer): HResult; stdcall ;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall ;
function GetIDsOfNames( const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall ;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall ;
end ;
{ $EXTERNALSYM IUnknown }
{ $EXTERNALSYM IDispatch }
{ TInterfacedObject provides a threadsafe default implementation
of IInterface. You should use TInterfaceObject as the base class
of objects implementing interfaces. }
TInterfacedObject = class (TObject, IInterface)
protected
FRefCount: Integer;
function QueryInterface( const IID: TGUID; out Obj): HResult; stdcall ;
function _AddRef: Integer; stdcall ;
function _Release: Integer; stdcall ;
public
procedure AfterConstruction; override ;
procedure BeforeDestruction; override ;
class function NewInstance: TObject; override ;
property RefCount: Integer read FRefCount;
end ;
TInterfacedClass = class of TInterfacedObject;
{ TAggregatedObject and TContainedObject are suitable base
classes for interfaced objects intended to be aggregated
or contained in an outer controlling object. When using
the "implements" syntax on an interface property in
an outer object class declaration, use these types
to implement the inner object.
Interfaces implemented by aggregated objects on behalf of
the controller should not be distinguishable from other
interfaces provided by the controller. Aggregated objects
must not maintain their own reference count - they must
have the same lifetime as their controller. To achieve this,
aggregated objects reflect the reference count methods
to the controller.
TAggregatedObject simply reflects QueryInterface calls to
its controller. From such an aggregated object, one can
obtain any interface that the controller supports, and
only interfaces that the controller supports. This is
useful for implementing a controller class that uses one
or more internal objects to implement the interfaces declared
on the controller class. Aggregation promotes implementation
sharing across the object hierarchy.
TAggregatedObject is what most aggregate objects should
inherit from, especially when used in conjunction with
the "implements" syntax. }
TAggregatedObject = class (TObject)
private
FController: Pointer; // weak reference to controller
function GetController: IInterface;
protected
{ IInterface }
function QueryInterface( const IID: TGUID; out Obj): HResult; stdcall ;
function _AddRef: Integer; stdcall ;
function _Release: Integer; stdcall ;
public
constructor Create( const Controller: IInterface);
property Controller: IInterface read GetController;
end ;
{ TContainedObject is an aggregated object that isolates
QueryInterface on the aggregate from the controller.
TContainedObject will return only interfaces that the
contained object itself implements, not interfaces
that the controller implements. This is useful for
implementing nodes that are attached to a controller and
have the same lifetime as the controller, but whose
interface identity is separate from the controller.
You might do this if you don't want the consumers of
an aggregated interface to have access to other interfaces
implemented by the controller - forced encapsulation.
This is a less common case than TAggregatedObject. }
TContainedObject = class (TAggregatedObject, IInterface)
protected
{ IInterface }
function QueryInterface( const IID: TGUID; out Obj): HResult; virtual ; stdcall ;
end ;
PShortString = ^ShortString;
PAnsiString = ^AnsiString;
PWideString = ^WideString;
PString = PAnsiString;
UCS2Char = WideChar;
PUCS2Char = PWideChar;
UCS4Char = type LongWord;
{ $NODEFINE UCS4CHAR }
PUCS4Char = ^UCS4Char;
{ $NODEFINE PUCS4CHAR }
TUCS4CharArray = array [ 0 ..$effffff] of UCS4Char;
PUCS4CharArray = ^TUCS4CharArray;
UCS4String = array of UCS4Char;
{ $NODEFINE UCS4String }
UTF8String = type string ;
PUTF8String = ^UTF8String;
{ $NODEFINE UTF8String }
{ $NODEFINE PUTF8String }
IntegerArray = array [ 0 ..$effffff] of Integer;
PIntegerArray = ^IntegerArray;
PointerArray = array [ 0 .. 512 * 1024 * 1024 - 2 ] of Pointer;
PPointerArray = ^PointerArray;
TBoundArray = array of Integer;
TPCharArray = packed array [ 0 ..(MaxLongint div SizeOf(PChar))- 1 ] of PChar;
PPCharArray = ^TPCharArray;
(* $HPPEMIT 'namespace System' *)
(* $HPPEMIT '{' *)
(* $HPPEMIT ' typedef int *PLongint;' *)
(* $HPPEMIT ' } ' *)
PLongint = ^Longint;
{ $EXTERNALSYM PLongint }
PInteger = ^Integer;
PCardinal = ^Cardinal;
PWord = ^Word;
PSmallInt = ^SmallInt;
PByte = ^Byte;
PShortInt = ^ShortInt;
PInt64 = ^Int64;
PLongWord = ^LongWord;
PSingle = ^Single;
PDouble = ^Double;
PDate = ^Double;
PDispatch = ^IDispatch;
PPDispatch = ^PDispatch;
PError = ^LongWord;
PWordBool = ^WordBool;
PUnknown = ^IUnknown;
PPUnknown = ^PUnknown;
{ $NODEFINE PByte }
PPWideChar = ^PWideChar;
PPChar = ^PChar;
PPAnsiChar = PPChar;
PExtended = ^Extended;
PComp = ^Comp;
PCurrency = ^Currency;
PVariant = ^Variant;
POleVariant = ^OleVariant;
PPointer = ^Pointer;
PBoolean = ^Boolean;
TDateTime = type Double;
PDateTime = ^TDateTime;
THandle = LongWord;
TVarArrayBound = packed record
ElementCount: Integer;
LowBound: Integer;
end ;
TVarArrayBoundArray = array [ 0 .. 0 ] of TVarArrayBound;
PVarArrayBoundArray = ^TVarArrayBoundArray;
TVarArrayCoorArray = array [ 0 .. 0 ] of Integer;
PVarArrayCoorArray = ^TVarArrayCoorArray;
PVarArray = ^TVarArray;
TVarArray = packed record
DimCount: Word;
Flags: Word;
ElementSize: Integer;
LockCount: Integer;
Data: Pointer;
Bounds: TVarArrayBoundArray;
end ;
TVarType = Word;
PVarData = ^TVarData;
{ $EXTERNALSYM PVarData }
TVarData = packed record
case Integer of
0 : (VType: TVarType;
case Integer of
0 : (Reserved1: Word;
case Integer of
0 : (Reserved2, Reserved3: Word;
case Integer of
varSmallInt: (VSmallInt: SmallInt);
varInteger: (VInteger: Integer);
varSingle: (VSingle: Single);
varDouble: (VDouble: Double);
varCurrency: (VCurrency: Currency);
varDate: (VDate: TDateTime);
varOleStr: (VOleStr: PWideChar);
varDispatch: (VDispatch: Pointer);
varError: (VError: HRESULT);
varBoolean: (VBoolean: WordBool);
varUnknown: (VUnknown: Pointer);
varShortInt: (VShortInt: ShortInt);
varByte: (VByte: Byte);
varWord: (VWord: Word);
varLongWord: (VLongWord: LongWord);
varInt64: (VInt64: Int64);
varString: (VString: Pointer);
varAny: (VAny: Pointer);
varArray: (VArray: PVarArray);
varByRef: (VPointer: Pointer);
);
1 : (VLongs: array [ 0 .. 2 ] of LongInt);
);
2 : (VWords: array [ 0 .. 6 ] of Word);
3 : (VBytes: array [ 0 .. 13 ] of Byte);
);
1 : (RawData: array [ 0 .. 3 ] of LongInt);
end ;
{ $EXTERNALSYM TVarData }
type
TVarOp = Integer;
const
opAdd = 0 ;
opSubtract = 1 ;
opMultiply = 2 ;
opDivide = 3 ;
opIntDivide = 4 ;
opModulus = 5 ;
opShiftLeft = 6 ;
opShiftRight = 7 ;
opAnd = 8 ;
opOr = 9 ;
opXor = 10 ;
opCompare = 11 ;
opNegate = 12 ;
opNot = 13 ;
opCmpEQ = 14 ;
opCmpNE = 15 ;
opCmpLT = 16 ;
opCmpLE = 17 ;
opCmpGT = 18 ;
opCmpGE = 19 ;
type
{ Dispatch call descriptor }
PCallDesc = ^TCallDesc;
TCallDesc = packed record
CallType: Byte;
ArgCount: Byte;
NamedArgCount: Byte;
ArgTypes: array [ 0 .. 255 ] of Byte;
end ;
PDispDesc = ^TDispDesc;
TDispDesc = packed record
DispID: Integer;
ResType: Byte;
CallDesc: TCallDesc;
end ;
PVariantManager = ^TVariantManager;
{ $EXTERNALSYM PVariantManager }
TVariantManager = record
VarClear: procedure ( var V : Variant);
VarCopy: procedure ( var Dest: Variant; const Source: Variant);
VarCopyNoInd: procedure ; // ARGS PLEASE!
VarCast: procedure ( var Dest: Variant; const Source: Variant; VarType: Integer);
VarCastOle: procedure ( var Dest: Variant; const Source: Variant; VarType: Integer);
VarToInt: function ( const V: Variant): Integer;
VarToInt64: function ( const V: Variant): Int64;
VarToBool: function ( const V: Variant): Boolean;
VarToReal: function ( const V: Variant): Extended;
VarToCurr: function ( const V: Variant): Currency;
VarToPStr: procedure ( var S; const V: Variant);
VarToLStr: procedure ( var S: string ; const V: Variant);
VarToWStr: procedure ( var S: WideString; const V: Variant);
VarToIntf: procedure ( var Unknown: IInterface; const V: Variant);
VarToDisp: procedure ( var Dispatch: IDispatch; const V: Variant);
VarToDynArray: procedure ( var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
VarFromInt: procedure ( var V: Variant; const Value: Integer; const Range: ShortInt);
VarFromInt64: procedure ( var V: Variant; const Value: Int64);
VarFromBool: procedure ( var V: Variant; const Value: Boolean);
VarFromReal: procedure ; // var V: Variant; const Value: Real
VarFromTDateTime: procedure ; // var V: Variant; const Value: TDateTime
VarFromCurr: procedure ; // var V: Variant; const Value: Currency
VarFromPStr: procedure ( var V: Variant; const Value: ShortString);
VarFromLStr: procedure ( var V: Variant; const Value: string );
VarFromWStr: procedure ( var V: Variant; const Value: WideString);
VarFromIntf: procedure ( var V: Variant; const Value: IInterface);
VarFromDisp: procedure ( var V: Variant; const Value: IDispatch);
VarFromDynArray: procedure ( var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
OleVarFromPStr: procedure ( var V: OleVariant; const Value: ShortString);
OleVarFromLStr: procedure ( var V: OleVariant; const Value: string );
OleVarFromVar: procedure ( var V: OleVariant; const Value: Variant);
OleVarFromInt: procedure ( var V: OleVariant; const Value: Integer; const Range: ShortInt);
VarOp: procedure ( var Left: Variant; const Right: Variant; OpCode: TVarOp);
VarCmp: procedure ( const Left, Right: TVarData; const OpCode: TVarOp); { result is set in the flags }
VarNeg: procedure ( var V: Variant);
VarNot: procedure ( var V: Variant);
DispInvoke: procedure (Dest: PVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer); cdecl ;
VarAddRef: procedure ( var V: Variant);
VarArrayRedim: procedure ( var A : Variant; HighBound: Integer);
VarArrayGet: function ( var A: Variant; IndexCount: Integer; Indices: Integer): Variant; cdecl ;
VarArrayPut: procedure ( var A: Variant; const Value: Variant; IndexCount: Integer; Indices: Integer); cdecl ;
WriteVariant: function ( var T: Text; const V: Variant; Width: Integer): Pointer;
Write0Variant: function ( var T: Text; const V: Variant): Pointer;
end deprecated;
{ $EXTERNALSYM TVariantManager }
{ Dynamic array support }
PDynArrayTypeInfo = ^TDynArrayTypeInfo;
{ $EXTERNALSYM PDynArrayTypeInfo }
TDynArrayTypeInfo = packed record
kind: Byte;
name: string [ 0 ];
elSize: Longint;
elType: ^PDynArrayTypeInfo;
varType: Integer;
end ;
{ $EXTERNALSYM TDynArrayTypeInfo }
PVarRec = ^TVarRec;
TVarRec = record { do not pack this record; it is compiler-generated }
case Byte of
vtInteger: (VInteger: Integer; VType: Byte);
vtBoolean: (VBoolean: Boolean);
vtChar: (VChar: Char);
vtExtended: (VExtended: PExtended);
vtString: (VString: PShortString);
vtPointer: (VPointer: Pointer);
vtPChar: (VPChar: PChar);
vtObject: (VObject: TObject);
vtClass: (VClass: TClass);
vtWideChar: (VWideChar: WideChar);
vtPWideChar: (VPWideChar: PWideChar);
vtAnsiString: (VAnsiString: Pointer);
vtCurrency: (VCurrency: PCurrency);
vtVariant: (VVariant: PVariant);
vtInterface: (VInterface: Pointer);
vtWideString: (VWideString: Pointer);
vtInt64: (VInt64: PInt64);
end ;
PMemoryManager = ^TMemoryManager;
TMemoryManager = record
GetMem: function (Size: Integer): Pointer;
FreeMem: function (P: Pointer): Integer;
ReallocMem: function (P: Pointer; Size: Integer): Pointer;
end ;
THeapStatus = record
TotalAddrSpace: Cardinal;
TotalUncommitted: Cardinal;
TotalCommitted: Cardinal;
TotalAllocated: Cardinal;
TotalFree: Cardinal;
FreeSmall: Cardinal;
FreeBig: Cardinal;
Unused: Cardinal;
Overhead: Cardinal;
HeapErrorCode: Cardinal;
end ;
{ $IFDEF PC_MAPPED_EXCEPTIONS }
PUnwinder = ^TUnwinder;
TUnwinder = record
RaiseException: function (Exc: Pointer): LongBool; cdecl ;
RegisterIPLookup: function (fn: Pointer; StartAddr, EndAddr: LongInt; Context: Pointer; GOT: LongInt): LongBool; cdecl ;
UnregisterIPLookup: procedure (StartAddr: LongInt) cdecl ;
DelphiLookup: function (Addr: LongInt; Context: Pointer): Pointer; cdecl ;
ClosestHandler: function (Context: Pointer): LongWord; cdecl ;
end ;
{ $ENDIF PC_MAPPED_EXCEPTIONS }
PackageUnitEntry = packed record
Init, FInit : Pointer;
end ;
{ Compiler generated table to be processed sequentially to init & finit all package units }
{ Init: 0..Max-1; Final: Last Initialized..0 }
UnitEntryTable = array [ 0 .. 9999999 ] of PackageUnitEntry;
PUnitEntryTable = ^UnitEntryTable;
PackageInfoTable = packed record
UnitCount : Integer; { number of entries in UnitInfo array; always > 0 }
UnitInfo : PUnitEntryTable;
end ;
PackageInfo = ^PackageInfoTable;
{ Each package exports a '@GetPackageInfoTable' which can be used to retrieve }
{ the table which contains compiler generated information about the package DLL }
GetPackageInfoTable = function : PackageInfo;
{ $IFDEF DEBUG_FUNCTIONS }
{ Inspector Query; implementation in GETMEM.INC; no need to conditionalize that }
THeapBlock = record
Start: Pointer;
Size: Cardinal;
end ;
THeapBlockArray = array of THeapBlock;
TObjectArray = array of TObject;
function GetHeapBlocks: THeapBlockArray;
function FindObjects(AClass: TClass; FindDerived: Boolean): TObjectArray;
{ Inspector Query }
{ $ENDIF }
{
When an exception is thrown, the exception object that is thrown is destroyed
automatically when the except clause which handles the exception is exited.
There are some cases in which an application may wish to acquire the thrown
object and keep it alive after the except clause is exited. For this purpose,
we have added the AcquireExceptionObject and ReleaseExceptionObject functions.
These functions maintain a reference count on the most current exception object,
allowing applications to legitimately obtain references. If the reference count
for an exception that is being thrown is positive when the except clause is exited,
then the thrown object is not destroyed by the RTL, but assumed to be in control
of the application. It is then the application's responsibility to destroy the
thrown object. If the reference count is zero, then the RTL will destroy the
thrown object when the except clause is exited.
}
function AcquireExceptionObject: Pointer;
procedure ReleaseExceptionObject;
{ $IFDEF PC_MAPPED_EXCEPTIONS }
procedure GetUnwinder( var Dest: TUnwinder);
procedure SetUnwinder( const NewUnwinder: TUnwinder);
function IsUnwinderSet: Boolean;
// function SysRegisterIPLookup(ModuleHandle, StartAddr, EndAddr: LongInt; Context: Pointer; GOT: LongInt): LongBool;
{
Do NOT call these functions. They are for internal use only:
SysRegisterIPLookup
SysUnregisterIPLookup
BlockOSExceptions
UnblockOSExceptions
AreOSExceptionsBlocked
}
function SysRegisterIPLookup(StartAddr, EndAddr: LongInt; Context: Pointer; GOT: LongInt): LongBool;
procedure SysUnregisterIPLookup(StartAddr: LongInt);
// function SysAddressIsInPCMap(Addr: LongInt): Boolean;
function SysClosestDelphiHandler(Context: Pointer): LongWord;
procedure BlockOSExceptions;
procedure UnblockOSExceptions;
function AreOSExceptionsBlocked: Boolean;
{ $ELSE }
// These functions are not portable. Use AcquireExceptionObject above instead
function RaiseList: Pointer; deprecated; { Stack of current exception objects }
function SetRaiseList(NewPtr: Pointer): Pointer; deprecated; { returns previous value }
{ $ENDIF }
function ExceptObject: TObject;
function ExceptAddr: Pointer;
{
Coverage support. These are internal use structures referenced by compiler
helper functions for QA coverage support.
}
type
TCVModInfo = packed record
ModName: PChar;
LibName: PChar;
UserData: PChar;
end ;
PCVModInfo = ^TCVModInfo;
{ $EXTERNALSYM _CVR_PROBE }
procedure _CVR_PROBE(mi: PCVModInfo; probeNum: Cardinal); cdecl ;
{ $EXTERNALSYM _CVR_STMTPROBE }
function _CVR_STMTPROBE(mi: PCVModInfo; probeNum: Cardinal; TrueFalse: Cardinal): Boolean; cdecl ;
procedure SetInOutRes(NewValue: Integer);
type
TAssertErrorProc = procedure ( const Message, Filename: string ;
LineNumber: Integer; ErrorAddr: Pointer);
TSafeCallErrorProc = procedure (ErrorCode: HResult; ErrorAddr: Pointer);
{ $IFDEF DEBUG }
{
This variable is just for debugging the exception handling system. See
_DbgExcNotify for the usage.
}
var
ExcNotificationProc : procedure ( NotificationKind: Integer;
ExceptionObject: Pointer;
ExceptionName: PShortString;
ExceptionLocation: Pointer;
HandlerAddr: Pointer) = nil ;
{ $ENDIF }
var
DispCallByIDProc: Pointer;
ExceptProc: Pointer; { Unhandled exception handler }
ErrorProc: procedure (ErrorCode: Byte; ErrorAddr: Pointer); { Error handler procedure }
ExceptClsProc: Pointer; { Map an OS Exception to a Delphi class reference }
ExceptObjProc: Pointer; { Map an OS Exception to a Delphi class instance }
RaiseExceptionProc: Pointer;
RTLUnwindProc: Pointer;
ExceptionClass: TClass; { Exception base class (must be Exception) }
SafeCallErrorProc: TSafeCallErrorProc; { Safecall error handler }
AssertErrorProc: TAssertErrorProc; { Assertion error handler }
ExitProcessProc: procedure ; { Hook to be called just before the process actually exits }
AbstractErrorProc: procedure ; { Abstract method error handler }
HPrevInst: LongWord deprecated; { Handle of previous instance - HPrevInst cannot be tested for multiple instances in Win32 }
MainInstance: LongWord; { Handle of the main(.EXE) HInstance }
MainThreadID: LongWord; { ThreadID of thread that module was initialized in }
IsLibrary: Boolean; { True if module is a DLL }
CmdShow: Integer platform; { CmdShow parameter for CreateWindow }
CmdLine: PChar platform; { Command line pointer }
InitProc: Pointer; { Last installed initialization procedure }
ExitCode: Integer = 0 ; { Program result }
ExitProc: Pointer; { Last installed exit procedure }
ErrorAddr: Pointer = nil ; { Address of run-time error }
RandSeed: Longint = 0 ; { Base for random number generator }
IsConsole: Boolean; { True if compiled as console app }
IsMultiThread: Boolean; { True if more than one thread }
FileMode: Byte = 2 ; { Standard mode for opening files }
Test8086: Byte; { CPU family (minus one) See consts below }
Test8087: Byte = 3 ; { assume 80387 FPU or OS supplied FPU emulation }
TestFDIV: Shortint; { -1: Flawed Pentium, 0: Not determined, 1: Ok }
Input: Text; { Standard input }
Output: Text; { Standard output }
ErrOutput: Text; { Standard error output }
envp: PPChar platform;
{ $HPPEMIT 'struct TVarData;' }
VarClearProc: procedure ( var v: TVarData) = nil ; // for internal use only
VarAddRefProc: procedure ( var v: TVarData) = nil ; // for internal use only
VarCopyProc: procedure ( var Dest: TVarData; const Source: TVarData) = nil ; // for internal use only
VarToLStrProc: procedure ( var Dest: AnsiString; const Source: TVarData) = nil ; // for internal use only
VarToWStrProc: procedure ( var Dest: WideString; const Source: TVarData) = nil ; // for internal use only
const
CPUi386 = 2 ;
CPUi486 = 3 ;
CPUPentium = 4 ;
var
Default8087CW: Word = $ 1332 ; { Default 8087 control word. FPU control register is set to this value.
CAUTION: Setting this to an invalid value could cause unpredictable behavior. }
HeapAllocFlags: Word platform = 2 ; { Heap allocation flags, gmem_Moveable }
DebugHook: Byte platform = 0 ; { 1 to notify debugger of non-Delphi exceptions>1 to notify debugger of exception unwinding }
JITEnable: Byte platform = 0 ; { 1 to call UnhandledExceptionFilter if the exception is not a Pascal exception.
>1 to call UnhandledExceptionFilter for all exceptions }
NoErrMsg: Boolean platform = False; { True causes the base RTL to not display the message box when a run-time error occurs }
type
(* $NODEFINE TTextLineBreakStyle *)
TTextLineBreakStyle = (tlbsLF, tlbsCRLF);
var { Text output line break handling. Default value for all text files }
DefaultTextLineBreakStyle: TTextLineBreakStyle = { $IFDEF LINUX } tlbsLF { $ENDIF }
{ $IFDEF MSWINDOWS } tlbsCRLF { $ENDIF } ;
const
sLineBreak = { $IFDEF LINUX } # 10 { $ENDIF } { $IFDEF MSWINDOWS } # 13 # 10 { $ENDIF } ;
type
HRSRC = THandle;
TResourceHandle = HRSRC; // make an opaque handle type
HINST = THandle;
HMODULE = HINST;
HGLOBAL = THandle;
{ Memory manager support }
procedure GetMemoryManager( var MemMgr: TMemoryManager);
procedure SetMemoryManager( const MemMgr: TMemoryManager);
function IsMemoryManagerSet: Boolean;
function SysGetMem(Size: Integer): Pointer;
function SysFreeMem(P: Pointer): Integer;
function SysReallocMem(P: Pointer; Size: Integer): Pointer;
var
AllocMemCount: Integer; { Number of allocated memory blocks }
AllocMemSize: Integer; { Total size of allocated memory blocks }
{ $IFDEF MSWINDOWS }
function GetHeapStatus: THeapStatus; platform;
{ $ENDIF }
{ Thread support }
type
TThreadFunc = function (Parameter: Pointer): Integer;
{ $IFDEF MSWINDOWS }
function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord;
ThreadFunc: TThreadFunc; Parameter: Pointer; CreationFlags: LongWord;
var ThreadId: LongWord): Integer;
{ $ENDIF }
procedure EndThread(ExitCode: Integer);
{ Standard procedures and functions }
const
{ File mode magic numbers }
fmClosed = $D7B0;
fmInput = $D7B1;
fmOutput = $D7B2;
fmInOut = $D7B3;
{ Text file flags }
tfCRLF = $ 1 ; // Dos compatibility flag, for CR+LF line breaks and EOF checks
type
{ Typed-file and untyped-file record }
TFileRec = packed record (* must match the size the compiler generates: 332 bytes *)
Handle: Integer;
Mode: Word;
Flags: Word;
case Byte of
0 : (RecSize: Cardinal); // files of record
1 : (BufSize: Cardinal; // text files
BufPos: Cardinal;
BufEnd: Cardinal;
BufPtr: PChar;
OpenFunc: Pointer;
InOutFunc: Pointer;
FlushFunc: Pointer;
CloseFunc: Pointer;
UserData: array [ 1 .. 32 ] of Byte;
Name: array [ 0 .. 259 ] of Char; );
end ;
{ Text file record structure used for Text files }
PTextBuf = ^TTextBuf;
TTextBuf = array [ 0 .. 127 ] of Char;
TTextRec = packed record (* must match the size the compiler generates: 460 bytes *)
Handle: Integer; (* must overlay with TFileRec *)
Mode: Word;
Flags: Word;
BufSize: Cardinal;
BufPos: Cardinal;
BufEnd: Cardinal;
BufPtr: PChar;
OpenFunc: Pointer;
InOutFunc: Pointer;
FlushFunc: Pointer;
CloseFunc: Pointer;
UserData: array [ 1 .. 32 ] of Byte;
Name: array [ 0 .. 259 ] of Char;
Buffer: TTextBuf;
end ;
TTextIOFunc = function ( var F: TTextRec): Integer;
TFileIOFunc = function ( var F: TFileRec): Integer;
procedure SetLineBreakStyle( var T: Text; Style: TTextLineBreakStyle);
procedure ChDir( const S: string ); overload ;
procedure ChDir(P: PChar); overload ;
function Flush( var t: Text): Integer;
procedure _LGetDir(D: Byte; var S: string );
procedure _SGetDir(D: Byte; var S: ShortString);
function IOResult: Integer;
procedure MkDir( const S: string ); overload ;
procedure MkDir(P: PChar); overload ;
procedure Move( const Source; var Dest; Count: Integer);
function ParamCount: Integer;
function ParamStr(Index: Integer): string ;
procedure Randomize;
procedure RmDir( const S: string ); overload ;
procedure RmDir(P: PChar); overload ;
function UpCase(Ch: Char): Char;
{ Control 8087 control word }
procedure Set8087CW(NewCW: Word);
function Get8087CW: Word;
{ Wide character support procedures and functions for C++ }
{ These functions should not be used in Delphi code! (conversion is implicit in Delphi code) }
function WideCharToString(Source: PWideChar): string ;
function WideCharLenToString(Source: PWideChar; SourceLen: Integer): string ;
procedure WideCharToStrVar(Source: PWideChar; var Dest: string );
procedure WideCharLenToStrVar(Source: PWideChar; SourceLen: Integer; var Dest: string );
function StringToWideChar( const Source: string ; Dest: PWideChar; DestSize: Integer): PWideChar;
{ PUCS4Chars returns a pointer to the UCS4 char data in the UCS4String array, or a pointer to a null char if UCS4String is empty }
function PUCS4Chars( const S: UCS4String): PUCS4Char;
{ Widestring <-> UCS4 conversion }
function WideStringToUCS4String( const S: WideString): UCS4String;
function UCS4StringToWideString( const S: UCS4String): WideString;
{ PChar/PWideChar Unicode <-> UTF8 conversion }
// UnicodeToUTF8( 3 ):
// UTF8ToUnicode( 3 ):
// Scans the source data to find the null terminator, up to MaxBytes
// Dest must have MaxBytes available in Dest.
// MaxDestBytes includes the null terminator (last char in the buffer will be set to null)
// Function result includes the null terminator.
function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: Integer): Integer; overload ; deprecated;
function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: Integer): Integer; overload ; deprecated;
// UnicodeToUtf8( 4 ):
// UTF8ToUnicode( 4 ):
// MaxDestBytes includes the null terminator (last char in the buffer will be set to null)
// Function result includes the null terminator.
// Nulls in the source data are not considered terminators - SourceChars must be accurate
function UnicodeToUtf8(Dest: PChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal; overload ;
function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal; overload ;
{ WideString <-> UTF8 conversion }
function UTF8Encode( const WS: WideString): UTF8String;
function UTF8Decode( const S: UTF8String): WideString;
{ Ansi <-> UTF8 conversion }
function AnsiToUtf8( const S: string ): UTF8String;
function Utf8ToAnsi( const S: UTF8String): string ;
{ OLE string support procedures and functions }
function OleStrToString(Source: PWideChar): string ;
procedure OleStrToStrVar(Source: PWideChar; var Dest: string );
function StringToOleStr( const Source: string ): PWideChar;
{ Variant manager support procedures and functions (obsolete - see Variants.pas) }
procedure GetVariantManager( var VarMgr: TVariantManager); deprecated;
procedure SetVariantManager( const VarMgr: TVariantManager); deprecated;
function IsVariantManagerSet: Boolean; deprecated;
{ Interface dispatch support }
procedure _IntfDispCall; cdecl ; // ARGS PLEASE!
procedure _IntfVarCall; cdecl ; // ARGS PLEASE!
{ Package/Module registration and unregistration }
type
PLibModule = ^TLibModule;
TLibModule = record
Next: PLibModule;
Instance: LongWord;
CodeInstance: LongWord;
DataInstance: LongWord;
ResInstance: LongWord;
Reserved: Integer;
end ;
TEnumModuleFunc = function (HInstance: Integer; Data: Pointer): Boolean;
{ $EXTERNALSYM TEnumModuleFunc }
TEnumModuleFuncLW = function (HInstance: LongWord; Data: Pointer): Boolean;
{ $EXTERNALSYM TEnumModuleFuncLW }
TModuleUnloadProc = procedure (HInstance: Integer);
{ $EXTERNALSYM TModuleUnloadProc }
TModuleUnloadProcLW = procedure (HInstance: LongWord);
{ $EXTERNALSYM TModuleUnloadProcLW }
PModuleUnloadRec = ^TModuleUnloadRec;
TModuleUnloadRec = record
Next: PModuleUnloadRec;
Proc: TModuleUnloadProcLW;
end ;
var
LibModuleList: PLibModule = nil ;
ModuleUnloadList: PModuleUnloadRec = nil ;
procedure RegisterModule(LibModule: PLibModule);
procedure UnregisterModule(LibModule: PLibModule);
function FindHInstance(Address: Pointer): LongWord;
function FindClassHInstance(ClassType: TClass): LongWord;
function FindResourceHInstance(Instance: LongWord): LongWord;
function LoadResourceModule(ModuleName: PChar; CheckOwner: Boolean = True): LongWord;
procedure EnumModules(Func: TEnumModuleFunc; Data: Pointer); overload ;
procedure EnumResourceModules(Func: TEnumModuleFunc; Data: Pointer); overload ;
procedure EnumModules(Func: TEnumModuleFuncLW; Data: Pointer); overload ;
procedure EnumResourceModules(Func: TEnumModuleFuncLW; Data: Pointer); overload ;
procedure AddModuleUnloadProc(Proc: TModuleUnloadProc); overload ;
procedure RemoveModuleUnloadProc(Proc: TModuleUnloadProc); overload ;
procedure AddModuleUnloadProc(Proc: TModuleUnloadProcLW); overload ;
procedure RemoveModuleUnloadProc(Proc: TModuleUnloadProcLW); overload ;
{ ResString support function/record }
type
PResStringRec = ^TResStringRec;
TResStringRec = packed record
Module: ^Cardinal;
Identifier: Integer;
end ;
function LoadResString(ResStringRec: PResStringRec): string ;
{ Procedures and functions that need compiler magic }
procedure _COS;
procedure _EXP;
procedure _INT;
procedure _SIN;
procedure _FRAC;
procedure _ROUND;
procedure _TRUNC;
procedure _AbstractError;
procedure _Assert( const Message, Filename: AnsiString; LineNumber: Integer);
function _Append( var t: TTextRec): Integer;
function _Assign( var t: TTextRec; const S: String): Integer;
function _BlockRead( var f: TFileRec; buffer: Pointer; recCnt: Longint; var recsRead: Longint): Longint;
function _BlockWrite( var f: TFileRec; buffer: Pointer; recCnt: Longint; var recsWritten: Longint): Longint;
function _Close( var t: TTextRec): Integer;
procedure _PStrCat;
procedure _PStrNCat;
procedure _PStrCpy(Dest: PShortString; Source: PShortString);
procedure _PStrNCpy(Dest: PShortString; Source: PShortString; MaxLen: Byte);
function _EofFile( var f: TFileRec): Boolean;
function _EofText( var t: TTextRec): Boolean;
function _Eoln( var t: TTextRec): Boolean;
procedure _Erase( var f: TFileRec);
function _FilePos( var f: TFileRec): Longint;
function _FileSize( var f: TFileRec): Longint;
procedure _FillChar( var Dest; count: Integer; Value: Char);
function _FreeMem(P: Pointer): Integer;
function _GetMem(Size: Integer): Pointer;
function _ReallocMem( var P: Pointer; NewSize: Integer): Pointer;
procedure _Halt(Code: Integer);
procedure _Halt0;
procedure Mark; deprecated;
procedure _PStrCmp;
procedure _AStrCmp;
procedure _RandInt;
procedure _RandExt;
function _ReadRec( var f: TFileRec; Buffer: Pointer): Integer;
function _ReadChar( var t: TTextRec): Char;
function _ReadLong( var t: TTextRec): Longint;
procedure _ReadString( var t: TTextRec; s: PShortString; maxLen: Longint);
procedure _ReadCString( var t: TTextRec; s: PChar; maxLen: Longint);
procedure _ReadLString( var t: TTextRec; var s: AnsiString);
procedure _ReadWString( var t: TTextRec; var s: WideString);
procedure _ReadWCString( var t: TTextRec; s: PWideChar; maxBytes: Longint);
function _ReadWChar( var t: TTextRec): WideChar;
function _ReadExt( var t: TTextRec): Extended;
procedure _ReadLn( var t: TTextRec);
procedure _Rename( var f: TFileRec; newName: PChar);
procedure Release; deprecated;
function _ResetText( var t: TTextRec): Integer;
function _ResetFile( var f: TFileRec; recSize: Longint): Integer;
function _RewritText( var t: TTextRec): Integer;
function _RewritFile( var f: TFileRec; recSize: Longint): Integer;
procedure _RunError(errorCode: Byte);
procedure _Run0Error;
procedure _Seek( var f: TFileRec; recNum: Cardinal);
function _SeekEof( var t: TTextRec): Boolean;
function _SeekEoln( var t: TTextRec): Boolean;
procedure _SetTextBuf( var t: TTextRec; p: Pointer; size: Longint);
procedure _StrLong(val, Longint; s: PShortString);
procedure _Str0Long(val: Longint; s: PShortString);
procedure _Truncate( var f: TFileRec);
function _ValLong( const s: String; var code: Integer): Longint;
function _WriteRec( var f: TFileRec; buffer: Pointer): Pointer;
function _WriteChar( var t: TTextRec; c: Char; Integer): Pointer;
function _Write0Char( var t: TTextRec; c: Char): Pointer;
function _WriteBool( var t: TTextRec; val: Boolean; Longint): Pointer;
function _Write0Bool( var t: TTextRec; val: Boolean): Pointer;
function _WriteLong( var t: TTextRec; val, Longint): Pointer;
function _Write0Long( var t: TTextRec; val: Longint): Pointer;
function _WriteString( var t: TTextRec; const s: ShortString; Longint): Pointer;
function _Write0String( var t: TTextRec; const s: ShortString): Pointer;
function _WriteCString( var t: TTextRec; s: PChar; Longint): Pointer;
function _Write0CString( var t: TTextRec; s: PChar): Pointer;
function _Write0LString( var t: TTextRec; const s: AnsiString): Pointer;
function _WriteLString( var t: TTextRec; const s: AnsiString; Longint): Pointer;
function _Write0WString( var t: TTextRec; const s: WideString): Pointer;
function _WriteWString( var t: TTextRec; const s: WideString; Longint): Pointer;
function _WriteWCString( var t: TTextRec; s: PWideChar; Longint): Pointer;
function _Write0WCString( var t: TTextRec; s: PWideChar): Pointer;
function _WriteWChar( var t: TTextRec; c: WideChar; Integer): Pointer;
function _Write0WChar( var t: TTextRec; c: WideChar): Pointer;
function _WriteVariant( var T: TTextRec; const V: TVarData; Width: Integer): Pointer;
function _Write0Variant( var T: TTextRec; const V: TVarData): Pointer;
procedure _Write2Ext;
procedure _Write1Ext;
procedure _Write0Ext;
function _WriteLn( var t: TTextRec): Pointer;
procedure __CToPasStr(Dest: PShortString; const Source: PChar);
procedure __CLenToPasStr(Dest: PShortString; const Source: PChar; MaxLen: Integer);
procedure __ArrayToPasStr(Dest: PShortString; const Source: PChar; Len: Integer);
procedure __PasToCStr( const Source: PShortString; const Dest: PChar);
procedure __IOTest;
function _Flush( var t: TTextRec): Integer;
procedure _SetElem;
procedure _SetRange;
procedure _SetEq;
procedure _SetLe;
procedure _SetIntersect;
procedure _SetIntersect3; { BEG only }
procedure _SetUnion;
procedure _SetUnion3; { BEG only }
procedure _SetSub;
procedure _SetSub3; { BEG only }
procedure _SetExpand;
procedure _Str2Ext;
procedure _Str0Ext;
procedure _Str1Ext;
procedure _ValExt;
procedure _Pow10;
procedure _Real2Ext;
procedure _Ext2Real;
procedure _ObjSetup;
procedure _ObjCopy;
procedure _Fail;
procedure _BoundErr;
procedure _IntOver;
{ Module initialization context. For internal use only. }
type
PInitContext = ^TInitContext;
TInitContext = record
OuterContext: PInitContext; { saved InitContext }
{ $IFNDEF PC_MAPPED_EXCEPTIONS }
ExcFrame: Pointer; { bottom exc handler }
{ $ENDIF }
InitTable: PackageInfo; { unit init info }
InitCount: Integer; { how far we got }
Module: PLibModule; { ptr to module desc }
DLLSaveEBP: Pointer; { saved regs for DLLs }
DLLSaveEBX: Pointer; { saved regs for DLLs }
DLLSaveESI: Pointer; { saved regs for DLLs }
DLLSaveEDI: Pointer; { saved regs for DLLs }
{ $IFDEF MSWINDOWS }
ExitProcessTLS: procedure ; { Shutdown for TLS }
{ $ENDIF }
DLLInitState: Byte; { 0 = package, 1 = DLL shutdown, 2 = DLL startup }
end platform;
type
TDLLProc = procedure (Reason: Integer);
// TDLLProcEx provides the reserved param returned by WinNT
TDLLProcEx = procedure (Reason: Integer; Reserved: Integer);
{ $IFDEF MSWINDOWS }
procedure _StartExe(InitTable: PackageInfo; Module: PLibModule);
procedure _StartLib;
{ $ENDIF }
procedure _PackageLoad( const Table : PackageInfo; Module: PLibModule);
procedure _PackageUnload( const Table : PackageInfo; Module: PLibModule);
procedure _InitResStrings;
procedure _InitResStringImports;
procedure _InitImports;
{ $IFDEF MSWINDOWS }
procedure _InitWideStrings;
{ $ENDIF }
function _ClassCreate(AClass: TClass; Alloc: Boolean): TObject;
procedure _ClassDestroy(Instance: TObject);
function _AfterConstruction(Instance: TObject): TObject;
function _BeforeDestruction(Instance: TObject; OuterMost: ShortInt): TObject;
function _IsClass(Child: TObject; Parent: TClass): Boolean;
function _AsClass(Child: TObject; Parent: TClass): TObject;
{ $IFDEF PC_MAPPED_EXCEPTIONS }
procedure _RaiseAtExcept;
// procedure _DestroyException(Exc: PRaisedException);
procedure _DestroyException;
{ $ENDIF }
procedure _RaiseExcept;
procedure _RaiseAgain;
procedure _DoneExcept;
{ $IFNDEF PC_MAPPED_EXCEPTIONS }
procedure _TryFinallyExit;
{ $ENDIF }
procedure _HandleAnyException;
procedure _HandleFinally;
procedure _HandleOnException;
{ $IFDEF PC_MAPPED_EXCEPTIONS }
procedure _HandleOnExceptionPIC;
{ $ENDIF }
procedure _HandleAutoException;
{ $IFDEF PC_MAPPED_EXCEPTIONS }
procedure _ClassHandleException;
{ $ENDIF }
procedure _CallDynaInst;
procedure _CallDynaClass;
procedure _FindDynaInst;
procedure _FindDynaClass;
procedure _LStrClr( var S);
procedure _LStrArrayClr( var StrArray; cnt: longint);
procedure _LStrAsg( var dest; const source);
procedure _LStrLAsg( var dest; const source);
procedure _LStrFromPCharLen( var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
procedure _LStrFromPWCharLen( var Dest: AnsiString; Source: PWideChar; Length: Integer);
procedure _LStrFromChar( var Dest: AnsiString; Source: AnsiChar);
procedure _LStrFromWChar( var Dest: AnsiString; Source: WideChar);
procedure _LStrFromPChar( var Dest: AnsiString; Source: PAnsiChar);
procedure _LStrFromPWChar( var Dest: AnsiString; Source: PWideChar);
procedure _LStrFromString( var Dest: AnsiString; const Source: ShortString);
procedure _LStrFromArray( var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
procedure _LStrFromWArray( var Dest: AnsiString; Source: PWideChar; Length: Integer);
procedure _LStrFromWStr( var Dest: AnsiString; const Source: WideString);
procedure _LStrToString { (var Dest: ShortString; const Source: AnsiString; MaxLen: Integer) } ;
function _LStrLen( const s: AnsiString): Longint;
procedure _LStrCat { var dest: AnsiString; source: AnsiString } ;
procedure _LStrCat3 { var dest:AnsiString; source1: AnsiString; source2: AnsiString } ;
procedure _LStrCatN { var dest:AnsiString; argCnt: Integer; ... } ;
procedure _LStrCmp { left: AnsiString; right: AnsiString } ;
function _LStrAddRef( var str): Pointer;
function _LStrToPChar( const s: AnsiString): PChar;
procedure _Copy { s : ShortString; index, count : Integer ) : ShortString } ;
procedure _Delete { var s : openstring; index, count : Integer } ;
procedure _Insert { source : ShortString; var s : openstring; index : Integer } ;
procedure _Pos { substr : ShortString; s : ShortString ) : Integer } ;
procedure _SetLength(s: PShortString; newLength: Byte);
procedure _SetString(s: PShortString; buffer: PChar; len: Byte);
procedure UniqueString( var str: AnsiString); overload ;
procedure UniqueString( var str: WideString); overload ;
procedure _UniqueStringA( var str: AnsiString);
procedure _UniqueStringW( var str: WideString);
procedure _LStrCopy { const s : AnsiString; index, count : Integer) : AnsiString } ;
procedure _LStrDelete { var s : AnsiString; index, count : Integer } ;
procedure _LStrInsert { const source : AnsiString; var s : AnsiString; index : Integer } ;
procedure _LStrPos { const substr : AnsiString; const s : AnsiString ) : Integer } ;
procedure _LStrSetLength { var str: AnsiString; newLength: Integer } ;
procedure _LStrOfChar { c: Char; count: Integer): AnsiString } ;
function _NewAnsiString(length: Longint): Pointer; { for debugger purposes only }
function _NewWideString(CharLength: Longint): Pointer;
procedure _WStrClr( var S);
procedure _WStrArrayClr( var StrArray; Count: Integer);
procedure _WStrAsg( var Dest: WideString; const Source: WideString);
procedure _WStrLAsg( var Dest: WideString; const Source: WideString);
function _WStrToPWChar( const S: WideString): PWideChar;
function _WStrLen( const S: WideString): Integer;
procedure _WStrFromPCharLen( var Dest: WideString; Source: PAnsiChar; Length: Integer);
procedure _WStrFromPWCharLen( var Dest: WideString; Source: PWideChar; CharLength: Integer);
procedure _WStrFromChar( var Dest: WideString; Source: AnsiChar);
procedure _WStrFromWChar( var Dest: WideString; Source: WideChar);
procedure _WStrFromPChar( var Dest: WideString; Source: PAnsiChar);
procedure _WStrFromPWChar( var Dest: WideString; Source: PWideChar);
procedure _WStrFromString( var Dest: WideString; const Source: ShortString);
procedure _WStrFromArray( var Dest: WideString; Source: PAnsiChar; Length: Integer);
procedure _WStrFromWArray( var Dest: WideString; Source: PWideChar; Length: Integer);
procedure _WStrFromLStr( var Dest: WideString; const Source: AnsiString);
procedure _WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
procedure _WStrCat( var Dest: WideString; const Source: WideString);
procedure _WStrCat3( var Dest: WideString; const Source1, Source2: WideString);
procedure _WStrCatN { var dest:WideString; argCnt: Integer; ... } ;
procedure _WStrCmp { left: WideString; right: WideString } ;
function _WStrCopy( const S: WideString; Index, Count: Integer): WideString;
procedure _WStrDelete( var S: WideString; Index, Count: Integer);
procedure _WStrInsert( const Source: WideString; var Dest: WideString; Index: Integer);
procedure _WStrPos { const substr : WideString; const s : WideString ) : Integer } ;
procedure _WStrSetLength( var S: WideString; NewLength: Integer);
function _WStrOfWChar(Ch: WideChar; Count: Integer): WideString;
function _WStrAddRef( var str: WideString): Pointer;
procedure _Initialize(p: Pointer; typeInfo: Pointer);
procedure _InitializeArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
procedure _InitializeRecord(p: Pointer; typeInfo: Pointer);
procedure _Finalize(p: Pointer; typeInfo: Pointer);
procedure _FinalizeArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
procedure _FinalizeRecord(P: Pointer; typeInfo: Pointer);
procedure _AddRef;
procedure _AddRefArray;
procedure _AddRefRecord;
procedure _CopyArray;
procedure _CopyRecord;
procedure _CopyObject;
function _New(size: Longint; typeInfo: Pointer): Pointer;
procedure _Dispose(p: Pointer; typeInfo: Pointer);
{ 64-bit Integer helper routines }
procedure __llmul;
procedure __lldiv;
procedure __lludiv;
procedure __llmod;
procedure __llmulo;
procedure __lldivo;
procedure __llmodo;
procedure __llumod;
procedure __llshl;
procedure __llushr;
procedure _WriteInt64;
procedure _Write0Int64;
procedure _ReadInt64;
function _StrInt64(val: Int64; Integer): ShortString;
function _Str0Int64(val: Int64): ShortString;
function _ValInt64( const s: AnsiString; var code: Integer): Int64;
{ Dynamic array helper functions }
procedure _DynArrayHigh;
procedure _DynArrayClear( var a: Pointer; typeInfo: Pointer);
procedure _DynArrayLength;
procedure _DynArraySetLength;
procedure _DynArrayCopy(a: Pointer; typeInfo: Pointer; var Result: Pointer);
procedure _DynArrayCopyRange(a: Pointer; typeInfo: Pointer; index, count : Integer; var Result: Pointer);
procedure _DynArrayAsg;
procedure _DynArrayAddRef;
procedure DynArrayClear( var a: Pointer; typeInfo: Pointer);
procedure DynArraySetLength( var a: Pointer; typeInfo: Pointer; dimCnt: Longint; lengthVec: PLongint);
function DynArrayDim(typeInfo: PDynArrayTypeInfo): Integer;
{ $NODEFINE DynArrayDim }
function _IntfClear( var Dest: IInterface): Pointer;
procedure _IntfCopy( var Dest: IInterface; const Source: IInterface);
procedure _IntfCast( var Dest: IInterface; const Source: IInterface; const IID: TGUID);
procedure _IntfAddRef( const Dest: IInterface);
{ $IFDEF MSWINDOWS }
procedure _FSafeDivide;
procedure _FSafeDivideR;
{ $ENDIF }
function _CheckAutoResult(ResultCode: HResult): HResult;
procedure FPower10;
procedure TextStart; deprecated;
// Conversion utility routines for C++ convenience. Not for Delphi code.
function CompToDouble(Value: Comp): Double; cdecl ;
procedure DoubleToComp(Value: Double; var Result: Comp); cdecl ;
function CompToCurrency(Value: Comp): Currency; cdecl ;
procedure CurrencyToComp(Value: Currency; var Result: Comp); cdecl ;
function GetMemory(Size: Integer): Pointer; cdecl ;
function FreeMemory(P: Pointer): Integer; cdecl ;
function ReallocMemory(P: Pointer; Size: Integer): Pointer; cdecl ;
{ Internal runtime error codes }
type
TRuntimeError = (reNone, reOutOfMemory, reInvalidPtr, reDivByZero,
reRangeError, reIntOverflow, reInvalidOp, reZeroDivide, reOverflow,
reUnderflow, reInvalidCast, reAccessViolation, rePrivInstruction,
reControlBreak, reStackOverflow,
{ reVar* used in Variants.pas }
reVarTypeCast, reVarInvalidOp,
reVarDispatch, reVarArrayCreate, reVarNotArray, reVarArrayBounds,
reAssertionFailed,
reExternalException, { not used here; in SysUtils }
reIntfCastError, reSafeCallError
);
{ $NODEFINE TRuntimeError }
procedure Error(errorCode: TRuntimeError);
{ $NODEFINE Error }
{ GetLastError returns the last error reported by an OS API call. Calling
this function usually resets the OS error state.
}
function GetLastError: Integer; { $IFDEF MSWINDOWS } stdcall ; { $ENDIF }
{ $EXTERNALSYM GetLastError }
{ SetLastError writes to the thread local storage area read by GetLastError. }
procedure SetLastError(ErrorCode: Integer); { $IFDEF MSWINDOWS } stdcall ; { $ENDIF }
查看更多关于D7的System.pas单元的声明部分的详细内容...
声明：本文来自网络，不代表【好得很程序员自学网】立场，转载请注明出处：http://www.haodehen.cn/did48474