idglobalprotocols.pas

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

  //MLIST FTP DateTime conversion functions
  function FTPMLSToGMTDateTime(const ATimeStamp : String):TDateTime;
  function FTPMLSToLocalDateTime(const ATimeStamp : String):TDateTime;

  function FTPGMTDateTimeToMLS(const ATimeStamp : TDateTime): String;
  function FTPLocalDateTimeToMLS(const ATimeStamp : TDateTime): String;

  function GetClockValue : Int64;
  function GetMIMETypeFromFile(const AFile: TFileName): string;
  function GetMIMEDefaultFileExt(const MIMEType: string): string;
  function GetGMTDateByName(const AFileName : String) : TDateTime;
  function GmtOffsetStrToDateTime(S: string): TDateTime;
  function GMTToLocalDateTime(S: string): TDateTime;
  function IdGetDefaultCharSet : TIdCharSet;
  function IntToBin(Value: cardinal): string;
  function IndyComputerName : String; // DotNet: see comments regarding GDotNetComputerName below
  //used by IdIMAP4Server
  function IndyCopyFile(AFromFileName, AToFileName : String; const AFailIfExists : Boolean) : Boolean;

  function IndyStrToBool(const AString: String): Boolean;
  function IsDomain(const S: String): Boolean;
  function IsFQDN(const S: String): Boolean;
  function IsBinary(const AChar : Char) : Boolean;
  function IsHex(const AChar : Char) : Boolean;
  function IsHostname(const S: String): Boolean;
  function IsLeadChar(ACh : Char):Boolean;
  function IsTopDomain(const AStr: string): Boolean;
  function IsValidIP(const S: String): Boolean;


  function Max(AValueOne,AValueTwo: Integer): Integer;
  function MakeTempFilename(const APath: String = ''): string;
  procedure MoveChars(const ASource:ShortString;ASourceStart:integer;var ADest:ShortString;ADestStart, ALen:integer);
  function OffsetFromUTC: TDateTime;
   function OrdFourByteToCardinal(AByte1, AByte2, AByte3, AByte4 : Byte): Cardinal;


  function ProcessPath(const ABasePath: String; const APath: String;
    const APathDelim: string = '/'): string;    {Do not Localize}
  function RightStr(const AStr: String; Len: Integer): String;
  {$IFNDEF DOTNET}
  // still to figure out how to reproduce these under .Net
  function ROL(AVal: LongWord; AShift: Byte): LongWord;
  function ROR(AVal: LongWord; AShift: Byte): LongWord;
  {$ENDIF}
  function RPos(const ASub, AIn: String; AStart: Integer = -1): Integer;
  function SetLocalTime(Value: TDateTime): boolean;

  function StrToCard(const AStr: String): Cardinal;
  function StrInternetToDateTime(Value: string): TDateTime;
  function StrToDay(const ADay: string): Byte;
  function StrToMonth(const AMonth: string): Byte;
  function StrToWord(const Value: String): Word;
  function TimeZoneBias: TDateTime;

  function TwoCharToWord(AChar1, AChar2: Char):Word;
  function UpCaseFirst(const AStr: string): string;
  function GetUniqueFileName(const APath, APrefix, AExt : String) : String;
  {$IFDEF MSWINDOWS}
  function Win32Type : TIdWin32Type;
  {$ENDIF}
  procedure WordToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer);
  function WordToStr(const Value: Word): String;

  //The following is for working on email headers and message part headers...
  function RemoveHeaderEntry(AHeader, AEntry: string): string;

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

  {$IFDEF DOTNET}
  // This is available through System.Windows.Forms.SystemInformation.ComputerName
  // however we do not wish to link to Wystem.Windows.Forms. So the name of
  // the computer must be provided here in DotNet. The only known use for this
  // value is in the NTML and SSPI authentication code
  GDotNetComputerName : String;
  {$ENDIF}

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

implementation

uses
  {$IFDEF LINUX}
  Libc,
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  Registry,
  {$ENDIF}
  {$IFDEF DOTNET}
  System.IO,
  {$ENDIF}
  {$IFDEF DELPHI5}
  FileCtrl,
  {$ENDIF}
  IdAssignedNumbers,
  IdResourceStringsCore,
  IdResourceStringsProtocols,
  IdStack;

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

{IndyCopyFile and  CreateEmptyFile are used by TIdIMAP4Server}

function IndyCopyFile(AFromFileName, AToFileName : String; const AFailIfExists : Boolean) : Boolean;
var
  LStream : TStream;
begin
  if FileExists(AToFileName) and AFailIfExists then begin
    Result := False;
  end else begin
    LStream := TFileStream.Create(AFromFileName, fmOpenRead or fmShareDenyWrite); try
      with TFileStream.Create(AToFileName, fmCreate) do try
        CopyFrom(LStream, 0);
      finally Free; end;
    finally FreeAndNil(LStream); end;
    Result := True;
  end;
end;

function CreateEmptyFile(const APathName : String) : Boolean;
{$IFDEF DOTNET}
var LSTr : FileStream;
{$ELSE}
var LHandle : Integer;
{$ENDIF}
begin
  Result := False;
  {$IFDEF DOTNET}
  LStr := FileCreate(APathName);
  if Assigned(LStr) then
  begin
    FreeAndNil(LStr);
    Result := True;
  end;
  {$ELSE}
  LHandle := FileCreate(APathName);
  if LHandle <> -1 then
  begin
    FileClose(LHandle);
    Result := True;
  end;
  {$ENDIF}
end;

// BGO: TODO: Move somewhere else
procedure MoveChars(const ASource:ShortString;ASourceStart:integer;var ADest:ShortString;ADestStart, ALen:integer);
{$ifdef DotNet}
var a:integer;
{$endif}
begin
  {$ifdef DotNet}
  for a:=1 to ALen do begin
    ADest[ADestStart]:= ASource[ASourceStart];
    inc(ADestStart);
    inc(ASourceStart);
  end;
  {$else}
    System.Move(ASource[ASourceStart], ADest[ADestStart], ALen);
  {$endif}
end;

Function CharToHex(const APrefix : String; const c : AnsiChar) : shortstring;
begin
  SetLength(Result,2);
  Result[1] := IdHexDigits[byte(c) shr 4];
  Result[2] := IdHexDigits[byte(c) AND $0F];
  Result := APrefix + Result;
end;

function CardinalToFourChar(ACardinal : Cardinal): string;
begin
  Result := BytesToString(ToBytes(ACardinal));
end;

procedure WordToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer);
begin
  //ByteArray[Index] := AWord div 256;
  //ByteArray[Index + 1] := AWord mod 256;
  ByteArray[Index + 1] := AWord div 256;
  ByteArray[Index] := AWord mod 256;
end;

function StrToWord(const Value: String): Word;
begin
  {$IFDEF DOTNET}
  if Length(Value)>1 then
  begin
    Result := TwoCharToWord(Value[1],Value[2]);
  end
  else
  begin
    Result := 0;
  end;
  {$ELSE}
  Result := Word(pointer(@Value[1])^);
  {$ENDIF}
end;

function WordToStr(const Value: Word): String;
begin
  {$IFDEF DOTNET}
  Result := BytesToString(ToBytes(Value));
  {$ELSE}
  SetLength(Result, SizeOf(Value));
  Move(Value, Result[1], SizeOf(Value));
  {$ENDIF}
end;

function OrdFourByteToCardinal(AByte1, AByte2, AByte3, AByte4 : Byte): Cardinal;
var
  LCardinal: TIdBytes;
begin
  SetLength(LCardinal,4);
  LCardinal[0] := AByte1;
  LCardinal[1] := AByte2;
  LCardinal[2] := AByte3;
  LCardinal[3] := AByte4;
  Result := BytesToCardinal( LCardinal);
end;

function TwoCharToWord(AChar1,AChar2: Char):Word;
//Since Replys are returned as Strings, we need a rountime to convert two
// characters which are a 2 byte U Int into a two byte unsigned integer
var
  LWord: TIdBytes;
begin
  SetLength(LWord,2);
  LWord[0] := Ord(AChar1);
  LWord[1] := Ord(AChar2);
  Result := BytesToWord(LWord);

//  Result := Word((Ord(AChar1) shl 8) and $FF00) or Word(Ord(AChar2) and $00FF);
end;


{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}
type
  TNTEditionType = (workstation, server, advancedserver);

{These two are intended as internel functions called by our Win32 function.
These assume you checked for Windows NT, 2000, XP, or 2003}

{Returns the NTEditionType on Windows NT, 2000, XP, or 2003, and return workstation on non-nt platforms (95,98,me) }
function GetNTType : TNTEditionType;
var
  RtlGetNtProductType:function(ProductType:PULONG):BOOL;stdcall;
  Lh:THandle;
  LVersion:ULONG;
begin
  result:=workstation;
  lh:=LoadLibrary('ntdll.dll'); {do not localize}
  if Lh>0 then begin
    @RtlGetNtProductType:=GetProcAddress(lh,'RtlGetNtProductType'); {do not localize}
    if @RtlGetNtProductType<>nil then begin
      RtlGetNtProductType(@LVersion);
      case LVersion of
        1: result := workstation;
        2: result := server;
        3: result := advancedserver;
      end;
    end;
    FreeLibrary(lh);
  end;
end;

function GetOSServicePack : Integer;
var LNumber : String;
  LBuf : String;
  i : Integer;
  OS : TOSVersionInfo;
begin
  OS.dwOSVersionInfoSize := SizeOf(OS);
  GetVersionEx(OS);
  LBuf := OS.szCSDVersion;
  //Strip off "Service Pack" words
  Fetch(LBuf,' ');
  Fetch(LBuf,' ');
  //get the version number without any letters
  LNumber := '';
  for i := 1 to Length(LBuf) do
  begin
    if IsNumeric(LBuf[i]) then
    begin
      LNumber := LNumber+LBuf[i];
    end
    else
    begin
      Break;
    end;
  end;
  Result := StrToIntDef(LNumber,0);
end;
{============}
function Win32Type: TIdWin32Type;
begin
  {VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);  GetVersionEx(VerInfo);}
  {is this Windows 2000, 2003, or XP?}
  if Win32MajorVersion >= 5 then begin
    if Win32MinorVersion >= 2 then begin
      case GetNTType of
        server : Result := Windows2003Server;
        advancedserver : Result := Windows2003Server;
      else
        Result := WindowsXPPro; // Windows 2003 has no desktop version
      end;
    end
    else
    begin
      if Win32MinorVersion >= 1 then begin
        case GetNTType of
          server : Result := Windows2000Server; // hmmm, winXp has no server versions
          advancedserver : Result := Windows2000AdvancedServer; // hmmm, winXp has no server versions
        else
          Result := WindowsXPPro;
        end;
      end
      else begin
        case GetNTType of
          server : Result := Windows2000Server;
          advancedserver : Result := Windows2000AdvancedServer;
        else
          Result := Windows2000Pro;
        end;
      end;
    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
        //Bas requested that we specifically check for anything below SP6
        if (GetOSServicePack<6) then
        begin
          case GetNTType of
            server : Result := WindowsNT40PreSP6Server;
            advancedserver : Result := WindowsNT40PreSP6AdvancedServer;
          else
            Result := WindowsNT40PreSP6Workstation;
          end;
        end
        else
        begin
          case GetNTType of
        //WindowsNT40Workstation, WindowsNT40Server, WindowsNT40AdvancedServer
            server : Result := WindowsNT40Server;
            advancedserver : Result := WindowsNT40AdvancedServer;
          else
            Result := WindowsNT40Workstation;
          end;
        end;
      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;
      end;//if VER_PLATFORM_WIN32_NT
    end
    else begin
      Result := Win32s;
    end;
  end;//if Win32MajorVersion >= 5
end;
{$ENDIF}

function CompareDateTime(const ADateTime1, ADateTime2 : TDateTime) : Integer;
var
  LYear1, LYear2 : Word;
  LMonth1, LMonth2 : Word;
  LDay1, LDay2 : Word;
  LHour1, LHour2 : Word;
  LMin1, LMin2 : Word;
  LSec1, LSec2 : Word;
  LMSec1, LMSec2 : Word;
{
The return value is less than 0 if ADateTime1 is less than ADateTime2,
0 if ADateTime1 equals ADateTime2, or
greater than 0 if ADateTime1 is greater than ADateTime2.
}
begin
  DecodeDate(ADateTime1,LYear1,LMonth1,LDay1);
  DecodeDate(ADateTime2,LYear2,LMonth2,LDay2);
  // year
  Result := LYear1 - LYear2;
  if Result <> 0 then
  begin
    Exit;
  end;
  // month
  Result := LMonth1 - LMonth2;
  if Result <> 0 then
  begin
    Exit;
  end;