⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 idglobalprotocols.pas

📁 photo.163.com 相册下载器 多线程下载
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  // day
  Result := LDay1 - LDay2;
  if Result <> 0 then
  begin
    Exit;
  end;
  DecodeTime(ADateTime1,LHour1,LMin1,LSec1,LMSec1);
  DecodeTime(ADateTime2,LHour2,LMin2,LSec2,LMSec2);
  //hour
  Result := LHour1 - LHour2;
  if Result <> 0 then
  begin
    Exit;
  end;
  //minute
  Result := LMin1 - LMin2;
  if Result <> 0 then
  begin
    Exit;
  end;
  //second
  Result := LSec1 - LSec2;
  if Result <> 0 then
  begin
    Exit;
  end;
  //millasecond
  Result := LMSec1 - LMSec2;
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;
  //flags for if AM/PM marker found
  LAM, LPM : Boolean;

  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;

  LAM:=false;
  LPM:=false;

  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
        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
    if IndyPos('AM', Value)>0 then {do not localize}
    begin
      LAM := True;
      Value := Fetch(Value, 'AM');  {do not localize}
    end;
    if IndyPos('PM', Value)>0 then  {do not localize}
    begin
      LPM := True;
      Value := Fetch(Value, 'PM');  {do not localize}
    end;
    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);
      {AM/PM part if preasent}
      Value := TrimLeft(Value);
      if LAM then
      begin
        if Ho = 12 then
        begin
          Ho := 0;
        end;
      end
      else
      begin
        if LPM then
        begin
          //in the 12 hour format, afternoon is 12:00PM followed by 1:00PM
          //while midnight is written as 12:00 AM
          //Not exactly technically correct but pritty accurate
          if Ho < 12 then
          begin
            Ho := Ho + 12;
          end;
        end;
      end;
      {The date and time stamp returned}
      Result := Result + EncodeTime(Ho, Min, Sec, 0);
    end;
    Value := TrimLeft(Value);
  except
    Result := 0.0;
  end;
end;

{$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;

{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;

function FTPMLSToGMTDateTime(const ATimeStamp : String):TDateTime;
var LYear, LMonth, LDay, LHour, LMin, LSec, LMSec : Integer;
    LBuffer : String;
begin
  Result := 0;
  LBuffer := ATimeStamp;
  if LBuffer <> '' then
  begin
  //  1234 56 78  90 12 34
  //  ---------- ---------
  //  1998 11 07  08 52 15
      LYear := StrToIntDef( Copy( LBuffer,1,4),0);
      LMonth := StrToIntDef(Copy(LBuffer,5,2),0);
      LDay := StrToIntDef(Copy(LBuffer,7,2),0);

      LHour := StrToIntDef(Copy(LBuffer,9,2),0);
      LMin := StrToIntDef(Copy(LBuffer,11,2),0);
      LSec := StrToIntDef(Copy(LBuffer,13,2),0);
      Fetch(LBuffer,'.');
      LMSec := StrToIntDef(LBuffer,0);
      Result := EncodeDate(LYear,LMonth,LDay);
      Result := Result + EncodeTime(LHour,LMin,LSec,LMSec);
  end;
end;

function FTPMLSToLocalDateTime(const ATimeStamp : String):TDateTime;
begin
  Result := 0;
  if ATimeStamp <> '' then
  begin
    Result := FTPMLSToGMTDateTime(ATimeStamp);
    // Apply local offset
    Result := Result + OffSetFromUTC;
  end;
end;

function FTPGMTDateTimeToMLS(const ATimeStamp : TDateTime): String;
var LYear, LMonth, LDay,
    LHour, LMin, LSec, LMSec : Word;

begin
  DecodeDate(ATimeStamp,LYear,LMonth,LDay);
  DecodeTime(ATimeStamp,LHour,LMin,LSec,LMSec);
  Result := Format('%4d%2d%2d%2d%2d%2d',[LYear,LMonth,LDay,LHour,LMin,LSec]);
  if (LMSec <> 0) then
  begin
    Result := Result + Format('.%3d',[LMSec]);
  end;
  Result := StringReplace(Result,' ','0',[rfReplaceAll]);
end;
{
Note that MS-DOS displays the time in the Local Time Zone - MLISx commands use
stamps based on GMT)
}
function FTPLocalDateTimeToMLS(const ATimeStamp : TDateTime): String;
begin
  Result := FTPGMTDateTimeToMLS(ATimeStamp - OffSetFromUTC);
end;


function BreakApart(BaseString, BreakString: string; StringList: TIdStrings): TIdStrings;
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: TIdStrings; 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}
//LEave in for IdAttachment
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 := IndyCopyFile(Source, Destination, True);
end;
{$ENDIF}
{$IFDEF MSWINDOWS}
function CopyFileTo(const Source, Destination: string): Boolean;
begin
  Result := CopyFile(PChar(Source), PChar(Destination), true);
end;
{$ENDIF}
{$IFDEF DOTNET}
function CopyFileTo(const Source, Destination: string): Boolean;
begin
  System.IO.File.Copy(Source, Destination, true);
  result := true; // or you'll get an exception
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;
var
  lPath: string;
  lExt: string;

begin
  lPath := APath;

  {$IFDEF LINUX}
  lExt = '';
  {$ELSE}
  lExt := '.tmp';
  {$ENDIF}

  {$IFDEF MSWINDOWS}
  if lPath = '' then
  begin
    lPath := ATempPath;
  end;
  {$ENDIF}

  {$IFDEF DOTNET}
  if lPath = '' then
  begin
    lPath := System.IO.Path.GetTempPath;
  end;
  {$ENDIF}

  Result := GetUniqueFilename(lPath, 'Indy', lExt);
end;

function GetUniqueFileName(const APath, APrefix, AExt : String) : String;
var
  LNamePart : Cardinal;
  LFQE : String;
  LFName: String;
begin
  {$IFDEF LINUX}

  {
    man tempnam

    BUGS

       The precise meaning of `appropriate' is undefined;  it  is
       unspecified  how  accessibility  of  a directory is deter

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -