idglobal.pas

网络控件适用于Delphi6

{
{   Rev 1.27    9/29/2003 03:03:28 PM  JPMugaas
{ Changed CIL to DOTNET.
}
{
{   Rev 1.26    9/28/2003 04:22:00 PM  JPMugaas
{ IFDEF'ed out MemoryPos in NET because that will not work there.
}
{
{   Rev 1.25    9/26/03 11:20:50 AM  RLebeau
{ Updated defines used with SetThreadName() to allow it to work under BCB6.
}
{
{   Rev 1.24    9/24/2003 11:42:42 PM  JPMugaas
{ Minor changes to help compile under NET
}
{
{   Rev 1.23    2003.09.20 10:25:42 AM  czhower
{ Added comment and chaned for D6 compat.
}
{
{   Rev 1.22    9/18/2003 07:43:12 PM  JPMugaas
{ Moved GetThreadHandle to IdGlobals so the ThreadComponent can be in this
{ package.
}
{
{   Rev 1.21    9/8/2003 11:44:38 AM  JPMugaas
{ Fix for problem that was introduced in an optimization.
}
{
{   Rev 1.20    2003.08.19 1:54:34 PM  czhower
{ Removed warning
}
{
{   Rev 1.19    11/8/2003 6:25:44 PM  SGrobety
{ IPv4ToDWord: Added overflow checking disabling ($Q+) and changed "* 256"  by
{ "SHL 8".
}
{
{   Rev 1.18    2003.07.08 2:41:42 PM  czhower
{ This time I saved the file before checking in.
}
{
{   Rev 1.16    7/1/2003 03:39:38 PM  JPMugaas
{ Started numeric IP function API calls for more efficiency.
}
{
{   Rev 1.15    2003.07.01 3:49:56 PM  czhower
{ Added SetThreadName
}
{
    Rev 1.14    7/1/2003 12:03:56 AM  BGooijen
  Added functions to switch between IPv6 addresses in string and in
  TIdIPv6Address form
}
{
{   Rev 1.13    6/30/2003 06:33:58 AM  JPMugaas
{ Fix for range check error.
}
{
{   Rev 1.12    6/27/2003 04:43:30 PM  JPMugaas
{ Made IPv4ToDWord overload that returns a flag for an error message.
{ Moved MakeCanonicalIPv4Address code into IPv4ToDWord because most of that
{ simply reduces IPv4 addresses into a DWord.  That also should make the
{ function more useful in reducing various alternative forms of IPv4 addresses
{ down to DWords.
}
{
{   Rev 1.11    6/27/2003 01:19:38 PM  JPMugaas
{ Added MakeCanonicalIPv4Address for converting various IPv4 address forms
{ (mentioned at http://www.pc-help.org/obscure.htm) into a standard dotted IP
{ address.  Hopefully, we should soon support octal and hexidecimal addresses.
}
{
{   Rev 1.9    6/27/2003 04:36:08 AM  JPMugaas
{ Function for converting DWord to IP adcdress.
}
{
{   Rev 1.8    6/26/2003 07:54:38 PM  JPMugaas
{ Routines for converting standard dotted IPv4 addresses into dword,
{ hexidecimal, and octal forms.
}
{
    Rev 1.7    5/11/2003 11:57:06 AM  BGooijen
  Added RaiseLastOSError
}
{
{   Rev 1.6    4/28/2003 03:19:00 PM  JPMugaas
{ Made a function for obtaining the services file FQN.  That's in case
{ something else besides IdPorts needs it.
}
{
{   Rev 1.5    2003.04.16 10:06:42 PM  czhower
{ Moved DebugOutput to IdCoreGlobal
}
{
{   Rev 1.4    12/29/2002 2:15:30 PM  JPMugaas
{ GetCurrentThreadHandle function created as per Bas's instructions.  Moved
{ THandle to IdCoreGlobal for this function.
}
{
{   Rev 1.3    12-15-2002 17:02:58  BGooijen
{ Added comments to TIdExtList
}
{
{   Rev 1.2    12-15-2002 16:45:42  BGooijen
{ Added TIdList
}
{
{   Rev 1.1    29/11/2002 10:08:50 AM  SGrobety    Version: 1.1
{ Changed GetTickCount to use high-performance timer if available under windows
}
{
{   Rev 1.0    21/11/2002 12:36:18 PM  SGrobety    Version: Indy 10
}
{
{   Rev 1.0    11/13/2002 08:41:24 AM  JPMugaas
}
unit IdGlobal;

{$I IdCompilerDefines.inc}

interface

uses
  IdTStrings,
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  {$IFDEF DotNetDistro}
  System.Collections.Specialized,
  {$ENDIF}
  {$IFDEF DotNet}
  System.net, System.net.Sockets, System.Diagnostics, System.Threading,
  System.IO, System.Text,
  {$ENDIF}
  {$IFNDEF DotNetExclude}
  SyncObjs,
  {$ENDIF}
  SysUtils, Classes,
  IdException;

const
  {This is the only unit with references to OS specific units and IFDEFs. NO OTHER units
  are permitted to do so except .pas files which are counterparts to dfm/xfm files, and only for
  support of that.}

  //We make the version things an Inc so that they can be managed independantly
  //by the package builder.
  {$I IdVers.inc}

  {$IFDEF DotNet}
  // Timeout.Infinite is -1 which violates Cardinal which VCL uses for parameter
  // so we are just setting it to this as a hard coded constant until
  // the synchro classes and other are all ported directly to portable classes
  // (SyncObjs is platform specific)
  //Infinite = Timeout.Infinite;
  INFINITE = Cardinal($FFFFFFFF);     { Infinite timeout }
  {$ENDIF}

  LF = #10;
  CR = #13;
  EOL = CR + LF;
  //
  CHAR0 = #0;
  BACKSPACE = #8;

  TAB = #9;
  CHAR32 = #32;

  //Timeout values
  IdTimeoutDefault = -1;
  IdTimeoutInfinite = -2;
  //Fetch Defaults
  IdFetchDelimDefault = ' ';    {Do not Localize}
  IdFetchDeleteDefault = True;
  IdFetchCaseSensitiveDefault = True;

  WhiteSpace = [0..12, 14..32]; {do not localize}

  IdHexDigits: array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'); {do not localize}
  IdOctalDigits: array [0..7] of AnsiChar = ('0','1','2','3','4','5','6','7'); {do not localize}
  HEXPREFIX = '0x';  {Do not translate}

  //Portable Seek() arguments.  In general, use Position (possibly with Size)
  //instead of Seek.
  {$IFDEF DotNet}
  IdFromBeginning = soBeginning;
  IdFromCurrent   = soCurrent;
  IdFromEnd       = soEnd;
  {$ELSE}
  IdFromBeginning = soFromBeginning;
  IdFromCurrent   = soFromCurrent;
  IdFromEnd       = soFromEnd;
  {$ENDIF}

type
  TIdEncoding = (enDefault, enANSI, enUTF8);

  TIdStringStream = class(TStringStream)
  public
    constructor Create(const ASrc: string); reintroduce;
  end;

  {$IFDEF DotNet}
  // dotNET implementation
  TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);

  TEvent = class(TObject)
  protected
    FEvent: WaitHandle;
  public
    constructor Create(EventAttributes: IntPtr; ManualReset,
      InitialState: Boolean; const Name: string = ''); overload;
    constructor Create; overload;
    destructor Destroy; override;
    procedure SetEvent;
    procedure ResetEvent;
    function WaitFor(Timeout: LongWord): TWaitResult; virtual;
  end;

  TCriticalSection = class(TObject)
  public
    procedure Acquire; virtual;
    procedure Release; virtual;
    function TryEnter: Boolean;
    procedure Enter;
    procedure Leave;
  end;
  {$ENDIF}

  TIdLocalEvent = class(TEvent)
  public
    constructor Create(const AInitialState: Boolean = False;
     const AManualReset: Boolean = False); reintroduce;
    function WaitForEver: TWaitResult; overload;
  end;

  // This is here to reduce all the warnings about imports. We may also ifdef
  // it to provide a non warning implementatino on this unit too later.
  TIdCriticalSection = class(TCriticalSection)
  end;

  {$IFDEF DotNet}
  Short = System.Int16;
  {$ENDIF}

  {$IFDEF LINUX}
  Short = Smallint;  //Only needed for ToBytes(Short) and BytesToShort
  {$ENDIF}

  {$IFDEF VCL4ORABOVE}
   {$IFNDEF VCL6ORABOVE} // Delphi 6 has PCardinal
  PCardinal = ^Cardinal;
   {$ENDIF}
  {$ENDIF}

   //This usually is a property editor exception
  EIdCorruptServicesFile = class(EIdException);

  {$IFNDEF DotNet}
  TBytes = array of Byte;
  {$ENDIF}
  TIdBytes = TBytes;
  TIdPort = Integer;
  //We don't have a native type that can hold an IPv6 address.
  TIdIPv6Address = array [0..7] of word;

  {This way instead of a boolean for future expansion of other actions}
  TIdMaxLineAction = (maException, maSplit);
  TIdOSType = (otUnknown, otLinux, otWindows, otDotNet);
  //This is for IPv6 support when merged into the core
  TIdIPVersion = (Id_IPv4, Id_IPv6);

  {$IFDEF LINUX}
  TIdPID = Integer;
  TIdThreadPriority = -20..19;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  TIdPID = LongWord;
  TIdThreadPriority = TThreadPriority;
  {$ENDIF}
  {$IFDEF DotNet}
  TIdPID = LongWord;
  TIdThreadPriority = TThreadPriority;
  {$ENDIF}

  {$IFDEF LINUX}
    {$IFNDEF VCL6ORABOVE}
  THandle = LongWord; //D6.System
    {$ENDIF}
  {$ENDIF}
  {$IFDEF MSWINDOWS}
    {$IFNDEF VCL6ORABOVE}
  THandle = Windows.THandle;
    {$ENDIF}
  {$ENDIF}
  {$IFDEF DotNet}
  THandle = LongWord;
  {$ENDIF}

  {$IFDEF DotNet}
  TPosProc = function(const substr, str: WideString): Integer;
  {$ELSE}
  TPosProc = function(const Substr, S: string): Integer;
  {$ENDIF}
  TIdReuseSocket = (rsOSDependent, rsTrue, rsFalse);

  {$IFNDEF VCL6ORABOVE}
  TIdExtList=class(TList) // We use this hack-class, because TList has no .assign on Delphi 5.
  public                  // Do NOT add DataMembers to this class !!!
    procedure Assign(AList: TList);
  end;
  {$ELSE}
  TIdExtList=class(TList);
  {$ENDIF}

  {$IFNDEF DotNet}
  TSeekOrigin = word;
  {$ENDIF}
  // TIdBaseStream is defined here to allow TIdMultiPartFormData to be defined
  // without any $IFDEFs in the unit IdMultiPartFormData - in accordance with Indy Coding rules
  TIdBaseStream = class (TStream)
  protected
    function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
    function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
    function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; virtual; abstract;
    procedure IdSetSize(ASize: Int64); virtual; abstract;
    {$IFDEF DotNet}
    procedure SetSize(ASize: Int64); override;
    {$ELSE}
    procedure SetSize(ASize: Integer); override;
    {$ENDIF}
  public
    {$IFDEF DotNet}
    function Read(var VBuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
    function Write(const ABuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
    function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
    {$ELSE}
    function Read(var VBuffer; ACount: Longint): Longint; override;
    function Write(const ABuffer; ACount: Longint): Longint; override;
    function Seek(AOffset: Longint; AOrigin: Word): Longint; override;
    {$ENDIF}
  end;

const
  {$IFDEF Linux}
  GOSType = otLinux;
  GPathDelim = '/'; {do not localize}
  INFINITE = LongWord($FFFFFFFF);     { Infinite timeout }

  // approximate values, its finer grained on Linux
  tpIdle = 19;
  tpLowest = 12;
  tpLower = 6;
  tpNormal = 0;
  tpHigher = -7;
  tpHighest = -13;
  tpTimeCritical = -20;
  {$ENDIF}

  {$IFDEF MSWINDOWS}
  GOSType = otWindows;
  GPathDelim = '\'; {do not localize}
  Infinite = Windows.INFINITE; { redeclare here for use elsewhere without using Windows.pas }  // cls modified 1/23/2002
  {$ENDIF}

  {$IFDEF DotNet}
  GOSType = otDotNet;
  GPathDelim = '\'; {do not localize}
//  Infinite = ?; { redeclare here for use elsewhere without using Windows.pas }  // cls modified 1/23/2002
  {$ENDIF}

  // S.G. 4/9/2002: IP version general switch for defaults
  {$IFDEF IdIPv6}
  ID_DEFAULT_IP_VERSION = Id_IPv6;
  {$ELSE}
  ID_DEFAULT_IP_VERSION = Id_IPv4;
  {$ENDIF}

  {$IFNDEF VCL6ORABOVE}
  //Only D6 & Kylix have this constant
  sLineBreak = EOL;
  {$ENDIF}

//The power constants are for processing IP addresses
//They are powers of 255.
const
  POWER_1 = $000000FF;
  POWER_2 = $0000FFFF;
  POWER_3 = $00FFFFFF;
  POWER_4 = $FFFFFFFF;

// To and From Bytes conversion routines
function ToBytes(
  const AValue: string;
  const AEncoding: TIdEncoding = enANSI
  ): TIdBytes; overload;
function ToBytes(const AValue: Char): TIdBytes; overload;
function ToBytes(const AValue: Integer): TIdBytes; overload;
function ToBytes(const AValue: Short): TIdBytes; overload;
function ToBytes(const AValue: Word): TIdBytes; overload;
function ToBytes(const AValue: Byte): TIdBytes; overload;
function ToBytes(const AValue: Cardinal): TIdBytes; overload;
function ToBytes(const AValue: Int64): TIdBytes; overload;
function ToBytes(const AValue: TIdBytes; const ASize: Integer): TIdBytes; overload;

// The following functions are faster but except that Bytes[] must have enough
// space for at least SizeOf(AValue) bytes.
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Char); overload;
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Integer); overload;
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Short); overload;
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Word); overload;
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Byte); overload;
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Cardinal); overload;
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int64); overload;
procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdBytes; const ASize: Integer); overload;

{$IFNDEF DotNet}
// RLebeau - not using the same naming convention for this function
// in order to prevent ambiquious errors with ToBytes(TIdBytes) above
function RawToBytes(const AValue; const ASize: Integer): TIdBytes; overload;
{$ENDIF}

function BytesToCardinal(const AValue: TIdBytes): Cardinal;
function BytesToWord(const AValue: TIdBytes): Word;
function ToHex(const AValue: TIdBytes): AnsiString; overload;
function ToHex(const AValue: array of LongWord): AnsiString; overload; // for IdHash
function BytesToChar(const AValue: TIdBytes): Char;
function BytesToShort(const AValue: TIdBytes): Short;
function BytesToInteger(const AValue: TIdBytes): Integer;
function BytesToInt64(const AValue: TIdBytes): Int64;
function BytesToIPv6(const AValue: TIdBytes): TIdIPv6Address;

// TIdBytes utilities
function BytesToString(ABytes: TIdBytes; AStartIndex: Integer = 0; AMaxCount: Integer = MaxInt): string; overload;
procedure AppendBytes(var VBytes: TIdBytes; AAdd: TIdBytes);
procedure AppendByte(var VBytes: TIdBytes; AByte: byte);

// Common Streaming routines
function ReadStringFromStream(AStream: TStream; ASize: Integer): string;
procedure WriteStringToStream(AStream: TStream; const AStr: string);
function ReadCharFromStream(AStream: TStream; var AChar: Char): Integer;
function ReadTIdBytesFromStream(AStream: TStream; ABytes: TIdBytes; Count: Integer): Integer;
procedure WriteTIdBytesToStream(AStream: TStream; ABytes: TIdBytes);

function ByteToHex(const AByte: Byte): string;
function ByteToOctal(const AByte: Byte): string;
procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
    var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
    var VDest: array of Byte; const ADestIndex: Integer; const ALength: Integer);
function CharIsInSet(const AString: string; const ACharPos: Integer; ASet: TSysCharSet): Boolean;
function CharIsInEOF(const AString: string; ACharPos: Integer): Boolean;
function CurrentProcessId: TIdPID;
procedure DebugOutput(const AText: string);
function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
  const ADelete: Boolean = IdFetchDeleteDefault;
  const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
function FetchCaseInsensitive(var AInput: string; const ADelim: string = IdFetchDelimDefault;
    const ADelete: Boolean = IdFetchDeleteDefault): string;
function GetCurrentThreadHandle: THandle;
function GetThreadHandle(AThread: TThread): THandle;
//GetTickDiff required because GetTickCount will wrap