idglobal.pas

Indy控件的使用源代码

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10169: IdGlobal.pas 
{
{   Rev 1.2    1/9/2003 05:44:10 PM  JPMugaas
{ Added workaround for if a space is missing after the comma in a date.  For
{ example:
{ 
{ Wed,08 Jan 2003 08:09:16 PM
}
{
{   Rev 1.1    29/11/2002 10:16:40 AM  SGrobety
{ Changed GetTickCount to use high permormance counters if possible under
{ Windows
}
{
{   Rev 1.0    2002.11.12 10:39:16 PM  czhower
}
unit IdGlobal;

interface
{
2002-04-02 - Darren Kosinski (Borland) - Have SetThreadPriority do nothing on Linux.
2002-01-28 - Hadi Hariri. Fixes for C++ Builder. Thanks to Chuck Smith.
2001-12-21 - Andrew P.Rybin
 - Fetch,FetchCaseInsensitive,IsNumeric(Chr),PosIdx,AnsiPosIdx optimization
2001-Nov-26 - Peter Mee
 - Added IndyStrToBool
2001-Nov-21 - Peter Mee
 - Moved the Fetch function's default values to constants.
 - Added FetchCaseInsensitive.
11-10-2001 - J. Peter Mugaas
  - Merged changes proposed by Andrew P.Rybin}

{$I IdCompilerDefines.inc}

{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.}

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  Classes,
  IdException,
  SyncObjs, SysUtils;

type
  TIdOSType = (otUnknown, otLinux, otWindows);

const
  IdTimeoutDefault = -1;
  IdTimeoutInfinite = -2;

  IdFetchDelimDefault = ' ';    {Do not Localize}
  IdFetchDeleteDefault = true;
  IdFetchCaseSensitiveDefault = true;
  //We make the version things an INC so that they can be managed independantly
  //by the package builder.
  {$I IdVers.inc}
  //
  CHAR0 = #0;
  BACKSPACE = #8;
  LF = #10;
  CR = #13;
  EOL = CR + LF;
  TAB = #9;
  CHAR32 = #32;
  {$IFNDEF VCL6ORABOVE}
  //Only D6&Kylix have this constant
  sLineBreak = EOL;
  {$ENDIF}

  LWS = [TAB, CHAR32];
  wdays: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri'    {Do not Localize}
   , 'Sat'); {do not localize}
  monthnames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May'    {Do not Localize}
   , 'Jun',  'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); {do not localize}
  IdHexDigits: array [0..15] of Char = '0123456789ABCDEF';    {Do not Localize}

  {$IFDEF Linux}
  GPathDelim = '/'; {do not localize}
  GOSType = otLinux;
  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}
  GPathDelim = '\'; {do not localize}
  GOSType = otWindows;
  infinite = windows.INFINITE; { redeclare here for use elsewhere without using Windows.pas }  // cls modified 1/23/2002
  {$ENDIF}

type
  {$IFDEF LINUX}
    {$IFNDEF VCL6ORABOVE}
    THandle = LongWord; //D6.System
    {$ENDIF}
  TIdThreadPriority = -20..19;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
    {$IFNDEF VCL6ORABOVE}
    THandle = Windows.THandle;
    {$ENDIF}
  TIdThreadPriority = TThreadPriority;
  {$ENDIF}

  {This way instead of a boolean for future expansion of other actions}
  TIdMaxLineAction = (maException, maSplit);

  TIdReadLnFunction = function: string of object;
  TStringEvent = procedure(ASender: TComponent; const AString: String);
  TPosProc = function(const Substr, S: string): Integer;
  TIdReuseSocket = (rsOSDependent, rsTrue, rsFalse);

  TIdCardinalBytes = record
    case Integer of
    0: (
      Byte1: Byte;
      Byte2: Byte;
      Byte3: Byte;
      Byte4: Byte;);
    1: (Whole: Cardinal);
    2: (CharArray : array[0..3] of Char);
  end;

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

  TIdMimeTable = class(TObject)
  protected
    FOnBuildCache: TNotifyEvent;
    FMIMEList: TStringList;
    FFileExt: TStringList;
    procedure BuildDefaultCache; virtual;
  public
    procedure BuildCache; virtual;
    procedure AddMimeType(const Ext, MIMEType: string);
    function GetFileMIMEType(const AFileName: string): string;
    function GetDefaultFileExt(Const MIMEType: string): string;
    procedure LoadFromStrings(AStrings: TStrings; const MimeSeparator: Char = '=');    {Do not Localize}
    procedure SaveToStrings(AStrings: TStrings; const MimeSeparator: Char = '=');    {Do not Localize}
    constructor Create(Autofill: boolean=true); virtual;
    destructor Destroy; override;
    //
    property  OnBuildCache: TNotifyEvent read FOnBuildCache write FOnBuildCache;
  end;

  //APR: for fast Stream reading (ex: StringStream killer)
  TIdReadMemoryStream = class (TCustomMemoryStream)
  public
    procedure SetPointer(Ptr: Pointer; Size: Longint);
    function Write(const Buffer; Count: Longint): Longint; override;
  End;

  // TODO: add ALL IANA charsets
  TIdCharSet = (csGB2312, csBig5, csIso2022jp, csEucKR, csIso88591);

  {$IFNDEF VCL6ORABOVE}
  PByte =^Byte;
  PWord =^Word;
  {$ENDIF}

  {$IFDEF LINUX}
  TIdPID = Integer;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  TIdPID = LongWord;
  {$ENDIF}

  {$IFDEF MSWINDOWS}
  TIdWin32Type = (Win32s, WindowsNT40, Windows95, Windows95OSR2, Windows98, Windows98SE,Windows2000, WindowsMe, WindowsXP);
  {$ENDIF}

  //This is called whenever there is a failure to retreive the time zone information
  EIdFailedToRetreiveTimeZoneInfo = class(EIdException);
  //This usually is a property editor exception
  EIdCorruptServicesFile = class(EIdException);
  //
  EIdExtensionAlreadyExists = class(EIdException);

// Procs - KEEP THESE ALPHABETICAL!!!!!
  function  AnsiMemoryPos(const ASubStr: String; MemBuff: PChar; MemorySize: Integer): Integer;
  function  AnsiPosIdx(const ASubStr,AStr: AnsiString; AStartPos: Cardinal=0): Cardinal;
  {$IFNDEF VCL5ORABOVE}
  function  AnsiSameText(const S1, S2: string): Boolean;
  procedure FreeAndNil(var Obj);
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  function GetFileCreationTime(const Filename: string): TDateTime;
  function GetInternetFormattedFileTimeStamp(const AFilename: String): String;
  {$ENDIF}
//  procedure BuildMIMETypeMap(dest: TStringList);
  // TODO: IdStrings have optimized SplitColumns* functions, can we remove it?
  function BreakApart(BaseString, BreakString: string; StringList: TStrings): TStrings;
  procedure CommaSeparatedToStringList(AList: TStrings; const Value:string);
  function CopyFileTo(const Source, Destination: string): Boolean;
  function CurrentProcessId: TIdPID;
  function DateTimeToGmtOffSetStr(ADateTime: TDateTime; SubGMT: Boolean): string;
  function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
  Function DateTimeToInternetStr(const Value: TDateTime; const AIsGMT : Boolean = False) : String;
  procedure DebugOutput(const AText: string);
  function DomainName(const AHost: String): 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 FileSizeByName(const AFilename: string): Int64;
  function GetMIMETypeFromFile(const AFile: TFileName): string;
  function GetSystemLocale: TIdCharSet;
  function GetThreadHandle(AThread: TThread): THandle;
  function GetTickCount: Cardinal;
  //required because GetTickCount will wrap
  function GetTickDiff(const AOldTickCount, ANewTickCount : Cardinal):Cardinal;
  function GmtOffsetStrToDateTime(S: string): TDateTime;
  function GMTToLocalDateTime(S: string): TDateTime;
  function IdPorts: TList;
  function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer; overload;
  function iif(ATest: Boolean; const ATrue: string;  const AFalse: string): string; overload;
  function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean; overload;
  function IncludeTrailingSlash(const APath: string): string;
  function IntToBin(Value: cardinal): string;
  function IndyGetHostName: string;
  function IndyInterlockedIncrement(var I: Integer): Integer;
  function IndyInterlockedDecrement(var I: Integer): Integer;
  function IndyInterlockedExchange(var A: Integer; B: Integer): Integer;
  function IndyInterlockedExchangeAdd(var A: Integer; B: Integer): Integer;
  function IndyStrToBool(const AString: String): Boolean;
  function IsCurrentThread(AThread: TThread): boolean;
  function IsDomain(const S: String): Boolean;
  function IsFQDN(const S: String): Boolean;
  function IsHostname(const S: String): Boolean;
  function IsNumeric(AChar: Char): Boolean; overload;
  function IsNumeric(const AString: string): Boolean; overload;
  function IsTopDomain(const AStr: string): Boolean;
  function IsValidIP(const S: String): Boolean;
  function InMainThread: boolean;
  function Max(AValueOne,AValueTwo: Integer): Integer;
  {APR: Help function to construct TMethod record. Can be useful to assign regular type procedure/function as event handler
  for event, defined as object method (do not forget, that in that case it must have first dummy parameter to replace @Self,
  passed in EAX to methods of object)}
  function MakeMethod (DataSelf, Code: Pointer): TMethod;
  function MakeTempFilename(const APath: String = ''): string;
  function Min(AValueOne, AValueTwo: Integer): Integer;
  function OffsetFromUTC: TDateTime;
  function PosIdx (const ASubStr,AStr: AnsiString; AStartPos: Cardinal=0): Cardinal;//For "ignoreCase" use AnsiUpperCase
  function PosInStrArray(const SearchStr: string; Contents: array of string;
    const CaseSensitive: Boolean=True): Integer;
  function ProcessPath(const ABasePath: String; const APath: String;
    const APathDelim: string = '/'): string;    {Do not Localize}
  function RightStr(const AStr: String; Len: Integer): String;
  function ROL(AVal: LongWord; AShift: Byte): LongWord;
  function ROR(AVal: LongWord; AShift: Byte): LongWord;
  function RPos(const ASub, AIn: String; AStart: Integer = -1): Integer;
  function SetLocalTime(Value: TDateTime): boolean;
  procedure SetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority; const APolicy: Integer = -MaxInt);
  procedure Sleep(ATime: cardinal);
  function StrToCard(const AStr: String): Cardinal;
  function StrInternetToDateTime(Value: string): TDateTime;
  function StrToDay(const ADay: string): Byte;
  function StrToMonth(const AMonth: string): Byte;
  function MemoryPos(const ASubStr: String; MemBuff: PChar; MemorySize: Integer): Integer;
  function TimeZoneBias: TDateTime;
  function UpCaseFirst(const AStr: string): string;
  {$IFDEF MSWINDOWS}
  function Win32Type : TIdWin32Type;
  {$ENDIF}

var
  IndyPos: TPosProc = nil;
  {$IFDEF LINUX}
  // For linux the user needs to set these variables to be accurate where used (mail, etc)
  GOffsetFromUTC: TDateTime = 0;
  GSystemLocale: TIdCharSet = csIso88591;
  GTimeZoneBias: TDateTime = 0;
  {$ENDIF}

  IndyFalseBoolStrs : array of String;
  IndyTrueBoolStrs : array of String;

implementation

uses
  {$IFDEF LINUX}
  Libc,
  IdStackLinux,
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  IdStackWindows,
  Registry,
  {$ENDIF}
  IdStack, IdResourceStrings, IdURI;

const
  WhiteSpace = [#0..#12, #14..' ']; {do not localize}


var
  FIdPorts: TList;
  {$IFDEF MSWINDOWS}
  ATempPath: string;
  {$ENDIF}

{This routine is based on JPM Open by J. Peter Mugaas.  Permission is granted
to use this with Indy under Indy's Licenses

Note that JPM Open is under a different Open Source license model.

It is available at http://www.wvnet.edu/~oma00215/jpm.html }

{$IFDEF MSWINDOWS}
function Win32Type: TIdWin32Type;
begin
  {VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);  GetVersionEx(VerInfo);}
  {is this Windows 2000 or XP?}
  if Win32MajorVersion >= 5 then begin
    if Win32MinorVersion >= 1 then begin
      Result := WindowsXP;
    end
    else begin
      Result := Windows2000;
    end;
  end
  else begin
    {is this WIndows 95, 98, Me, or NT 40}
    if Win32MajorVersion > 3 then begin
      if Win32Platform = VER_PLATFORM_WIN32_NT then begin
        Result := WindowsNT40;
      end
      else begin
        {mask off junk}
        Win32BuildNumber := Win32BuildNumber and $FFFF;
        if Win32MinorVersion >= 90 then begin
          Result := WindowsMe;
        end
        else begin
          if Win32MinorVersion >= 10 then begin
            {Windows 98}
            if Win32BuildNumber >= 2222 then begin
              Result := Windows98SE
            end
            else begin
              Result := Windows98;
            end;
          end
          else begin {Windows 95}
            if Win32BuildNumber >= 1000 then begin
              Result := Windows95OSR2
            end
            else begin
              Result := Windows95;
            end;
          end;
        end;