📄 idglobalprotocols.pas
字号:
// 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 + -