idglobal.pas

photo.163.com 相册下载器 多线程下载

  // Must cast to a cardinal
  //
  // http://lists.ximian.com/archives/public/mono-bugs/2003-November/009293.html
  // Other references in Google.
  // Bug in .NET. It acts like Win32, not as per .NET docs but goes negative after 25 days.
  //
  // There may be a problem in the future if .NET changes this to work as docced with 25 days.
  // Will need to check our routines then and somehow counteract / detect this.
  // One possibility is that we could just wrap it ourselves in this routine.
  Result:= Cardinal(Environment.TickCount);
end;
{$ENDIF}

function GetTickDiff(const AOldTickCount, ANewTickCount: Cardinal): Cardinal;
begin
  {This is just in case the TickCount rolled back to zero}
    if ANewTickCount >= AOldTickCount then begin
      Result := ANewTickCount - AOldTickCount;
    end else begin
      Result := High(Cardinal) - AOldTickCount + ANewTickCount;
    end;
end;

function ServicesFilePath: string;
var sLocation: string;
begin
    {$IFDEF LINUX}
    sLocation := '/etc/';  // assume Berkeley standard placement   {do not localize}
    {$ENDIF}
    {$IFDEF MSWINDOWS}
    SetLength(sLocation, MAX_PATH);
    SetLength(sLocation, GetWindowsDirectory(pchar(sLocation), MAX_PATH));
    sLocation := IncludeTrailingSlash(sLocation);
    if Win32Platform = VER_PLATFORM_WIN32_NT then begin
      sLocation := sLocation + 'system32\drivers\etc\'; {do not localize}
    end;
    {$ENDIF}
  Result := sLocation + 'services'; {do not localize}
end;

{$IFNDEF DotNet}
// IdPorts returns a list of defined ports in /etc/services
function IdPorts: TList;
var
  s: string;
  idx, i, iPrev, iPosSlash: Integer;
  sl: TIdStringList;
begin
  if GIdPorts = nil then
  begin
    GIdPorts := TList.Create;
    sl := TIdStringList.Create;
    try
      sl.LoadFromFile(ServicesFilePath);  {do not localize}
      iPrev := 0;
      for idx := 0 to sl.Count - 1 do
      begin
        s := sl[idx];
        iPosSlash := IndyPos('/', s);   {do not localize}
        if (iPosSlash > 0) and (not (IndyPos('#', s) in [1..iPosSlash])) then {do not localize}
        begin // presumably found a port number that isn't commented    {Do not Localize}
          i := iPosSlash;
          repeat
            Dec(i);
            if i = 0 then begin
              raise EIdCorruptServicesFile.CreateFmt(RSCorruptServicesFile, [ServicesFilePath]); {do not localize}
            end;
          //TODO: Make Whitespace a function to elim warning
          until Ord(s[i]) in WhiteSpace;
          i := StrToInt(Copy(s, i+1, iPosSlash-i-1));
          if i <> iPrev then begin
            GIdPorts.Add(TObject(i));
          end;
          iPrev := i;
        end;
      end;
    finally
      sl.Free;
    end;
  end;
  Result := GIdPorts;
end;
{$ENDIF}

function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer;
begin
  if ATest then begin
    Result := ATrue;
  end else begin
    Result := AFalse;
  end;
end;

function iif(ATest: Boolean; const ATrue: string; const AFalse: string): string;
begin
  if ATest then begin
    Result := ATrue;
  end else begin
    Result := AFalse;
  end;
end;

function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean;
begin
  if ATest then begin
    Result := ATrue;
  end else begin
    Result := AFalse;
  end;
end;

function IncludeTrailingSlash(const APath: string): string;
begin
  {for some odd reason, the IFDEF's were not working in Delphi 4
  so as a workaround and to ensure some code is actually compiled into
  the procedure, I use a series of $elses}
  {$IFDEF VCL5O}
  Result := IncludeTrailingBackSlash(APath);
  {$ELSE}
    {$IFDEF VCL6ORABOVE}
    Result :=  IncludeTrailingPathDelimiter(APath);
    {$ELSE}
    Result := APath;
    if not IsPathDelimiter(Result, Length(Result)) then begin
      Result := Result + GPathDelim;
    end;
    {$ENDIF}
  {$ENDIF}
end;

function InMainThread: boolean;
begin
  {$IFDEF DotNet}
  Result := System.Threading.Thread.CurrentThread <> MainThread;
  {$ELSE}
  Result := GetCurrentThreadID = MainThreadID;
  {$ENDIF}
end;

procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: int64);
begin
  {$IFDEF DotNet}
  Dest.Write(Src.Memory, Count);
  {$ELSE}
  Dest.Write(Src.Memory^, Count);
  {$ENDIF}
end;

{$IFNDEF DotNetExclude}
function IsCurrentThread(AThread: TThread): boolean;
begin
  Result := AThread.ThreadID = GetCurrentThreadID;
end;
{$ENDIF}

//convert a dword into an IPv4 address in dotted form
function MakeDWordIntoIPv4Address(const ADWord: Cardinal): string;
begin
  Result := IntToStr((ADWord shr 24) and $FF) + '.';
  Result := Result + IntToStr((ADWord shr 16) and $FF) + '.';
  Result := Result + IntToStr((ADWord shr 8) and $FF) + '.';
  Result := Result + IntToStr(ADWord and $FF);
end;

function IsOctal(AChar: Char): Boolean; overload;
begin
  Result := (AChar >= '0') and (AChar <= '7') {Do not Localize}
end;

function IsOctal(const AString: string): Boolean; overload;
var
  i: Integer;
begin
  Result := True;
  for i := 1 to Length(AString) do
  begin
    if IsOctal(AString[i])=False then
    begin
      Result := False;
    end;
  end;
end;

function IsHexidecimal(AChar: Char): Boolean; overload;
begin
  Result := ((AChar >= '0') and (AChar <= '9')) {Do not Localize}
   or ((AChar >= 'A') and (AChar <= 'F')) {Do not Localize}
   or ((AChar >= 'a') and (AChar <= 'f')); {Do not Localize}
end;

function IsHexidecimal(const AString: string): Boolean; overload;
var
  i: Integer;
begin
  Result := True;
  for i := 1 to Length(AString) do
  begin
    if IsHexidecimal(AString[i])=False then
    begin
      Result := False;
    end;
  end;
end;

{$HINTS OFF}
function IsNumeric(const AString: string): Boolean;
var
  LCode: Integer;
  LVoid: Int64;
begin
  Val(AString, LVoid, LCode);
  Result := LCode = 0;
end;
{$HINTS ON}

function IsNumeric(AChar: Char): Boolean;
begin
  // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
  Result := (AChar >= '0') and (AChar <= '9'); {Do not Localize}
end;

{
This is an adaptation of the StrToInt64 routine in SysUtils.
We had to adapt it to work with Int64 because the one with Integers
can not deal with anything greater than MaxInt and IP addresses are
always $0-$FFFFFFFF (unsigned)
}
function StrToInt64Def(const S: string; Default: Integer): Int64;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then
  begin
    Result := Default;
  end;
end;

{$IFNDEF DotNet}
function IPv4MakeCardInRange(const AInt: Int64; const A256Power: Integer): Cardinal;
//Note that this function is only for stripping off some extra bits
//from an address that might appear in some spam E-Mails.
begin
  case A256Power of
    4: Result := (AInt and POWER_4);
    3: Result := (AInt and POWER_3);
    2: Result := (AInt and POWER_2);
  else
    Result := Lo(AInt and POWER_1);
  end;
end;
{$ENDIF}

function IPv4ToDWord(const AIPAddress: string): Cardinal; overload;
var
  LErr: Boolean;
begin
  Result := IPv4ToDWord(AIPAddress,LErr);
end;

{$IFDEF DotNet}
function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): Cardinal; overload;
var
  AIPaddr: IPAddress;
begin
  VErr := True;
  Result := 0;
  AIPaddr := System.Net.IPAddress.Parse(AIPAddress);
  try
    try
      if AIPaddr.AddressFamily = Addressfamily.InterNetwork then
      begin
        Result := AIPaddr.Address;
        VErr := False;
      end;
    except
      VErr := True;
    end;
  finally
    AIPaddr.free;
  end;
end;
{$ELSE}
function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): Cardinal; overload;
var
  LBuf, LBuf2: string;
  L256Power: Integer;
  LParts: Integer; //how many parts should we process at a time
begin
  // S.G. 11/8/2003: Added overflow checking disabling and change multiplys by SHLs.
  // Locally disable overflow checking so we can safely use SHL and SHR
  {$ifopt Q+} // detect previous setting
  {$define _QPlusWasEnabled}
  {$Q-}
  {$endif}
  VErr := True;
  L256Power := 4;
  LBuf2 := AIPAddress;
  Result := 0;
  repeat
    LBuf := Fetch(LBuf2,'.');
    if LBuf = '' then
    begin
      Break;
    end;
    //We do things this way because we have to treat
    //IP address parts differently than a whole number
    //and sometimes, there can be missing periods.
    if (LBuf2='') and (L256Power > 1) then
    begin
      LParts := L256Power;
      Result := Result shl (L256Power SHL 3);
//      Result := Result shl ((L256Power - 1) SHL 8);
    end
    else
    begin
      LParts := 1;
      result := result SHL 8;
    end;
    if (Copy(LBuf,1,2)=HEXPREFIX) then
    begin
      //this is a hexideciaml number
      if IsHexidecimal(Copy(LBuf,3,MaxInt))=False then
      begin
        Exit;
      end
      else
      begin
        Result :=  Result + IPv4MakeCardInRange (StrToInt64Def(LBuf,0), LParts);
      end;
    end
    else
    begin
      if IsNumeric(LBuf) then
      begin
        if (LBuf[1]='0') and IsOctal(LBuf) then
        begin
          //this is octal
          Result := Result + IPv4MakeCardInRange(OctalToInt64(LBuf),LParts);
        end
        else
        begin
          //this must be a decimal
          Result :=  Result + IPv4MakeCardInRange(StrToInt64Def(LBuf,0), LParts);
        end;
      end
      else
      begin
        //There was an error meaning an invalid IP address
        Exit;
      end;
    end;
    Dec(L256Power);
  until False;
  VErr := False;
  // Restore overflow checking
  {$ifdef _QPlusWasEnabled} // detect previous setting
  {$undef _QPlusWasEnabled}
  {$Q-}
  {$endif}
end;
{$ENDIF}

function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
var i:Integer;
begin
  Result := '';
  for i := 0 to 7 do begin
    Result := Result + ':' + IntToHex(AValue[i], 4);
  end;
end;

function MakeCanonicalIPv4Address(const AAddr: string): string;
var LErr: Boolean;
  LIP: Cardinal;
begin
  LIP := IPv4ToDWord(AAddr,LErr);
  if LErr then begin
    Result := '';
  end else begin
    Result := MakeDWordIntoIPv4Address(LIP);
  end;
end;

function MakeCanonicalIPv6Address(const AAddr: string): string;
// return an empty string if the address is invalid,
// for easy checking if its an address or not.
var
  p, i: Integer;
  dots, colons: Integer;
  colonpos: array[1..8] of Integer;
  dotpos: array[1..3] of Integer;
  LAddr: string;
  num: Integer;
  haddoublecolon: boolean;
  fillzeros: Integer;
begin
  Result := ''; // error
  LAddr := AAddr;
  if Length(LAddr) = 0 then Exit;

  if LAddr[1] = ':' then begin
    LAddr := '0'+LAddr;
  end;
  if LAddr[Length(LAddr)] = ':' then begin
    LAddr := LAddr + '0';
  end;
  dots := 0;
  colons := 0;
  for p := 1 to Length(LAddr) do begin
    case LAddr[p] of
      '.': begin
              Inc(dots);
              if dots < 4 then begin
                dotpos[dots] := p;
              end else begin
                Exit; // error in address
              end;
            end;
      ':': begin
              Inc(colons);
              if colons < 8 then begin
                colonpos[colons] := p;
              end else begin
                Exit; // error in address
              end;
            end;
      'a'..'f',
      'A'..'F': if dots>0 then Exit;
        // allow only decimal stuff within dotted portion, ignore otherwise
      '0'..'9': ; // do nothing
    else
      Exit; // error in address
    end; // case
  end; // for
  if not (dots in [0,3]) then begin
    Exit; // you have to write 0 or 3 dots...
  end;
  if dots = 3 then begin
    if not (colons in [2..6]) then begin
      Exit; // must not have 7 colons if we have dots
    end;
    if colonpos[colons] > dotpos[1] then begin
      Exit; // x:x:x.x:x:x is not valid
    end;
  end else begin
    if not (colons in [2..7]) then begin
      Exit; // must at least have two colons
    end;
  end;

  // now start :-)
  num := StrToIntDef('$'+Copy(LAddr, 1, colonpos[1]-1), -1);
  if (num<0) or (num>65535) then begin
    Exit; // huh? odd number...
  end;
  Result := IntToHex(num,1)+':';

  haddoublecolon := false;
  for p := 2 to colons do begin
    if colonpos[p - 1] = colonpos[p]-1 then begin
      if haddoublecolon then begin
        Result := '';
        Exit; // only a single double-dot allowed!