idglobal.pas

Indy控件的使用源代码

      end;//if VER_PLATFORM_WIN32_NT
    end
    else begin
      Result := Win32s;
    end;
  end;//if Win32MajorVersion >= 5
end;
{$ENDIF}

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

{This is an internal procedure so the StrInternetToDateTime and GMTToLocalDateTime can share common code}
function RawStrInternetToDateTime(var Value: string): TDateTime;
var
  i: Integer;
  Dt, Mo, Yr, Ho, Min, Sec: Word;
  sTime: String;
  ADelim: string;

  Procedure ParseDayOfMonth;
  begin
    Dt :=  StrToIntDef( Fetch(Value, ADelim), 1);
    Value := TrimLeft(Value);
  end;

  Procedure ParseMonth;
  begin
    Mo := StrToMonth( Fetch ( Value, ADelim )  );
    Value := TrimLeft(Value);
  end;
begin
  Result := 0.0;
  Value := Trim(Value);
  if Length(Value) = 0 then begin
    Exit;
  end;

  try
    {Day of Week}
    if StrToDay(Copy(Value, 1, 3)) > 0 then begin
      //workaround in case a space is missing after the initial column
      if (Copy(Value,4,1)=',') and (Copy(Value,5,1)<>' ') then
      begin
        System.Insert(' ',Value,5);
      end;
      Fetch(Value);
      Value := TrimLeft(Value);
    end;

    // Workaround for some buggy web servers which use '-' to separate the date parts.    {Do not Localize}
    if (IndyPos('-', Value) > 1) and (IndyPos('-', Value) < IndyPos(' ', Value)) then begin    {Do not Localize}
      ADelim := '-';    {Do not Localize}
    end
    else begin
      ADelim := ' ';    {Do not Localize}
    end;
    //workaround for improper dates such as 'Fri, Sep 7 2001'    {Do not Localize}
    //RFC 2822 states that they should be like 'Fri, 7 Sep 2001'    {Do not Localize}
    if (StrToMonth(Fetch(Value, ADelim,False)) > 0) then
    begin
      {Month}
      ParseMonth;
      {Day of Month}
      ParseDayOfMonth;
    end
    else
    begin
      {Day of Month}
      ParseDayOfMonth;
      {Month}
      ParseMonth;
    end;
    {Year}
    // There is sometrage date/time formats like
    // DayOfWeek Month DayOfMonth Time Year

    sTime := Fetch(Value);
    Yr := StrToIntDef(sTime, 1900);
    // Is sTime valid Integer
    if Yr = 1900 then begin
      Yr := StrToIntDef(Value, 1900);
      Value := sTime;
    end;
    if Yr < 80 then begin
      Inc(Yr, 2000);
    end else if Yr < 100 then begin
      Inc(Yr, 1900);
    end;

    Result := EncodeDate(Yr, Mo, Dt);
    // SG 26/9/00: Changed so that ANY time format is accepted
    i := IndyPos(':', Value); {do not localize}
    if i > 0 then begin
      // Copy time string up until next space (before GMT offset)
      sTime := fetch(Value, ' ');  {do not localize}
      {Hour}
      Ho  := StrToIntDef( Fetch ( sTime,':'), 0);  {do not localize}
      {Minute}
      Min := StrToIntDef( Fetch ( sTime,':'), 0);  {do not localize}
      {Second}
      Sec := StrToIntDef( Fetch ( sTime ), 0);
      {The date and time stamp returned}
      Result := Result + EncodeTime(Ho, Min, Sec, 0);
    end;
    Value := TrimLeft(Value);
  except
    Result := 0.0;
  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;

{$IFNDEF VCL5ORABOVE}
function AnsiSameText(const S1, S2: string): Boolean;
begin
  Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1)
   , Length(S1), PChar(S2), Length(S2)) = 2;
end;

procedure FreeAndNil(var Obj);
var
  P: TObject;
begin
  if TObject(Obj) <> nil then begin
    P := TObject(Obj);
    TObject(Obj) := nil;  // clear the reference before destroying the object
    P.Free;
  end;
end;
{$ENDIF}

{$IFDEF MSWINDOWS}
  {$IFNDEF VCL5ORABOVE}
  function CreateTRegistry: TRegistry;
  begin
    Result := TRegistry.Create;
  end;
  {$ELSE}
  function CreateTRegistry: TRegistry;
  begin
    Result := TRegistry.Create(KEY_READ);
  end;
  {$ENDIF}
{$ENDIF}

function Max(AValueOne,AValueTwo: Integer): Integer;
begin
  if AValueOne < AValueTwo then
  begin
    Result := AValueTwo
  end //if AValueOne < AValueTwo then
  else
  begin
    Result := AValueOne;
  end; //else..if AValueOne < AValueTwo then
end;

function Min(AValueOne, AValueTwo : Integer): Integer;
begin
  If AValueOne > AValueTwo then
  begin
    Result := AValueTwo
  end //If AValueOne > AValueTwo then
  else
  begin
    Result := AValueOne;
  end; //..If AValueOne > AValueTwo then
end;

{This should never be localized}
function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
// should adhere to RFC 2616
var
  wDay,
  wMonth,
  wYear: Word;
begin
  DecodeDate(GMTValue, wYear, wMonth, wDay);
  Result := Format('%s, %.2d %s %.4d %s %s',    {do not localize}
                   [wdays[DayOfWeek(GMTValue)], wDay, monthnames[wMonth],
                    wYear, FormatDateTime('HH":"NN":"SS', GMTValue), 'GMT']);  {do not localize}
end;

{This should never be localized}
function DateTimeToInternetStr(const Value: TDateTime; const AIsGMT : Boolean = False) : String;
var
  wDay,
  wMonth,
  wYear: Word;
begin
  DecodeDate(Value, wYear, wMonth, wDay);
  Result := Format('%s, %d %s %d %s %s',    {do not localize}
                   [wdays[DayOfWeek(Value)], wDay, monthnames[wMonth],
                    wYear, FormatDateTime('HH":"NN":"SS', Value),  {do not localize}
                    DateTimeToGmtOffSetStr(OffsetFromUTC, AIsGMT)]);
end;

function StrInternetToDateTime(Value: string): TDateTime;
begin
  Result := RawStrInternetToDateTime(Value);
end;

{$IFDEF MSWINDOWS}
function GetInternetFormattedFileTimeStamp(const AFilename: String):String;
const
  wdays: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); {do not localize}
  monthnames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',   {do not localize}
    'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); {do not localize}
var
  DT1, DT2 : TDateTime;
  wDay, wMonth, wYear: Word;
begin
  DT1 := GetFileCreationTime(AFilename);
  DecodeDate(DT1, wYear, wMonth, wDay);
  DT2 := TimeZoneBias;
  Result := Format('%s, %d %s %d %s %s', [wdays[DayOfWeek(DT1)], wDay, monthnames[wMonth],   {do not localize}
   wYear, FormatDateTime('HH":"NN":"SS', DT1), DateTimeToGmtOffSetStr(DT2,False)]);   {do not localize}
end;

function GetFileCreationTime(const Filename: string): TDateTime;
var
  Data: TWin32FindData;
  H: THandle;
  FT: TFileTime;
  I: Integer;
begin
  H := FindFirstFile(PCHAR(Filename), Data);
  if H <> INVALID_HANDLE_VALUE then begin
    try
      FileTimeToLocalFileTime(Data.ftLastWriteTime, FT);
      FileTimeToDosDateTime(FT, LongRec(I).Hi, LongRec(I).Lo);
      Result := FileDateToDateTime(I);
    finally
      Windows.FindClose(H);
    end
  end else begin
    Result := 0;
  end;
end;
{$ENDIF}

function BreakApart(BaseString, BreakString: string; StringList: TStrings): TStrings;
var
  EndOfCurrentString: integer;
begin
  repeat
    EndOfCurrentString := Pos(BreakString, BaseString);
    if (EndOfCurrentString = 0) then
    begin
      StringList.add(BaseString);
    end
    else
      StringList.add(Copy(BaseString, 1, EndOfCurrentString - 1));
    delete(BaseString, 1, EndOfCurrentString + Length(BreakString) - 1); //Copy(BaseString, EndOfCurrentString + length(BreakString), length(BaseString) - EndOfCurrentString);
  until EndOfCurrentString = 0;
  result := StringList;
end;

procedure CommaSeparatedToStringList(AList: TStrings; const Value:string);
var
  iStart,
  iEnd,
  iQuote,
  iPos,
  iLength : integer ;
  sTemp : string ;
begin
  iQuote := 0;
  iPos := 1 ;
  iLength := Length(Value) ;
  AList.Clear ;
  while (iPos <= iLength) do
  begin
    iStart := iPos ;
    iEnd := iStart ;
    while ( iPos <= iLength ) do
    begin
      if Value[iPos] = '"' then  {do not localize}
      begin
        inc(iQuote);
      end;
      if Value[iPos] = ',' then  {do not localize}
      begin
        if iQuote <> 1 then
        begin
          break;
        end;
      end;
      inc(iEnd);
      inc(iPos);
    end ;
    sTemp := Trim(Copy(Value, iStart, iEnd - iStart));
    if Length(sTemp) > 0 then
    begin
      AList.Add(sTemp);
    end;
    iPos := iEnd + 1 ;
    iQuote := 0 ;
  end ;
end;

{$IFDEF LINUX}
function CopyFileTo(const Source, Destination: string): Boolean;
var
  SourceStream: TFileStream;
begin
  // -TODO: Change to use a Linux copy function
  // There is no native Linux copy function (at least "cp" doesn't use one
  // and I can't find one anywhere (Johannes Berg))
  Result := false;
  if not FileExists(Destination) then begin
    SourceStream := TFileStream.Create(Source, fmOpenRead); try
      with TFileStream.Create(Destination, fmCreate) do try
        CopyFrom(SourceStream, 0);
      finally Free; end;
    finally SourceStream.free; end;
    Result := true;
  end;
end;
{$ENDIF}
{$IFDEF MSWINDOWS}
function CopyFileTo(const Source, Destination: string): Boolean;
begin
  Result := CopyFile(PChar(Source), PChar(Destination), true);
end;
{$ENDIF}

{$IFDEF MSWINDOWS}
function TempPath: string;
var
	i: integer;
begin
  SetLength(Result, MAX_PATH);
	i := GetTempPath(Length(Result), PChar(Result));
	SetLength(Result, i);
  IncludeTrailingSlash(Result);
end;
{$ENDIF}

function MakeTempFilename(const APath: String = ''): string;
Begin
  {$IFDEF LINUX}
    {
    man tempnam
    [...]
    BUGS
       The precise meaning of `appropriate' is undefined;  it  is
       unspecified  how  accessibility  of  a directory is deter