idglobal.pas

网络控件适用于Delphi6

function GetTickDiff(const AOldTickCount, ANewTickCount: Cardinal): Cardinal; //IdICMP uses it
procedure IdDelete(var s: string; AOffset, ACount: Integer);
procedure IdInsert(const Source: string; var S: string; Index: Integer);
{$IFNDEF DotNet}
function IdPorts: TList;
{$ENDIF}
function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer; overload;
function iif(ATest: Boolean; const ATrue: string; const AFalse: string = ''): string; overload; { do not localize }
function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean; overload;
function IncludeTrailingSlash(const APath: string): string;
function InMainThread: Boolean;
function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: int64);
{$IFNDEF DotNetExclude}
function IsCurrentThread(AThread: TThread): boolean;
{$ENDIF}
function IPv4ToDWord(const AIPAddress: string): Cardinal; overload;
function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): Cardinal; overload;
function IPv4ToHex(const AIPAddress: string; const ASDotted: Boolean = False): string;
function IPv4ToOctal(const AIPAddress: string): string;
function IsASCII(const AByte: Byte): Boolean; overload;
function IsASCII(const ABytes: TIdBytes): Boolean; overload;
function IsASCIILDH(const AByte: Byte): Boolean; overload;
function IsASCIILDH(const ABytes: TIdBytes): Boolean; overload;
function IsHexidecimal(AChar: Char): Boolean; overload;
function IsHexidecimal(const AString: string): Boolean; overload;
function IsNumeric(AChar: Char): Boolean; overload;
function IsNumeric(const AString: string): Boolean; overload;
function IsOctal(AChar: Char): Boolean; overload;
function IsOctal(const AString: string): Boolean; overload;
function MakeCanonicalIPv4Address(const AAddr: string): string;
function MakeCanonicalIPv6Address(const AAddr: string): string;
function MakeDWordIntoIPv4Address(const ADWord: Cardinal): string;
function Max(AValueOne,AValueTwo: Integer): Integer;
{$IFNDEF DotNet}
function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
{$ENDIF}
function Min(AValueOne, AValueTwo: Integer): Integer;
function PosIdx(const ASubStr, AStr: AnsiString; AStartPos: Cardinal = 0): Cardinal; //For "ignoreCase" use AnsiUpperCase
function PosInSmallIntArray(const ASearchInt: SmallInt; AArray: array of SmallInt): Integer;
function PosInStrArray(const SearchStr: string; Contents: array of string;
    const CaseSensitive: Boolean = True): Integer;
function ServicesFilePath: string;
procedure SetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority; const APolicy: Integer = -MaxInt);
procedure SetThreadName(const AName: string);
procedure Sleep(ATime: cardinal);
//in Integer(Strings.Objects[i]) - column position in AData
procedure SplitColumnsNoTrim(const AData: string; AStrings: TIdStrings; const ADelim: string = ' ');    {Do not Localize}
procedure SplitColumns(const AData: string; AStrings: TIdStrings; const ADelim: string = ' ');    {Do not Localize}
function StartsWithACE(const ABytes: TIdBytes): Boolean;
function TextIsSame(const A1: string; const A2: string): Boolean;
function IndyUpperCase(const A1: string): string;
function IndyLowerCase(const A1: string): string;
function IndyCompareStr(const A1: string; const A2: string): Integer;
function Ticks: Cardinal;
procedure ToDo;
function TwoByteToWord(AByte1, AByte2: Byte): Word;

var
  IndyPos: TPosProc = nil;
  {$IFNDEF VCL6ORABOVE}
    {$IFDEF MSWINDOWS}
  RaiseLastOSError: procedure = SysUtils.RaiseLastWin32Error;
    {$ELSE}
  RaiseLastOSError: procedure = SysUtils.RaiseLastOSError;
    {$ENDIF}
  {$ELSE}
  RaiseLastOSError: procedure = SysUtils.RaiseLastOSError;
  {$ENDIF}

implementation

uses
  {$IFDEF LINUX} Libc, {$ENDIF}
  IdResourceStrings;

{$IFNDEF DotNet}
var
  GIdPorts: TList;
{$ENDIF}

function IsASCIILDH(const AByte: Byte): Boolean;

begin
  Result := True;
    //Verify the absence of non-LDH ASCII code points; that is, the
   //absence of 0..2C, 2E..2F, 3A..40, 5B..60, and 7B..7F.
   //Permissable chars are in this set
   //['-','0'..'9','A'..'Z','a'..'z']
    if AByte <= $2C then
    begin
      Result := False;
    end;
    if (AByte >= $2E) and (AByte <= $2F) then
    begin
      Result := False;
    end;
    if (AByte >= $3A) and (AByte <= $40) then
    begin
      Result := False;
    end;
    if (AByte >= $5B) and (AByte <= $60) then
    begin
      Result := False;
    end;
    if (AByte >= $7B) and (AByte <= $7F) then
    begin
      Result := False;
    end;
end;

function IsASCIILDH(const ABytes: TIdBytes): Boolean;
var i: Integer;
begin
  Result := True;
  for i := 0 to Length(ABytes) -1 do
  begin
    if IsASCIILDH(ABytes[i]) then
    begin
      Result := False;
      Exit;
    end;
  end;
end;

function IsASCII(const AByte: Byte): Boolean;
begin
  Result := AByte <= $7F;
end;

function IsASCII(const ABytes: TIdBytes): Boolean;
var i: Integer;
begin
  Result := True;
  for i := 0 to Length(ABytes) -1 do
  begin
    if IsASCII(ABytes[i])=False then
    begin
      Result := False;
      Break;
    end;
  end;
end;

function StartsWithACE(const ABytes: TIdBytes): Boolean;
var LS: string;
const DASH = ord('-');
begin
  Result := False;
  if Length(ABytes)>4 then
  begin
    if (ABytes[2]=DASH) and (ABytes[3]=DASH) then
    begin
      SetLength(LS,2);
      LS[1] := Char(ABytes[2]);
      LS[2] := Char(ABytes[3]);
      if PosInStrArray(LS,['bl','bq','dq','lq','mq','ra','wq','zq'],False)>-1 then {do not localize}
      begin
        Result := True;
      end;
    end;
  end;
end;

function PosInSmallIntArray(const ASearchInt: SmallInt; AArray: array of SmallInt): Integer;
begin
  for Result := Low(AArray) to High(AArray) do begin
    if ASearchInt = AArray[Result] then begin
        Exit;
    end;
  end;
  Result := -1;
end;

{This searches an array of string for an occurance of SearchStr}
function PosInStrArray(const SearchStr: string; Contents: array of string; const CaseSensitive: Boolean): Integer;
begin
  for Result := Low(Contents) to High(Contents) do begin
    if CaseSensitive then begin
      if SearchStr = Contents[Result] then begin
        Exit;
      end;
    end else begin
      if TextIsSame(SearchStr, Contents[Result]) then begin
        Exit;
      end;
    end;
  end;  //for Result := Low(Contents) to High(Contents) do
  Result := -1;
end;

//IPv4 address conversion
function ByteToHex(const AByte: Byte): string;
begin
  Result := IdHexDigits[AByte shr 4] + IdHexDigits[AByte and $F];
end;

function ToHex(const AValue: TIdBytes): AnsiString;
var
  i: Integer;
begin
  SetLength(Result,Length(AValue)*2);
  for i:=0 to Length(AValue)-1 do begin
    Result[i*2+1]:=IdHexDigits[AValue[i] shr 4];
    Result[i*2+2]:=IdHexDigits[AValue[i] and $F];
  end;//for
end;

{$IFNDEF DotNet}
function ToHex(const AValue: array of LongWord): AnsiString;
var
  P: PChar;
  i: Integer;
begin
  P:=PChar(@AValue);
  SetString(Result,NIL,Length(AValue)*4*2);//40
  for i:=0 to Length(AValue)*4-1 do begin
    Result[i*2+1]:=IdHexDigits[Ord(P[i]) shr 4];
    Result[i*2+2]:=IdHexDigits[Ord(P[i]) and $F];
  end;//for
end;
{$ELSE}
function ToHex(const AValue: array of LongWord): AnsiString;
var
  i: Integer;
begin
  for i:=0 to Length(AValue)-1 do begin
    Result:=Result+ToHex(ToBytes(AValue[i]));
  end;//for
end;
{$ENDIF}

function IPv4ToHex(const AIPAddress: string; const ASDotted: Boolean): string;
var
  i: Integer;
  LBuf, LTmp: string;
begin
  LBuf := Trim(AIPAddress);
  Result := HEXPREFIX;

  for i := 0 to 3 do begin
    LTmp := ByteToHex(StrToIntDef(Fetch(LBuf, '.', True), 0));

    if ASDotted then begin
      Result := Result + '.' + HEXPREFIX + LTmp;
    end else begin
      Result := Result + LTmp;
    end;
  end;
end;

function OctalToInt64(const AValue: string): Int64;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(AValue) do
  begin
    Result := (Result shl 3) + StrToIntDef(copy(AValue, i, 1), 0);
  end;
end;

function ByteToOctal(const AByte: Byte): string;
begin
  Result := IdOctalDigits[(AByte shr 6) and $7] +
            IdOctalDigits[(AByte shr 3) and $7] +
            IdOctalDigits[AByte and $7];

  if Result[1] <> '0' then
  begin
    Result := '0' + Result;
  end;
end;

function IPv4ToOctal(const AIPAddress: string): string;
var
  i: Integer;
  LBuf: string;
begin
  LBuf := Trim(AIPAddress);
  Result := ByteToOctal(StrToIntDef(Fetch(LBuf, '.', True), 0));
  for i := 0 to 2 do
  begin
    Result := Result + '.' + ByteToOctal(StrToIntDef(Fetch(LBuf, '.', True), 0));
  end;
end;

procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
    var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
begin
  {$IFDEF DotNet}
  System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
  {$ELSE}
  Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
  {$ENDIF}
end;

procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
    var VDest: array of Byte; const ADestIndex: Integer; const ALength: Integer);
begin
  {$IFDEF DotNet}
  System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
  {$ELSE}
  Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
  {$ENDIF}
end;

procedure DebugOutput(const AText: string);
begin
  {$IFDEF LINUX}
  __write(stderr, AText, Length(AText));
  __write(stderr, EOL, Length(EOL));
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  OutputDebugString(PChar(AText));
  {$ENDIF}
  {$IFDEF DotNet}
   System.Diagnostics.Debug.WriteLine(AText);
  {$ENDIF}
end;

{$IFNDEF DotNet}
function GetCurrentThreadHandle: THandle;
begin
  Result := GetCurrentThreadID;
end;
{$ELSE}
function GetCurrentThreadHandle: THandle;
begin
  // SG: I'm not sure if this return the handle of the dotnet thread or the handle of the application domain itself (or even if there is a difference)
  Result := AppDomain.GetCurrentThreadId;
end;
{$ENDIF}

function CurrentProcessId: TIdPID;
begin
  {$IFDEF LINUX}
  Result := getpid;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  Result := GetCurrentProcessID;
  {$ENDIF}
  {$IFDEF DotNet}
  Result := System.Diagnostics.Process.GetCurrentProcess.ID;
  {$ENDIF}
end;

function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
 const ADelete: Boolean = IdFetchDeleteDefault;
 const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
var
  LPos: Integer;
begin
  if ACaseSensitive then begin
    if ADelim = #0 then begin
      // AnsiPos does not work with #0
      LPos := Pos(ADelim, AInput);
    end else begin
      LPos := IndyPos(ADelim, AInput);
    end;
    if LPos = 0 then begin
      Result := AInput;
      if ADelete then begin
        AInput := '';    {Do not Localize}
      end;
    end
    else begin
      Result := Copy(AInput, 1, LPos - 1);
      if ADelete then begin
        //slower Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
        //remaining part is larger than the deleted
        AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
      end;
    end;
  end else begin
    Result := FetchCaseInsensitive(AInput, ADelim, ADelete);
  end;
end;

function FetchCaseInsensitive(var AInput: string; const ADelim: string;
  const ADelete: Boolean): string;
var
  LPos: Integer;
begin
  if ADelim = #0 then begin
    // AnsiPos does not work with #0
    LPos := Pos(ADelim, AInput);
  end else begin
    //? may be AnsiUpperCase?
    LPos := IndyPos(UpperCase(ADelim), UpperCase(AInput));
  end;
  if LPos = 0 then begin
    Result := AInput;
    if ADelete then begin
      AInput := '';    {Do not Localize}
    end;
  end else begin
    Result := Copy(AInput, 1, LPos - 1);
    if ADelete then begin
      //faster than Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
      //remaining part is larger than the deleted
      AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
    end;
  end;
end;

function GetThreadHandle(AThread: TThread): THandle;
begin
  {$IFDEF LINUX}
  Result := AThread.ThreadID;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  Result := AThread.Handle;
  {$ENDIF}
  {$IFDEF DotNet}
  Result := 0;
  {$ENDIF}
end;

{$IFDEF LINUX}
function Ticks: Cardinal;
var
  tv: timeval;
begin
  gettimeofday(tv, nil);
  {$RANGECHECKS OFF}
  Result := int64(tv.tv_sec) * 1000 + tv.tv_usec div 1000;
  {
    I've implemented this correctly for now. I'll argue for using
    an int64 internally, since apparently quite some functionality
    (throttle, etc etc) depends on it, and this value may wrap
    at any point in time.
    For Windows: Uptime > 72 hours isn't really that rare any more,
    For Linux: no control over when this wraps.

    IdEcho has code to circumvent the wrap, but its not very good
    to have code for that at all spots where it might be relevant.

  }
end;
{$ENDIF}

{$IFDEF MSWindows}
// S.G. 27/11/2002: Changed to use high-performance counters as per suggested
// S.G. 27/11/2002: by David B. Ferguson ([e-mail])
function Ticks: Cardinal;
var
  nTime, freq: Int64;
begin
  if Windows.QueryPerformanceFrequency(freq) then begin
    if Windows.QueryPerformanceCounter(nTime) then begin
      Result := Trunc((nTime / Freq) * 1000)
    end else begin
      Result := Windows.GetTickCount;
    end;
  end else begin
    Result:= Windows.GetTickCount;
  end;
end;
{$ENDIF}

{$IFDEF DotNet}
function Ticks: Cardinal;
begin