4972 lines
172 KiB
Plaintext
4972 lines
172 KiB
Plaintext
{
|
||
$Project$
|
||
$Workfile$
|
||
$Revision$
|
||
$DateUTC$
|
||
$Id$
|
||
|
||
This file is part of the Indy (Internet Direct) project, and is offered
|
||
under the dual-licensing agreement described on the Indy website.
|
||
(http://www.indyproject.org/)
|
||
|
||
Copyright:
|
||
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
||
}
|
||
{
|
||
$Log$
|
||
}
|
||
{
|
||
10 Indy10 1.9 5/4/2005 7:06:24 PM J. Peter Mugaas Attempt to
|
||
fix another junked part of the file.
|
||
|
||
9 Indy10 1.8 5/4/2005 7:02:50 PM J. Peter Mugaas Attempt to
|
||
fix a junked file.
|
||
|
||
8 Indy10 1.7 5/4/2005 6:31:08 PM J. Peter Mugaas These
|
||
should now work. I moved a TextWrapping function out of TIdHeaderList
|
||
and into IdGlobalProtocols so the FTP List output object can use it and
|
||
so we can rework the routine slightly to use StringBuilder in DotNET.
|
||
|
||
7 Indy10 1.6 4/28/2005 11:02:30 PM J. Peter Mugaas Removed
|
||
StrToInt64Def symbol. We now use Sys.StrToInt64 instead.
|
||
|
||
6 Indy10 1.5 4/28/2005 10:23:14 PM J. Peter Mugaas Should now
|
||
work with new API change in CharInSet.
|
||
|
||
5 Indy10 1.4 4/20/2005 10:44:24 PM Ben Taylor IdSys
|
||
changes
|
||
|
||
4 Indy10 1.3 4/20/2005 12:43:48 AM J. Peter Mugaas Removed
|
||
SysUtils from most units and added it to IdGlobalProtocols (works best
|
||
that way).
|
||
|
||
3 Indy10 1.2 4/19/2005 5:19:11 PM J. Peter Mugaas Removed
|
||
SysUtils and fixed EIdException reference.
|
||
|
||
2 Indy10 1.1 4/19/2005 10:15:26 AM J. Peter Mugaas Updates
|
||
|
||
Rev 1.31 04/03/2005 21:21:56 HHariri
|
||
Fix for DirectoryExists and removal of FileCtrl dependency
|
||
|
||
Rev 1.30 3/3/2005 10:12:38 AM JPMugaas
|
||
Fix for compiler warning about DotNET and ByteType.
|
||
|
||
Rev 1.29 2/12/2005 8:08:02 AM JPMugaas
|
||
Attempt to fix MDTM bug where msec was being sent.
|
||
|
||
Rev 1.28 2/10/2005 2:24:40 PM JPMugaas
|
||
Minor Restructures for some new UnixTime Service components.
|
||
|
||
Rev 1.27 1/15/2005 6:02:46 PM JPMugaas
|
||
Byte extract with byte order now use updated code in IdGlobal.
|
||
|
||
Rev 1.26 1/8/2005 3:59:58 PM JPMugaas
|
||
New functions for reading integer values to and from TIdBytes using the
|
||
network byte order functions. They should be used for embedding values in
|
||
some Internet Protocols such as FSP, SNTP, and maybe others.
|
||
|
||
Rev 1.25 12/3/2004 3:16:20 PM DSiders
|
||
Fixed assignment error in MakeTempFilename.
|
||
|
||
Rev 1.24 12/1/2004 4:40:42 AM JPMugaas
|
||
Fix for GMT Time routine. This has been tested.
|
||
|
||
Rev 1.23 11/14/2004 10:28:42 PM JPMugaas
|
||
Compiler warning in IdGlobalProtocol about an undefined result.
|
||
|
||
Rev 1.22 12/11/2004 9:31:22 HHariri
|
||
Fix for Delphi 5
|
||
|
||
Rev 1.21 11/11/2004 11:18:04 PM JPMugaas
|
||
Function to get the Last Modified file in GMT instead of localtime. Needed
|
||
by TIdFSP.
|
||
|
||
Rev 1.20 2004.10.27 9:17:50 AM czhower
|
||
For TIdStrings
|
||
|
||
Rev 1.19 10/26/2004 10:07:02 PM JPMugaas
|
||
Updated refs.
|
||
|
||
Rev 1.18 10/13/2004 7:48:52 PM DSiders
|
||
Modified GetUniqueFilename to pass correct argument type to tempnam function.
|
||
|
||
Rev 1.17 10/6/2004 11:39:48 PM DSiders
|
||
Modified MakeTempFilename to use GetUniqueFilename. File extensions are
|
||
omitted on Linux.
|
||
Modified GetUniqueFilename to use tempnam function on Linux. Validates path
|
||
on Win32 and .Net. Uses platform-specific temp path on Win32 and .Net.
|
||
|
||
Rev 1.16 9/5/2004 2:55:52 AM JPMugaas
|
||
Fixed a range check error in
|
||
|
||
function TwoCharToWord(AChar1,AChar2: Char):Word;.
|
||
|
||
Rev 1.15 8/10/04 8:47:16 PM RLebeau
|
||
Bug fix for TIdMimeTable.AddMimeType()
|
||
|
||
Rev 1.14 8/5/04 5:44:40 PM RLebeau
|
||
Added GetMIMEDefaultFileExt() function
|
||
|
||
Rev 1.13 7/23/04 6:51:34 PM RLebeau
|
||
Added extra exception handling to IndyCopyFile()
|
||
|
||
Updated CopyFileTo() to call IndyCopyFile()
|
||
|
||
TFileStream access right tweak for FileSizeByName()
|
||
|
||
Rev 1.12 7/8/04 5:23:46 PM RLebeau
|
||
Updated CardinalToFourChar() to remove use of local TIdBytes variable
|
||
|
||
Rev 1.11 11/06/2004 00:22:38 CCostelloe
|
||
Implemented GetClockValue for Linux
|
||
|
||
Rev 1.10 09/06/2004 10:03:00 CCostelloe
|
||
Kylix 3 patch
|
||
|
||
Rev 1.9 02/05/2004 13:20:50 CCostelloe
|
||
Added RemoveHeaderEntry for use by IdMessage and IdMessageParts (typically
|
||
removing old boundary)
|
||
|
||
Rev 1.8 2/22/2004 12:09:38 AM JPMugaas
|
||
Fixes for IMAP4Server compile failure in DotNET. This also fixes a potential
|
||
problem where file handles can be leaked in the server needlessly.
|
||
|
||
Rev 1.7 2/19/2004 11:53:00 PM JPMugaas
|
||
Moved some functions out of CoderQuotedPrintable for reuse.
|
||
|
||
Rev 1.6 2/19/2004 11:40:28 PM JPMugaas
|
||
Character to hex translation routine added for QP and some
|
||
internationalization work.
|
||
|
||
Rev 1.5 2/19/2004 3:22:40 PM JPMugaas
|
||
ABNFToText and related functions added for some RFC 2234. This is somee
|
||
groundwork for RFC 2640 - Internationalization of the File Transfer Protocol.
|
||
|
||
Rev 1.4 2/16/2004 1:53:34 PM JPMugaas
|
||
Moved some routines to the system package.
|
||
|
||
Rev 1.3 2/11/2004 5:17:50 AM JPMugaas
|
||
Bit flip functionality was removed because is problematic on some
|
||
architectures. They were used in place of the standard network byte order
|
||
conversion routines. On an Intel chip, flip works the same as those but in
|
||
architectures where network order is the same as host order, some functions
|
||
will fail and you may get strange results. The network byte order conversion
|
||
functions provide transparancy amoung architectures.
|
||
|
||
Rev 1.2 2/9/2004 11:27:48 AM JPMugaas
|
||
Some functions weren't working as expected. Renamed them to describe them
|
||
better.
|
||
|
||
Rev 1.1 2/7/2004 7:18:38 PM JPMugaas
|
||
Moved some functions out of IdDNSCommon so we can use them elsewhere.
|
||
|
||
Rev 1.0 2004.02.03 7:46:04 PM czhower
|
||
New names
|
||
|
||
Rev 1.43 1/31/2004 3:31:58 PM JPMugaas
|
||
Removed some File System stuff for new package.
|
||
|
||
Rev 1.42 1/31/2004 1:00:26 AM JPMugaas
|
||
FileDateByName was changed to LocalFileDateByName as that uses the Local Time
|
||
Zone.
|
||
Added BMTDateByName for some GMT-based stuff.
|
||
We now use the IdFileSystem*.pas units instead of SysUtils for directory
|
||
functions. This should remove a dependancy on platform specific things in
|
||
DotNET.
|
||
|
||
Rev 1.41 1/29/2004 6:22:22 AM JPMugaas
|
||
IndyComputerName will now use Environment.MachineName in DotNET. This should
|
||
fix the ESMTP bug where IndyComputerName would return nothing causing an EHLO
|
||
and HELO command to fail in TIdSMTP under DotNET.
|
||
|
||
Rev 1.40 2004.01.22 5:58:56 PM czhower
|
||
IdCriticalSection
|
||
|
||
Rev 1.39 14/01/2004 00:16:10 CCostelloe
|
||
Updated to remove deprecated warnings by using
|
||
TextIsSame/IndyLowerCase/IndyUpperCase
|
||
|
||
Rev 1.38 2003.12.28 6:50:30 PM czhower
|
||
Update for Ticks function
|
||
|
||
Rev 1.37 4/12/2003 10:24:06 PM GGrieve
|
||
Fix to Compile
|
||
|
||
Rev 1.36 11/29/2003 12:19:50 AM JPMugaas
|
||
CompareDateTime added for more accurate DateTime comparisons. Sometimes
|
||
comparing two floating point values for equality will fail because they are
|
||
of different percision and some fractions such as 1/3 and pi (7/22) can never
|
||
be calculated 100% accurately.
|
||
|
||
Rev 1.35 25/11/2003 12:24:20 PM SGrobety
|
||
various IdStream fixes with ReadLn/D6
|
||
|
||
Rev 1.34 10/16/2003 11:18:10 PM DSiders
|
||
Added localization comments.
|
||
Corrected spelling error in coimments.
|
||
|
||
Rev 1.33 10/15/2003 9:53:58 PM GGrieve
|
||
Add TIdInterfacedObject
|
||
|
||
Rev 1.32 10/10/2003 10:52:12 PM BGooijen
|
||
Removed IdHexDigits
|
||
|
||
Rev 1.31 10/8/2003 9:52:40 PM GGrieve
|
||
reintroduce GetSystemLocale as IdGetDefaultCharSet
|
||
|
||
Rev 1.30 10/8/2003 2:25:40 PM GGrieve
|
||
Update ROL and ROR for DotNet
|
||
|
||
Rev 1.29 10/5/2003 11:43:32 PM GGrieve
|
||
Add IsLeadChar
|
||
|
||
Rev 1.28 10/5/2003 5:00:10 PM GGrieve
|
||
GetComputerName (once was IndyGetHostName)
|
||
|
||
Rev 1.27 10/4/2003 9:14:26 PM GGrieve
|
||
Remove TIdCardinalBytes - replace with other methods
|
||
|
||
Rev 1.26 10/3/2003 11:55:50 PM GGrieve
|
||
First full DotNet version
|
||
|
||
Rev 1.25 10/3/2003 5:39:30 PM GGrieve
|
||
dotnet work
|
||
|
||
Rev 1.24 2003.10.02 10:52:48 PM czhower
|
||
.Net
|
||
|
||
Rev 1.23 2003.10.02 9:27:50 PM czhower
|
||
DotNet Excludes
|
||
|
||
Rev 1.22 9/18/2003 07:41:46 PM JPMugaas
|
||
Moved GetThreadHandle to IdCoreGlobal.
|
||
|
||
Rev 1.21 9/10/2003 03:26:42 AM JPMugaas
|
||
Added EnsureMsgIDBrackets() function. Checked in on behalf of Remy Lebeau
|
||
|
||
Rev 1.20 6/27/2003 05:53:28 AM JPMugaas
|
||
Removed IsNumeric. That's now in IdCoreGlobal.
|
||
|
||
Rev 1.19 2003.06.23 2:57:18 PM czhower
|
||
Comments added
|
||
|
||
Rev 1.18 2003.06.23 9:46:54 AM czhower
|
||
Russian, Ukranian support for headers.
|
||
|
||
Rev 1.17 2003.06.13 2:24:40 PM czhower
|
||
Expanded TIdCardinalBytes
|
||
|
||
Rev 1.16 5/13/2003 12:45:50 PM JPMugaas
|
||
GetClockValue added for unique clock values.
|
||
|
||
Rev 1.15 5/8/2003 08:43:14 PM JPMugaas
|
||
Function for finding an integer's position in an array of integers. This is
|
||
required by some SASL code.
|
||
|
||
Rev 1.14 4/21/2003 7:52:58 PM BGooijen
|
||
other nt version detection, removed non-existing windows versions
|
||
|
||
Rev 1.13 4/18/2003 09:28:24 PM JPMugaas
|
||
Changed Win32 Operating System detection so it can distinguish between
|
||
workstation OS NT versions and server versions. I also added specific
|
||
detection for Windows NT 4.0 with a Service Pack below 6 (requested by Bas).
|
||
|
||
Rev 1.12 2003.04.16 10:06:22 PM czhower
|
||
Moved DebugOutput to IdCoreGlobal
|
||
|
||
Rev 1.11 4/10/2003 02:54:32 PM JPMugaas
|
||
Improvement for FTP STOU command. Unique filename now uses
|
||
IdGlobal.GetUniqueFileName instead of Rand. I also fixed GetUniqueFileName
|
||
so that it can accept an empty path specification.
|
||
|
||
Rev 1.10 4/5/2003 10:39:06 PM BGooijen
|
||
LAM,LPM were not initialized
|
||
|
||
Rev 1.9 4/5/2003 04:12:00 AM JPMugaas
|
||
Date Time should now be able to process AM/PM.
|
||
|
||
Rev 1.8 4/4/2003 11:02:56 AM JPMugaas
|
||
Added GetUniqueFileName for the Virtual FTP File System component.
|
||
|
||
Rev 1.7 20/3/2003 19:15:46 GGrieve
|
||
Fix GMTToLocalDateTime for empty content
|
||
|
||
Rev 1.6 3/9/2003 04:34:40 PM JPMugaas
|
||
FileDateByName now works on directories.
|
||
|
||
Rev 1.5 2/14/2003 11:50:58 AM JPMugaas
|
||
Removed a function for giving an OS identifier in the FTP server because we
|
||
no longer use that function.
|
||
|
||
Rev 1.4 1/27/2003 12:30:22 AM JPMugaas
|
||
Forgot to add a space after one OS type. That makes the job a little easier
|
||
for the FTP Server SYST command handler.
|
||
|
||
Rev 1.3 1/26/2003 11:56:30 PM JPMugaas
|
||
Added function for returning an OS descriptor for combining with a FTP Server
|
||
SysDescription for the SYST command reply. This can also optionally return
|
||
the true system identifier.
|
||
|
||
Rev 1.2 1/9/2003 05:39:08 PM JPMugaas
|
||
Added workaround for if the date is missing a space after a comma.
|
||
|
||
Rev 1.1 12/29/2002 2:13:14 PM JPMugaas
|
||
Moved THandle to IdCoreGlobal for new function used in the core.
|
||
|
||
Rev 1.0 11/13/2002 08:29:32 AM JPMugaas
|
||
Initial import from FTP VC.
|
||
}
|
||
|
||
unit IdGlobalProtocols;
|
||
|
||
interface
|
||
|
||
{$i IdCompilerDefines.inc}
|
||
|
||
uses
|
||
Classes,
|
||
{$IFDEF WINDOWS}
|
||
Windows,
|
||
{$ENDIF}
|
||
IdCharsets,
|
||
IdBaseComponent,
|
||
IdGlobal,
|
||
IdException,
|
||
SysUtils;
|
||
|
||
const
|
||
LWS = TAB + CHAR32;
|
||
|
||
// TODO: get rid of these and use the ones in the IdGlobal unit
|
||
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', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); {do not localize}
|
||
|
||
type
|
||
//WinCE only has Unicode functions for files.
|
||
{$IFDEF WINCE}
|
||
TIdFileName = TIdUnicodeString;
|
||
PIdFileNameChar = PWideChar;
|
||
{$ELSE}
|
||
TIdFileName = String;
|
||
PIdFileNameChar = PChar;
|
||
{$ENDIF}
|
||
|
||
TIdReadLnFunction = function: string of object;
|
||
TStringEvent = procedure(ASender: TComponent; const AString: String);
|
||
|
||
TIdMimeTable = class(TObject)
|
||
protected
|
||
FLoadTypesFromOS: Boolean;
|
||
FOnBuildCache: TNotifyEvent;
|
||
FMIMEList: TStrings;
|
||
FFileExt: TStrings;
|
||
procedure BuildDefaultCache; virtual;
|
||
public
|
||
property LoadTypesFromOS: Boolean read FLoadTypesFromOS write FLoadTypesFromOS;
|
||
procedure BuildCache; virtual;
|
||
procedure AddMimeType(const Ext, MIMEType: string; const ARaiseOnError: Boolean = True);
|
||
function GetFileMIMEType(const AFileName: string): string;
|
||
function GetDefaultFileExt(const MIMEType: string): string;
|
||
procedure LoadFromStrings(const AStrings: TStrings; const MimeSeparator: Char = '='); {Do not Localize}
|
||
procedure SaveToStrings(const AStrings: TStrings; const MimeSeparator: Char = '='); {Do not Localize}
|
||
constructor Create(const AutoFill: Boolean = True); reintroduce; virtual;
|
||
destructor Destroy; override;
|
||
//
|
||
property OnBuildCache: TNotifyEvent read FOnBuildCache write FOnBuildCache;
|
||
end;
|
||
|
||
TIdInterfacedObject = class (TInterfacedObject)
|
||
public
|
||
function _AddRef: Integer;
|
||
function _Release: Integer;
|
||
end;
|
||
|
||
TIdHeaderQuotingType = (QuotePlain, QuoteRFC822, QuoteMIME, QuoteHTTP);
|
||
|
||
//
|
||
EIdExtensionAlreadyExists = class(EIdException);
|
||
|
||
// Procs - KEEP THESE ALPHABETICAL!!!!!
|
||
|
||
// procedure BuildMIMETypeMap(dest: TIdStringList);
|
||
// TODO: IdStrings have optimized SplitColumns* functions, can we remove it?
|
||
function ABNFToText(const AText : String) : String;
|
||
function BinStrToInt(const ABinary: String): Integer;
|
||
function BreakApart(BaseString, BreakString: string; StringList: TStrings): TStrings;
|
||
function UInt32ToFourChar(AValue : UInt32): string;
|
||
function LongWordToFourChar(AValue : UInt32): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt32ToFourChar()'{$ENDIF};{$ENDIF}
|
||
function CharRange(const AMin, AMax : Char): String;
|
||
procedure CommaSeparatedToStringList(AList: TStrings; const Value:string);
|
||
function CompareDateTime(const ADateTime1, ADateTime2 : TDateTime) : Integer;
|
||
|
||
function ContentTypeToEncoding(const AContentType: string; AQuoteType: TIdHeaderQuotingType): IIdTextEncoding;
|
||
function CharsetToEncoding(const ACharset: string): IIdTextEncoding;
|
||
|
||
function ReadStringAsContentType(AStream: TStream; const AContentType: String;
|
||
AQuoteType: TIdHeaderQuotingType
|
||
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}): String;
|
||
|
||
procedure ReadStringsAsContentType(AStream: TStream; AStrings: TStrings;
|
||
const AContentType: String; AQuoteType: TIdHeaderQuotingType
|
||
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
|
||
procedure WriteStringAsContentType(AStream: TStream; const AStr, AContentType: String;
|
||
AQuoteType: TIdHeaderQuotingType
|
||
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
|
||
procedure WriteStringsAsContentType(AStream: TStream; const AStrings: TStrings;
|
||
const AContentType: String; AQuoteType: TIdHeaderQuotingType
|
||
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
|
||
procedure WriteStringAsCharset(AStream: TStream; const AStr, ACharset: string
|
||
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
|
||
procedure WriteStringsAsCharset(AStream: TStream; const AStrings: TStrings;
|
||
const ACharset: string
|
||
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
|
||
function ReadStringAsCharset(AStream: TStream; const ACharset: String
|
||
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}): String;
|
||
|
||
procedure ReadStringsAsCharset(AStream: TStream; AStrings: TStrings; const ACharset: string
|
||
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
|
||
{
|
||
These are for handling binary values that are in Network Byte order. They call
|
||
ntohs, ntols, htons, and htons which are required by SNTP and FSP
|
||
(probably some other protocols). They aren't aren't in IdGlobals because that
|
||
doesn't refer to IdStack so you can't use GStack there.
|
||
}
|
||
procedure CopyBytesToHostUInt32(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt32);
|
||
procedure CopyBytesToHostUInt16(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt16);
|
||
procedure CopyTIdNetworkUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
|
||
procedure CopyTIdNetworkUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
|
||
|
||
procedure CopyBytesToHostLongWord(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt32); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyBytesToHostUInt32'{$ENDIF};{$ENDIF}
|
||
procedure CopyBytesToHostWord(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt16); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyBytesToHostWord'{$ENDIF};{$ENDIF}
|
||
procedure CopyTIdNetworkLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdNetworkLongWord'{$ENDIF};{$ENDIF}
|
||
procedure CopyTIdNetworkWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdNetworkWord'{$ENDIF};{$ENDIF}
|
||
|
||
function CopyFileTo(const Source, Destination: TIdFileName): Boolean;
|
||
function DomainName(const AHost: String): String;
|
||
function EnsureMsgIDBrackets(const AMsgID: String): String;
|
||
function ExtractHeaderItem(const AHeaderLine: String): String;
|
||
function ExtractHeaderSubItem(const AHeaderLine, ASubItem: String; AQuoteType: TIdHeaderQuotingType): String;
|
||
function ReplaceHeaderSubItem(const AHeaderLine, ASubItem, AValue: String; AQuoteType: TIdHeaderQuotingType): String; overload;
|
||
function ReplaceHeaderSubItem(const AHeaderLine, ASubItem, AValue: String; var VOld: String; AQuoteType: TIdHeaderQuotingType): String; overload;
|
||
function IsHeaderMediaType(const AHeaderLine, AMediaType: String): Boolean;
|
||
function IsHeaderMediaTypes(const AHeaderLine: String; const AMediaTypes: array of String): Boolean;
|
||
function ExtractHeaderMediaType(const AHeaderLine: String): String;
|
||
function ExtractHeaderMediaSubType(const AHeaderLine: String): String;
|
||
function IsHeaderValue(const AHeaderLine: String; const AValue: String): Boolean;
|
||
function FileSizeByName(const AFilename: TIdFileName): Int64;
|
||
{$IFDEF WINDOWS}
|
||
function IsVolume(const APathName : TIdFileName) : Boolean;
|
||
{$ENDIF}
|
||
//MLIST FTP DateTime conversion functions
|
||
function FTPMLSToGMTDateTime(const ATimeStamp : String):TDateTime;
|
||
function FTPMLSToLocalDateTime(const ATimeStamp : String):TDateTime;
|
||
|
||
function FTPGMTDateTimeToMLS(const ATimeStamp : TDateTime; const AIncludeMSecs : Boolean=True): String;
|
||
function FTPLocalDateTimeToMLS(const ATimeStamp : TDateTime; const AIncludeMSecs : Boolean=True): String;
|
||
|
||
function GetClockValue : Int64;
|
||
function GetMIMETypeFromFile(const AFile: TIdFileName): string;
|
||
function GetMIMEDefaultFileExt(const MIMEType: string): TIdFileName;
|
||
function GetGMTDateByName(const AFileName : TIdFileName) : TDateTime;
|
||
function GmtOffsetStrToDateTime(const S: string): TDateTime;
|
||
function GMTToLocalDateTime(S: string): TDateTime;
|
||
function CookieStrToLocalDateTime(S: string): TDateTime;
|
||
function IdGetDefaultCharSet : TIdCharSet;
|
||
function IntToBin(Value: UInt32): string;
|
||
function IndyComputerName : String; // DotNet: see comments regarding GDotNetComputerName below
|
||
function IndyCurrentYear : Integer;
|
||
|
||
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;
|
||
{$IFDEF STRING_IS_ANSI}
|
||
function IsLeadChar(ACh : Char): Boolean;
|
||
{$ENDIF}
|
||
function IsTopDomain(const AStr: string): Boolean;
|
||
function IsValidIP(const S: String): Boolean;
|
||
function MakeTempFilename(const APath: TIdFileName = ''): TIdFileName;
|
||
function OrdFourByteToUInt32(AByte1, AByte2, AByte3, AByte4 : Byte): UInt32;
|
||
function OrdFourByteToLongWord(AByte1, AByte2, AByte3, AByte4 : Byte): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use OrdFourByteToUInt32()'{$ENDIF};{$ENDIF}
|
||
procedure UInt32ToOrdFourByte(const AValue: UInt32; var VByte1, VByte2, VByte3, VByte4 : Byte);
|
||
procedure LongWordToOrdFourByte(const AValue: UInt32; var VByte1, VByte2, VByte3, VByte4 : Byte); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt32ToOrdFourByte()'{$ENDIF};{$ENDIF}
|
||
|
||
function PadString(const AString : String; const ALen : Integer; const AChar: Char): String;
|
||
function UnquotedStr(const AStr : String): String;
|
||
|
||
function ProcessPath(const ABasePath: String; const APath: String; const APathDelim: string = '/'): string; {Do not Localize}
|
||
function RightStr(const AStr: String; const Len: Integer): String;
|
||
// still to figure out how to reproduce these under .Net
|
||
function ROL(const AVal: UInt32; AShift: Byte): UInt32;
|
||
function ROR(const AVal: UInt32; AShift: Byte): UInt32;
|
||
function RPos(const ASub, AIn: String; AStart: Integer = -1): Integer;
|
||
function IndySetLocalTime(Value: TDateTime): Boolean;
|
||
|
||
function StartsWith(const ANSIStr, APattern : String) : Boolean;
|
||
|
||
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;
|
||
//these are for FSP but may also help with MySQL
|
||
function UnixDateTimeToDelphiDateTime(UnixDateTime: UInt32): TDateTime;
|
||
function DateTimeToUnix(ADateTime: TDateTime): UInt32;
|
||
|
||
function TwoCharToUInt16(AChar1, AChar2: Char): Word;
|
||
function TwoCharToWord(AChar1, AChar2: Char): Word; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use TwoCharToUInt16()'{$ENDIF};{$ENDIF}
|
||
|
||
function UpCaseFirst(const AStr: string): string;
|
||
function UpCaseFirstWord(const AStr: string): string;
|
||
function GetUniqueFileName(const APath, APrefix, AExt : String) : String;
|
||
procedure UInt16ToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer);
|
||
procedure WordToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt16ToTwoBytes()'{$ENDIF};{$ENDIF}
|
||
function UInt16ToStr(const Value: Word): String;
|
||
function WordToStr(const Value: Word): String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt16ToStr()'{$ENDIF};{$ENDIF}
|
||
|
||
//moved here so I can IFDEF a DotNET ver. that uses StringBuilder
|
||
function IndyWrapText(const ALine, ABreakStr, ABreakChars : string; MaxCol: Integer): string;
|
||
|
||
//The following is for working on email headers and message part headers...
|
||
function RemoveHeaderEntry(const AHeader, AEntry: string; AQuoteType: TIdHeaderQuotingType): string; overload;
|
||
function RemoveHeaderEntry(const AHeader, AEntry: string; var VOld: String; AQuoteType: TIdHeaderQuotingType): string; overload;
|
||
function RemoveHeaderEntries(const AHeader: string; AEntries: array of string; AQuoteType: TIdHeaderQuotingType): string;
|
||
|
||
{
|
||
Three functions for easier manipulating of strings. Don't know of any
|
||
system functions to perform these actions. If there aren't and someone
|
||
can find an optimised way of performing then please implement...
|
||
}
|
||
function FindFirstOf(const AFind, AText: string; const ALength: Integer = -1; const AStartPos: Integer = 1): Integer;
|
||
function FindFirstNotOf(const AFind, AText: string; const ALength: Integer = -1; const AStartPos: Integer = 1): Integer;
|
||
function TrimAllOf(const ATrim, AText: string): string;
|
||
procedure ParseMetaHTTPEquiv(AStream: TStream; AHeaders : TStrings; var VCharSet: string);
|
||
|
||
type
|
||
TIdEncodingNeededEvent = function(const ACharset: String): IIdTextEncoding;
|
||
|
||
var
|
||
{$IFDEF UNIX}
|
||
// For linux the user needs to set these variables to be accurate where used (mail, etc)
|
||
GIdDefaultCharSet : TIdCharSet = idcs_ISO_8859_1; // idcsISO_8859_1;
|
||
{$ENDIF}
|
||
|
||
GIdEncodingNeeded: TIdEncodingNeededEvent = nil;
|
||
|
||
IndyFalseBoolStrs : array of String;
|
||
IndyTrueBoolStrs : array of String;
|
||
|
||
//This is from: http://www.swissdelphicenter.ch/en/showcode.php?id=844
|
||
const
|
||
// Sets UnixStartDate to TIdDateTime of 01/01/1970
|
||
UNIXSTARTDATE : TDateTime = 25569.0;
|
||
{This indicates that the default date is Jan 1, 1900 which was specified
|
||
by RFC 868.}
|
||
TIME_BASEDATE = 2;
|
||
|
||
//These are moved here to facilitate inlining
|
||
const
|
||
HexNumbers = '01234567890ABCDEF'; {Do not Localize}
|
||
BinNumbers = '01'; {Do not localize}
|
||
|
||
implementation
|
||
|
||
uses
|
||
{$IFDEF USE_VCL_POSIX}
|
||
{$IFDEF DARWIN}
|
||
Macapi.CoreServices,
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
IdIPAddress,
|
||
{$IFDEF UNIX}
|
||
{$IFDEF KYLIXCOMPAT}
|
||
Libc,
|
||
{$ENDIF}
|
||
{$IFDEF FPC}
|
||
{$IFDEF USE_BASEUNIX}
|
||
BaseUnix,
|
||
Unix,
|
||
DateUtils,
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF USE_VCL_POSIX}
|
||
DateUtils,
|
||
Posix.SysStat, Posix.SysTime, Posix.Time, Posix.Unistd,
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF WINDOWS}
|
||
Messages,
|
||
Registry,
|
||
{$ENDIF}
|
||
{$IFDEF DOTNET}
|
||
System.IO,
|
||
System.Text,
|
||
{$ENDIF}
|
||
IdAssignedNumbers,
|
||
IdResourceStringsCore,
|
||
IdResourceStringsProtocols,
|
||
IdStack
|
||
{$IFDEF USE_OBJECT_ARC}
|
||
{$IFDEF HAS_UNIT_Generics_Collections}
|
||
, System.Generics.Collections
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
;
|
||
|
||
//
|
||
|
||
function UnquotedStr(const AStr : String): String;
|
||
begin
|
||
Result := AStr;
|
||
if TextStartsWith(Result, '"') then begin
|
||
IdDelete(Result, 1, 1);
|
||
Result := Fetch(Result, '"');
|
||
end;
|
||
end;
|
||
|
||
{This is taken from Borland's SysUtils and modified for our folding} {Do not Localize}
|
||
function IndyWrapText(const ALine, ABreakStr, ABreakChars : string; MaxCol: Integer): string;
|
||
const
|
||
QuoteChars = '"'; {Do not Localize}
|
||
var
|
||
LCol, LPos: Integer;
|
||
LLinePos, LLineLen: Integer;
|
||
LBreakLen, LBreakPos: Integer;
|
||
LQuoteChar, LCurChar: Char;
|
||
LExistingBreak: Boolean;
|
||
begin
|
||
LCol := 1;
|
||
LPos := 1;
|
||
LLinePos := 1;
|
||
LBreakPos := 0;
|
||
LQuoteChar := ' '; {Do not Localize}
|
||
LExistingBreak := False;
|
||
LLineLen := Length(ALine);
|
||
LBreakLen := Length(ABreakStr);
|
||
Result := ''; {Do not Localize}
|
||
while LPos <= LLineLen do begin
|
||
LCurChar := ALine[LPos];
|
||
{$IFDEF STRING_IS_ANSI}
|
||
if IsLeadChar(LCurChar) then begin
|
||
Inc(LPos);
|
||
Inc(LCol);
|
||
end else begin //if CurChar in LeadBytes then
|
||
{$ENDIF}
|
||
if LCurChar = ABreakStr[1] then begin
|
||
if LQuoteChar = ' ' then begin {Do not Localize}
|
||
LExistingBreak := TextIsSame(ABreakStr, Copy(ALine, LPos, LBreakLen));
|
||
if LExistingBreak then begin
|
||
Inc(LPos, LBreakLen-1);
|
||
LBreakPos := LPos;
|
||
end; //if ExistingBreak then
|
||
end // if QuoteChar = ' ' then {Do not Localize}
|
||
end else begin// if CurChar = BreakStr[1] then
|
||
if CharIsInSet(LCurChar, 1, ABreakChars) then begin
|
||
if LQuoteChar = ' ' then begin {Do not Localize}
|
||
LBreakPos := LPos;
|
||
end;
|
||
end else begin // if CurChar in BreakChars then
|
||
if CharIsInSet(LCurChar, 1, QuoteChars) then begin
|
||
if LCurChar = LQuoteChar then begin
|
||
LQuoteChar := ' '; {Do not Localize}
|
||
end else begin
|
||
if LQuoteChar = ' ' then begin {Do not Localize}
|
||
LQuoteChar := LCurChar;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
{$IFDEF STRING_IS_ANSI}
|
||
end;
|
||
{$ENDIF}
|
||
Inc(LPos);
|
||
Inc(LCol);
|
||
if not (CharIsInSet(LQuoteChar, 1, QuoteChars)) and
|
||
(LExistingBreak or
|
||
((LCol > MaxCol) and (LBreakPos > LLinePos))) then begin
|
||
LCol := LPos - LBreakPos;
|
||
Result := Result + Copy(ALine, LLinePos, LBreakPos - LLinePos + 1);
|
||
if not (CharIsInSet(LCurChar, 1, QuoteChars)) then begin
|
||
while (LPos <= LLineLen) and (CharIsInSet(ALine, LPos, ABreakChars + #13+#10)) do begin
|
||
Inc(LPos);
|
||
end;
|
||
if not LExistingBreak and (LPos < LLineLen) then begin
|
||
Result := Result + ABreakStr;
|
||
end;
|
||
end;
|
||
Inc(LBreakPos);
|
||
LLinePos := LBreakPos;
|
||
LExistingBreak := False;
|
||
end; //if not
|
||
end; //while Pos <= LineLen do
|
||
Result := Result + Copy(ALine, LLinePos, MaxInt);
|
||
end;
|
||
|
||
function IndyCurrentYear : Integer;
|
||
{$IFDEF HAS_CurrentYear}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
{$ELSE}
|
||
var
|
||
LYear, LMonth, LDay : Word;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF HAS_CurrentYear}
|
||
Result := CurrentYear;
|
||
{$ELSE}
|
||
DecodeDate(Now, LYear, LMonth, LDay);
|
||
Result := LYear;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function CharRange(const AMin, AMax : Char): String;
|
||
var
|
||
i : Char;
|
||
{$IFDEF STRING_IS_IMMUTABLE}
|
||
LSB : TIdStringBuilder;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF STRING_IS_IMMUTABLE}
|
||
LSB := TIdStringBuilder.Create(Ord(AMax) - Ord(AMin) + 1);
|
||
for i := AMin to AMax do begin
|
||
LSB.Append(i);
|
||
end;
|
||
Result := LSB.ToString;
|
||
{$ELSE}
|
||
SetLength(Result, Ord(AMax) - Ord(AMin) + 1);
|
||
for i := AMin to AMax do begin
|
||
Result[Ord(i) - Ord(AMin) + 1] := i;
|
||
end;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
{$IFDEF WINDOWS}
|
||
var
|
||
ATempPath: TIdFileName;
|
||
{$ENDIF}
|
||
|
||
function StartsWith(const ANSIStr, APattern : String) : Boolean;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := TextStartsWith(ANSIStr, APattern) {do not localize}
|
||
//tentative fix for a problem with Korean indicated by "SungDong Kim" <infi@acrosoft.pe.kr>
|
||
{$IFNDEF DOTNET}
|
||
//note that in DotNET, everything is MBCS
|
||
and (ByteType(ANSIStr, 1) = mbSingleByte)
|
||
{$ENDIF} ;
|
||
//just in case someone is doing a recursive listing and there's a dir with the name total
|
||
end;
|
||
|
||
function UnixDateTimeToDelphiDateTime(UnixDateTime: UInt32): TDateTime;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := (UnixDateTime / 86400) + UnixStartDate;
|
||
{
|
||
From: http://homepages.borland.com/efg2lab/Library/UseNet/1999/0309b.txt
|
||
}
|
||
// Result := EncodeDate(1970, 1, 1) + (UnixDateTime / 86400); {86400=No. of secs. per day}
|
||
end;
|
||
|
||
function DateTimeToUnix(ADateTime: TDateTime): UInt32;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
//example: DateTimeToUnix(now);
|
||
Result := Round((ADateTime - UnixStartDate) * 86400);
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
procedure CopyBytesToHostWord(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt16);
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
CopyBytesToHostUInt16(ASource, ASourceIndex, VDest);
|
||
end;
|
||
|
||
procedure CopyBytesToHostUInt16(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt16);
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
VDest := BytesToUInt16(ASource, ASourceIndex);
|
||
VDest := GStack.NetworkToHost(VDest);
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
procedure CopyBytesToHostLongWord(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt32);
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
CopyBytesToHostUInt32(ASource, ASourceIndex, VDest);
|
||
end;
|
||
|
||
procedure CopyBytesToHostUInt32(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt32);
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
VDest := BytesToUInt32(ASource, ASourceIndex);
|
||
VDest := GStack.NetworkToHost(VDest);
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
procedure CopyTIdNetworkWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
CopyTIdNetworkUInt16(ASource, VDest, ADestIndex);
|
||
end;
|
||
|
||
procedure CopyTIdNetworkUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
CopyTIdUInt16(GStack.HostToNetwork(ASource),VDest,ADestIndex);
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
procedure CopyTIdNetworkLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
CopyTIdNetworkUInt32(ASource, VDest, ADestIndex);
|
||
end;
|
||
|
||
procedure CopyTIdNetworkUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
CopyTIdUInt32(GStack.HostToNetwork(ASource),VDest,ADestIndex);
|
||
end;
|
||
|
||
function UInt32ToFourChar(AValue : UInt32): string;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := BytesToStringRaw(ToBytes(AValue));
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
function LongWordToFourChar(AValue : UInt32): string;
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := UInt32ToFourChar(AValue);
|
||
end;
|
||
|
||
procedure UInt16ToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer);
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
//ByteArray[Index] := AWord div 256;
|
||
//ByteArray[Index + 1] := AWord mod 256;
|
||
ByteArray[Index + 1] := AWord div 256;
|
||
ByteArray[Index] := AWord mod 256;
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
procedure WordToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer);
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
UInt16ToTwoBytes(AWord, ByteArray, Index);
|
||
end;
|
||
|
||
function StrToWord(const Value: String): Word;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
if Length(Value) > 1 then begin
|
||
{$IFDEF STRING_IS_UNICODE}
|
||
Result := TwoCharToUInt16(Value[1], Value[2]);
|
||
{$ELSE}
|
||
Result := PWord(Pointer(Value))^;
|
||
{$ENDIF}
|
||
end else begin
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
function UInt16ToStr(const Value: Word): String;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
{$IFDEF STRING_IS_UNICODE}
|
||
Result := BytesToStringRaw(ToBytes(Value));
|
||
{$ELSE}
|
||
SetLength(Result, SizeOf(Value));
|
||
Move(Value, Result[1], SizeOf(Value));
|
||
{$ENDIF}
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
function WordToStr(const Value: Word): String;
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := UInt16ToStr(Value);
|
||
end;
|
||
|
||
function OrdFourByteToUInt32(AByte1, AByte2, AByte3, AByte4 : Byte): UInt32;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
var
|
||
LValue: TIdBytes;
|
||
begin
|
||
SetLength(LValue, SizeOf(UInt32));
|
||
LValue[0] := AByte1;
|
||
LValue[1] := AByte2;
|
||
LValue[2] := AByte3;
|
||
LValue[3] := AByte4;
|
||
Result := BytesToUInt32(LValue);
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
function OrdFourByteToLongWord(AByte1, AByte2, AByte3, AByte4 : Byte): UInt32;
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := OrdFourByteToUInt32(AByte1, AByte2, AByte3, AByte4);
|
||
end;
|
||
|
||
procedure UInt32ToOrdFourByte(const AValue: UInt32; var VByte1, VByte2, VByte3, VByte4 : Byte);
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
var
|
||
LValue: TIdBytes;
|
||
begin
|
||
LValue := ToBytes(AValue);
|
||
VByte1 := LValue[0];
|
||
VByte2 := LValue[1];
|
||
VByte3 := LValue[2];
|
||
VByte4 := LValue[3];
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
procedure LongWordToOrdFourByte(const AValue: UInt32; var VByte1, VByte2, VByte3, VByte4 : Byte);
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
UInt32ToOrdFourByte(AValue, VByte1, VByte2, VByte3, VByte4);
|
||
end;
|
||
|
||
function TwoCharToUInt16(AChar1, AChar2: Char): UInt16;
|
||
//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, SizeOf(UInt16));
|
||
LWord[0] := Ord(AChar1);
|
||
LWord[1] := Ord(AChar2);
|
||
Result := BytesToUInt16(LWord);
|
||
|
||
// Result := Word((Ord(AChar1) shl 8) and $FF00) or Word(Ord(AChar2) and $00FF);
|
||
end;
|
||
|
||
{$I IdDeprecatedImplBugOff.inc}
|
||
function TwoCharToWord(AChar1, AChar2: Char): Word;
|
||
{$I IdDeprecatedImplBugOn.inc}
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
Result := TwoCharToUInt16(AChar1, AChar2);
|
||
end;
|
||
|
||
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;
|
||
// 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; var VDateTime: TDateTime): Boolean;
|
||
var
|
||
i: Integer;
|
||
Dt, Mo, Yr, Ho, Min, Sec, MSec: Word;
|
||
sYear, sTime, sDelim: string;
|
||
//flags for if AM/PM marker found
|
||
LAM, LPM : Boolean;
|
||
|
||
procedure ParseDayOfMonth;
|
||
begin
|
||
Dt := IndyStrToInt( Fetch(Value, sDelim), 1);
|
||
Value := TrimLeft(Value);
|
||
end;
|
||
|
||
procedure ParseMonth;
|
||
begin
|
||
Mo := StrToMonth( Fetch (Value, sDelim) );
|
||
Value := TrimLeft(Value);
|
||
end;
|
||
|
||
function ParseISO8601: Boolean;
|
||
var
|
||
S: String;
|
||
Len, Offset, Found: Integer;
|
||
begin
|
||
Result := False;
|
||
|
||
// TODO: implement logic from IdVCard.ParseISO8601DateAndOrTime() here and then remove that function
|
||
{
|
||
var
|
||
LDate: TIdISO8601DateComps;
|
||
LTime: TIdISO8601TimeComps;
|
||
begin
|
||
Result := ParseISO8601DateAndOrTime(Value, LDate, LTime);
|
||
if Result then begin
|
||
VDateTime := EncodeDate(LDate.Year, LDate.Month, LDate.Day) + EncodeTime(LTime.Hour, LTime.Min, LTime.Sec, LTime.MSec);
|
||
Value := LTime.UTFOffset;
|
||
end;
|
||
end;
|
||
}
|
||
|
||
S := Value;
|
||
Len := Length(S);
|
||
|
||
if not IsNumeric(S, 4) then begin
|
||
Exit;
|
||
end;
|
||
|
||
// defaults for omitted values
|
||
Dt := 1;
|
||
Mo := 1;
|
||
Ho := 0;
|
||
Min := 0;
|
||
Sec := 0;
|
||
MSec := 0;
|
||
|
||
Yr := IndyStrToInt( Copy(S, 1, 4) );
|
||
Offset := 5;
|
||
|
||
if Offset <= Len then
|
||
begin
|
||
if (not CharEquals(S, Offset, '-')) or (not IsNumeric(S, 2, Offset+1)) then begin
|
||
Exit;
|
||
end;
|
||
Mo := IndyStrToInt( Copy(S, Offset+1, 2) );
|
||
Inc(Offset, 3);
|
||
|
||
if Offset <= Len then
|
||
begin
|
||
if (not CharEquals(S, Offset, '-')) or {Do not Localize}
|
||
(not IsNumeric(S, 2, Offset+1)) then
|
||
begin
|
||
Exit;
|
||
end;
|
||
Dt := IndyStrToInt( Copy(S, Offset+1, 2) );
|
||
Inc(Offset, 3);
|
||
|
||
if Offset <= Len then
|
||
begin
|
||
if (not CharEquals(S, Offset, 'T')) or {Do not Localize}
|
||
(not IsNumeric(S, 2, Offset+1)) or
|
||
(not CharEquals(S, Offset+3, ':')) then {Do not Localize}
|
||
begin
|
||
Exit;
|
||
end;
|
||
Ho := IndyStrToInt( Copy(S, Offset+1, 2) );
|
||
Inc(Offset, 4);
|
||
|
||
if not IsNumeric(S, 2, Offset) then begin
|
||
Exit;
|
||
end;
|
||
Min := IndyStrToInt( Copy(S, Offset, 2) );
|
||
Inc(Offset, 2);
|
||
|
||
if Offset > Len then begin
|
||
Exit;
|
||
end;
|
||
|
||
if CharEquals(S, Offset, ':') then {Do not Localize}
|
||
begin
|
||
if not IsNumeric(S, 2, Offset+1) then begin
|
||
Exit;
|
||
end;
|
||
Sec := IndyStrToInt( Copy(S, Offset+1, 2) );
|
||
Inc(Offset, 3);
|
||
|
||
if Offset > Len then begin
|
||
Exit;
|
||
end;
|
||
|
||
if CharEquals(S, Offset, '.') then {Do not Localize}
|
||
begin
|
||
Found := FindFirstNotOf('0123456789', S, -1, Offset+1); {Do not Localize}
|
||
if Found = 0 then begin
|
||
Exit;
|
||
end;
|
||
MSec := IndyStrToInt( Copy(S, Offset+1, Found-Offset-1) );
|
||
Inc(Offset, Found-Offset+1);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
VDateTime := EncodeDate(Yr, Mo, Dt) + EncodeTime(Ho, Min, Sec, MSec);
|
||
Value := Copy(S, Offset, MaxInt);
|
||
Result := True;
|
||
end;
|
||
|
||
begin
|
||
Result := False;
|
||
VDateTime := 0.0;
|
||
|
||
Value := Trim(Value);
|
||
if Length(Value) = 0 then begin
|
||
Exit;
|
||
end;
|
||
|
||
try
|
||
// RLebeau: have noticed some HTTP servers deliver dates using ISO-8601
|
||
// format even though this is in violation of the HTTP specs!
|
||
if ParseISO8601 then begin
|
||
Result := True;
|
||
Exit;
|
||
end;
|
||
|
||
{Day of Week}
|
||
if StrToDay(Copy(Value, 1, 3)) > 0 then begin
|
||
//workaround in case a space is missing after the initial column
|
||
if CharEquals(Value, 4, ',') and (not CharEquals(Value, 5, ' ')) 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}
|
||
i := IndyPos('-', Value); {Do not Localize}
|
||
if (i > 1) and (i < IndyPos(' ', Value)) then begin {Do not Localize}
|
||
sDelim := '-'; {Do not Localize}
|
||
end else begin
|
||
sDelim := ' '; {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, sDelim, False)) > 0 then begin
|
||
{Month}
|
||
ParseMonth;
|
||
{Day of Month}
|
||
ParseDayOfMonth;
|
||
end else begin
|
||
{Day of Month}
|
||
ParseDayOfMonth;
|
||
{Month}
|
||
ParseMonth;
|
||
end;
|
||
|
||
{Year}
|
||
// There is some strange date/time formats like
|
||
// DayOfWeek Month DayOfMonth Time Year
|
||
sYear := Fetch(Value);
|
||
Yr := IndyStrToInt(sYear, High(Word));
|
||
if Yr = High(Word) then begin // Is sTime valid Integer?
|
||
sTime := sYear;
|
||
sYear := Fetch(Value);
|
||
Value := TrimRight(sTime + ' ' + Value);
|
||
Yr := IndyStrToInt(sYear);
|
||
end;
|
||
|
||
// RLebeau: According to RFC 2822, Section 4.3:
|
||
//
|
||
// "Where a two or three digit year occurs in a date, the year is to be
|
||
// interpreted as follows: If a two digit year is encountered whose
|
||
// value is between 00 and 49, the year is interpreted by adding 2000,
|
||
// ending up with a value between 2000 and 2049. If a two digit year is
|
||
// encountered with a value between 50 and 99, or any three digit year
|
||
// is encountered, the year is interpreted by adding 1900."
|
||
if Length(sYear) = 2 then begin
|
||
if {(Yr >= 0) and} (Yr <= 49) then begin
|
||
Inc(Yr, 2000);
|
||
end
|
||
else if (Yr >= 50) and (Yr <= 99) then begin
|
||
Inc(Yr, 1900);
|
||
end;
|
||
end
|
||
else if Length(sYear) = 3 then begin
|
||
Inc(Yr, 1900);
|
||
end;
|
||
|
||
VDateTime := EncodeDate(Yr, Mo, Dt);
|
||
|
||
// SG 26/9/00: Changed so that ANY time format is accepted
|
||
if IndyPos('AM', Value) > 0 then begin{do not localize}
|
||
LAM := True;
|
||
LPM := False;
|
||
Value := Fetch(Value, 'AM'); {do not localize}
|
||
end
|
||
else if IndyPos('PM', Value) > 0 then begin {do not localize}
|
||
LAM := False;
|
||
LPM := True;
|
||
Value := Fetch(Value, 'PM'); {do not localize}
|
||
end else begin
|
||
LAM := False;
|
||
LPM := False;
|
||
end;
|
||
|
||
// RLebeau 03/04/2009: some countries use dot instead of colon
|
||
// for the time separator
|
||
i := IndyPos('.', Value); {do not localize}
|
||
if (i > 0) and (i < IndyPos(' ', Value)) then begin {do not localize}
|
||
sDelim := '.'; {do not localize}
|
||
end else begin
|
||
sDelim := ':'; {do not localize}
|
||
end;
|
||
i := IndyPos(sDelim, Value);
|
||
if i > 0 then begin
|
||
// Copy time string up until next space (before GMT offset)
|
||
sTime := Fetch(Value, ' '); {do not localize}
|
||
{Hour}
|
||
Ho := IndyStrToInt( Fetch(sTime, sDelim), 0);
|
||
{Minute}
|
||
Min := IndyStrToInt( Fetch(sTime, sDelim), 0);
|
||
{Second}
|
||
Sec := IndyStrToInt( Fetch(sTime), 0);
|
||
MSec := 0; // TODO
|
||
{AM/PM part if present}
|
||
Value := TrimLeft(Value);
|
||
if LAM then begin
|
||
if Ho = 12 then begin
|
||
Ho := 0;
|
||
end;
|
||
end
|
||
else 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 pretty accurate
|
||
if Ho < 12 then begin
|
||
Inc(Ho, 12);
|
||
end;
|
||
end;
|
||
{The date and time stamp returned}
|
||
VDateTime := VDateTime + EncodeTime(Ho, Min, Sec, MSec);
|
||
end;
|
||
Value := TrimLeft(Value);
|
||
Result := True;
|
||
except
|
||
VDateTime := 0.0;
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
{This should never be localized}
|
||
|
||
function StrInternetToDateTime(Value: string): TDateTime;
|
||
begin
|
||
RawStrInternetToDateTime(Value, Result);
|
||
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 := IndyStrToInt( Copy( LBuffer,1,4),0);
|
||
LMonth := IndyStrToInt(Copy(LBuffer,5,2),0);
|
||
LDay := IndyStrToInt(Copy(LBuffer,7,2),0);
|
||
|
||
LHour := IndyStrToInt(Copy(LBuffer,9,2),0);
|
||
LMin := IndyStrToInt(Copy(LBuffer,11,2),0);
|
||
LSec := IndyStrToInt(Copy(LBuffer,13,2),0);
|
||
Fetch(LBuffer,'.');
|
||
LMSec := IndyStrToInt(LBuffer,0);
|
||
Result := EncodeDate(LYear,LMonth,LDay);
|
||
Result := Result + EncodeTime(LHour,LMin,LSec,LMSec);
|
||
end;
|
||
end;
|
||
|
||
function FTPMLSToLocalDateTime(const ATimeStamp : String):TDateTime;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := 0.0;
|
||
if ATimeStamp <> '' then begin
|
||
Result := FTPMLSToGMTDateTime(ATimeStamp);
|
||
// Apply local offset
|
||
Result := Result + OffsetFromUTC;
|
||
end;
|
||
end;
|
||
|
||
function FTPGMTDateTimeToMLS(const ATimeStamp : TDateTime; const AIncludeMSecs : Boolean=True): String;
|
||
var
|
||
LYear, LMonth, LDay,
|
||
LHour, LMin, LSec, LMSec : Word;
|
||
begin
|
||
DecodeDate(ATimeStamp,LYear,LMonth,LDay);
|
||
DecodeTime(ATimeStamp,LHour,LMin,LSec,LMSec);
|
||
Result := IndyFormat('%4d%2d%2d%2d%2d%2d',[LYear,LMonth,LDay,LHour,LMin,LSec]);
|
||
if AIncludeMSecs then begin
|
||
if (LMSec <> 0) then begin
|
||
Result := Result + IndyFormat('.%3d',[LMSec]);
|
||
end;
|
||
end;
|
||
Result := ReplaceAll(Result, ' ', '0');
|
||
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; const AIncludeMSecs : Boolean=True): String;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := FTPGMTDateTimeToMLS(ATimeStamp - OffsetFromUTC, AIncludeMSecs);
|
||
end;
|
||
|
||
|
||
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);
|
||
Break;
|
||
end;
|
||
StringList.Add(Copy(BaseString, 1, EndOfCurrentString - 1));
|
||
Delete(BaseString, 1, EndOfCurrentString + Length(BreakString) - 1); //Copy(BaseString, EndOfCurrentString + length(BreakString), length(BaseString) - EndOfCurrentString);
|
||
until False;
|
||
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 begin {do not localize}
|
||
Inc(iQuote);
|
||
end;
|
||
if Value[iPos] = ',' then begin {do not localize}
|
||
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;
|
||
|
||
{$UNDEF NATIVEFILEAPI}
|
||
{$UNDEF NATIVECOPYAPI}
|
||
{$IFDEF DOTNET}
|
||
{$DEFINE NATIVEFILEAPI}
|
||
{$DEFINE NATIVECOPYAPI}
|
||
{$ENDIF}
|
||
{$IFDEF WINDOWS}
|
||
{$DEFINE NATIVEFILEAPI}
|
||
{$DEFINE NATIVECOPYAPI}
|
||
{$ENDIF}
|
||
{$IFDEF UNIX}
|
||
{$DEFINE NATIVEFILEAPI}
|
||
{$ENDIF}
|
||
|
||
function CopyFileTo(const Source, Destination: TIdFileName): Boolean;
|
||
{$IFDEF NATIVECOPYAPI}
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
{$IFDEF WIN32_OR_WIN64}
|
||
var
|
||
LOldErrorMode : Integer;
|
||
{$ENDIF}
|
||
{$ELSE}
|
||
var
|
||
SourceF, DestF : File;
|
||
NumRead, NumWritten: Integer;
|
||
Buffer: array[1..2048] of Byte;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF DOTNET}
|
||
try
|
||
System.IO.File.Copy(Source, Destination, True);
|
||
Result := True; // or you'll get an exception
|
||
except
|
||
Result := False;
|
||
end;
|
||
{$ENDIF}
|
||
{$IFDEF WINDOWS}
|
||
{$IFDEF WIN32_OR_WIN64}
|
||
LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
|
||
try
|
||
{$ENDIF}
|
||
Result := CopyFile(PIdFileNameChar(Source), PIdFileNameChar(Destination), False);
|
||
{$IFDEF WIN32_OR_WIN64}
|
||
finally
|
||
SetErrorMode(LOldErrorMode);
|
||
end;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFNDEF NATIVECOPYAPI}
|
||
//mostly from http://delphi.about.com/od/fileio/a/untypedfiles.htm
|
||
|
||
//note that I do use the I+ and I- directive.
|
||
// decided not to use streams because some may not handle more than
|
||
// 2GB'sand it would run counter to the intent of this, return false
|
||
//on failure.
|
||
|
||
//This is intended to be generic because it may run in many different
|
||
//Operating systems
|
||
|
||
// -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))
|
||
|
||
{$IFOPT I+} // detect IO checking
|
||
{$DEFINE _IPlusWasEnabled}
|
||
{$I-}
|
||
{$ENDIF}
|
||
|
||
Assign(SourceF, Source);
|
||
Reset(SourceF, 1);
|
||
Result := IOResult = 0;
|
||
if not Result then begin
|
||
Exit;
|
||
end;
|
||
Assign(DestF, Destination);
|
||
Rewrite(DestF, 1);
|
||
Result := IOResult = 0;
|
||
if Result then begin
|
||
repeat
|
||
BlockRead(SourceF, Buffer, SizeOf(Buffer), NumRead);
|
||
Result := IOResult = 0;
|
||
if (not Result) or (NumRead = 0) then begin
|
||
Break;
|
||
end;
|
||
BlockWrite(DestF, Buffer, NumRead, NumWritten);
|
||
Result := (IOResult = 0) and (NumWritten = NumRead);
|
||
until not Result;
|
||
Close(DestF);
|
||
end;
|
||
Close(SourceF);
|
||
|
||
// Restore IO checking
|
||
{$IFDEF _IPlusWasEnabled} // detect previous setting
|
||
{$UNDEF _IPlusWasEnabled}
|
||
{$I+}
|
||
{$ENDIF}
|
||
|
||
{$ENDIF}
|
||
end;
|
||
|
||
{$IFDEF WINDOWS}
|
||
function TempPath: TIdFileName;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
SetLength(Result, MAX_PATH);
|
||
i := GetTempPath(MAX_PATH, PIdFileNameChar(Result));
|
||
if i > 0 then begin
|
||
SetLength(Result, i);
|
||
Result := IndyIncludeTrailingPathDelimiter(Result);
|
||
end else begin
|
||
Result := '';
|
||
end;
|
||
end;
|
||
{$ENDIF}
|
||
|
||
function MakeTempFilename(const APath: TIdFileName = ''): TIdFileName;
|
||
var
|
||
lPath: TIdFileName;
|
||
lExt: TIdFileName;
|
||
begin
|
||
lPath := APath;
|
||
|
||
{$IFDEF UNIX}
|
||
lExt := '';
|
||
{$ELSE}
|
||
lExt := '.tmp';
|
||
{$ENDIF}
|
||
|
||
{$IFDEF WINDOWS}
|
||
if lPath = '' then begin
|
||
lPath := ATempPath;
|
||
end;
|
||
{$ELSE}
|
||
{$IFDEF DOTNET}
|
||
if lPath = '' then begin
|
||
lPath := System.IO.Path.GetTempPath;
|
||
end;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
|
||
Result := GetUniqueFilename(lPath, 'Indy', lExt);
|
||
end;
|
||
|
||
|
||
function GetUniqueFileName(const APath, APrefix, AExt : String) : String;
|
||
var
|
||
{$IFDEF FPC}
|
||
LPrefix: string;
|
||
{$ELSE}
|
||
LNamePart : TIdTicks;
|
||
LFQE : String;
|
||
LFName: String;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF FPC}
|
||
|
||
//Do not use Tempnam in Unix-like Operating systems. That function is dangerous
|
||
//and you will be warned about it when compiling. FreePascal has GetTempFileName. Use
|
||
//that instead.
|
||
LPrefix := APrefix;
|
||
if LPrefix = '' then begin
|
||
LPrefix := 'Indy'; {Do not localize}
|
||
end;
|
||
Result := GetTempFileName(APath, LPrefix);
|
||
|
||
{$ELSE}
|
||
|
||
// TODO: Use Winapi.GetTempFileName() in Windows...
|
||
|
||
LFQE := AExt;
|
||
|
||
// period is optional in the extension... force it
|
||
if LFQE <> '' then begin
|
||
if LFQE[1] <> '.' then begin
|
||
LFQE := '.' + LFQE;
|
||
end;
|
||
end;
|
||
|
||
// validate path and add path delimiter before file name prefix
|
||
if APath <> '' then begin
|
||
if not IndyDirectoryExists(APath) then begin
|
||
// TODO: fail with an error instead...
|
||
LFName := APrefix;
|
||
end else begin
|
||
// uses the Indy function... not the Borland one
|
||
LFName := IndyIncludeTrailingPathDelimiter(APath) + APrefix;
|
||
end;
|
||
end else begin
|
||
// TODO: without a starting path, we cannot check for file existance, so fail...
|
||
LFName := APrefix;
|
||
end;
|
||
|
||
LNamePart := Ticks64;
|
||
repeat
|
||
Result := LFName + IntToHex(LNamePart, 8) + LFQE;
|
||
if not FileExists(Result) then begin
|
||
Break;
|
||
end;
|
||
Inc(LNamePart);
|
||
until False;
|
||
|
||
{$ENDIF}
|
||
end;
|
||
|
||
// Find a token given a direction (>= 0 from start; < 0 from end)
|
||
// S.G. 19/4/00:
|
||
// Changed to be more readable
|
||
function RPos(const ASub, AIn: String; AStart: Integer = -1): Integer;
|
||
var
|
||
i: Integer;
|
||
LStartPos: Integer;
|
||
LTokenLen: Integer;
|
||
begin
|
||
Result := 0;
|
||
LTokenLen := Length(ASub);
|
||
// Get starting position
|
||
if AStart < 0 then begin
|
||
AStart := Length(AIn);
|
||
end;
|
||
if AStart < (Length(AIn) - LTokenLen + 1) then begin
|
||
LStartPos := AStart;
|
||
end else begin
|
||
LStartPos := (Length(AIn) - LTokenLen + 1);
|
||
end;
|
||
// Search for the string
|
||
for i := LStartPos downto 1 do begin
|
||
if TextIsSame(Copy(AIn, i, LTokenLen), ASub) then begin
|
||
Result := i;
|
||
Break;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{$IFDEF WINDOWS}
|
||
function IsVolume(const APathName : TIdFileName) : Boolean;
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
Result := TextEndsWith(APathName, ':') or TextEndsWith(APathName, ':\');
|
||
end;
|
||
{$ENDIF}
|
||
|
||
// OS-independant version
|
||
function FileSizeByName(const AFilename: TIdFileName): Int64;
|
||
//Leave in for HTTP Server
|
||
{$IFDEF DOTNET}
|
||
var
|
||
LFile : System.IO.FileInfo;
|
||
{$ELSE}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
{$IFDEF WINDOWS}
|
||
var
|
||
LHandle : THandle;
|
||
LRec : TWin32FindData;
|
||
{$IFDEF WIN32_OR_WIN64}
|
||
LOldErrorMode : Integer;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF UNIX}
|
||
var
|
||
{$IFDEF USE_VCL_POSIX}
|
||
LRec : _Stat;
|
||
{$IFDEF USE_MARSHALLED_PTRS}
|
||
M: TMarshaller;
|
||
{$ENDIF}
|
||
{$ELSE}
|
||
{$IFDEF KYLIXCOMPAT}
|
||
LRec : TStatBuf;
|
||
{$ELSE}
|
||
LRec : TStat;
|
||
LU : time_t;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFNDEF NATIVEFILEAPI}
|
||
var
|
||
LStream: TIdReadFileExclusiveStream;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF DOTNET}
|
||
Result := -1;
|
||
LFile := System.IO.FileInfo.Create(AFileName);
|
||
if LFile.Exists then begin
|
||
Result := LFile.Length;
|
||
end;
|
||
{$ENDIF}
|
||
{$IFDEF WINDOWS}
|
||
Result := -1;
|
||
//check to see if something like "a:\" is specified and fail in that case.
|
||
//FindFirstFile would probably succede even though a drive is not a proper
|
||
//file.
|
||
if not IsVolume(AFileName) then begin
|
||
{
|
||
IMPORTANT!!!
|
||
|
||
For servers in Windows, you probably want the API call to fail rather than
|
||
get a "Cancel Try Again Continue " dialog-box box if a drive is not
|
||
ready or there's some other critical I/O error.
|
||
}
|
||
{$IFDEF WIN32_OR_WIN64}
|
||
LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
|
||
try
|
||
{$ENDIF}
|
||
LHandle := Windows.FindFirstFile(PIdFileNameChar(AFileName), LRec);
|
||
if LHandle <> INVALID_HANDLE_VALUE then begin
|
||
Windows.FindClose(LHandle);
|
||
if (LRec.dwFileAttributes and Windows.FILE_ATTRIBUTE_DIRECTORY) = 0 then begin
|
||
Result := (Int64(LRec.nFileSizeHigh) shl 32) + LRec.nFileSizeLow;
|
||
end;
|
||
end;
|
||
{$IFDEF WIN32_OR_WIN64}
|
||
finally
|
||
SetErrorMode(LOldErrorMode);
|
||
end;
|
||
{$ENDIF}
|
||
end;
|
||
{$ENDIF}
|
||
{$IFDEF UNIX}
|
||
Result := -1;
|
||
{$IFDEF USE_VCL_POSIX}
|
||
//This is messy with IFDEF's but I want to be able to handle 63 bit file sizes.
|
||
if stat(
|
||
{$IFDEF USE_MARSHALLED_PTRS}
|
||
M.AsAnsi(AFileName).ToPointer
|
||
{$ELSE}
|
||
PAnsiChar(
|
||
{$IFDEF STRING_IS_ANSI}
|
||
AFileName
|
||
{$ELSE}
|
||
AnsiString(AFileName) // explicit convert to Ansi
|
||
{$ENDIF}
|
||
)
|
||
{$ENDIF}
|
||
, LRec) = 0 then
|
||
begin
|
||
Result := LRec.st_size;
|
||
end;
|
||
{$ELSE}
|
||
//Note that we can use stat here because we are only looking at the date.
|
||
if {$IFDEF KYLIXCOMPAT}stat{$ELSE}fpstat{$ENDIF}(
|
||
PAnsiChar(
|
||
{$IFDEF STRING_IS_ANSI}
|
||
AFileName
|
||
{$ELSE}
|
||
AnsiString(AFileName) // explicit convert to Ansi
|
||
{$ENDIF}
|
||
), LRec) = 0 then
|
||
begin
|
||
Result := LRec.st_Size;
|
||
end;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFNDEF NATIVEFILEAPI}
|
||
Result := -1;
|
||
if FileExists(AFilename) then begin
|
||
// the other cases simply return -1 on error, so make sure to do the same here
|
||
try
|
||
// TODO: maybe use TIdReadFileNonExclusiveStream instead?
|
||
LStream := TIdReadFileExclusiveStream.Create(AFilename);
|
||
try
|
||
Result := LStream.Size;
|
||
finally
|
||
LStream.Free;
|
||
end;
|
||
except
|
||
end;
|
||
end;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function GetGMTDateByName(const AFileName : TIdFileName) : TDateTime;
|
||
{$IFDEF WINDOWS}
|
||
var
|
||
LRec : TWin32FindData;
|
||
LHandle : THandle;
|
||
LTime : {$IFDEF WINCE}TSystemTime{$ELSE}Integer{$ENDIF};
|
||
{$IFDEF WIN32_OR_WIN64}
|
||
LOldErrorMode : Integer;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF UNIX}
|
||
var
|
||
LTime : Integer;
|
||
{$IFDEF USE_VCL_POSIX}
|
||
LRec : _Stat;
|
||
{$IFDEF USE_MARSHALLED_PTRS}
|
||
M: TMarshaller;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF KYLIXCOMPAT}
|
||
LRec : TStatBuf;
|
||
LU : TUnixTime;
|
||
{$ENDIF}
|
||
{$IFDEF USE_BASEUNIX}
|
||
LRec : TStat;
|
||
LU : time_t;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
begin
|
||
Result := -1;
|
||
{$IFDEF WINDOWS}
|
||
if not IsVolume(AFileName) then begin
|
||
{$IFDEF WIN32_OR_WIN64}
|
||
LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
|
||
try
|
||
{$ENDIF}
|
||
LHandle := Windows.FindFirstFile(PIdFileNameChar(AFileName), LRec);
|
||
{$IFDEF WIN32_OR_WIN64}
|
||
finally
|
||
SetErrorMode(LOldErrorMode);
|
||
end;
|
||
{$ENDIF}
|
||
if LHandle <> INVALID_HANDLE_VALUE then begin
|
||
Windows.FindClose(LHandle);
|
||
{$IFDEF WINCE}
|
||
FileTimeToSystemTime(@LRec, @LTime);
|
||
Result := SystemTimeToDateTime(LTime);
|
||
{$ELSE}
|
||
FileTimeToDosDateTime(LRec.ftLastWriteTime, LongRec(LTime).Hi, LongRec(LTime).Lo);
|
||
Result := FileDateToDateTime(LTime);
|
||
{$ENDIF}
|
||
end;
|
||
end;
|
||
{$ENDIF}
|
||
{$IFDEF DOTNET}
|
||
if System.IO.File.Exists(AFileName) then begin
|
||
Result := System.IO.File.GetLastWriteTimeUtc(AFileName).ToOADate;
|
||
end;
|
||
{$ENDIF}
|
||
{$IFDEF UNIX}
|
||
//Note that we can use stat here because we are only looking at the date.
|
||
{$IFDEF USE_BASEUNIX}
|
||
if fpstat(PAnsiChar(AnsiString(AFileName)), LRec) = 0 then
|
||
{$ENDIF}
|
||
{$IFDEF KYLIXCOMPAT}
|
||
if stat(PAnsiChar(AnsiString(AFileName)), LRec) = 0 then
|
||
{$ENDIF}
|
||
{$IFDEF USE_VCL_POSIX}
|
||
if stat(
|
||
{$IFDEF USE_MARSHALLED_PTRS}
|
||
M.AsAnsi(AFileName).ToPointer
|
||
{$ELSE}
|
||
PAnsiChar(
|
||
{$IFDEF STRING_IS_ANSI}
|
||
AFileName
|
||
{$ELSE}
|
||
AnsiString(AFileName) // explicit convert to Ansi
|
||
{$ENDIF}
|
||
)
|
||
{$ENDIF}
|
||
, LRec) = 0 then
|
||
{$ENDIF}
|
||
begin
|
||
LTime := LRec.st_mtime;
|
||
{$IFDEF KYLIXCOMPAT}
|
||
gmtime_r(@LTime, LU);
|
||
Result := EncodeDate(LU.tm_year + 1900, LU.tm_mon + 1, LU.tm_mday) +
|
||
EncodeTime(LU.tm_hour, LU.tm_min, LU.tm_sec, 0);
|
||
{$ENDIF}
|
||
{$IFDEF USE_BASEUNIX}
|
||
Result := UnixToDateTime(LTime);
|
||
{$ENDIF}
|
||
{$IFDEF USE_VCL_POSIX}
|
||
Result := DateUtils.UnixToDateTime(LTime);
|
||
{$ENDIF}
|
||
end;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function RightStr(const AStr: String; const Len: Integer): String;
|
||
var
|
||
LStrLen : Integer;
|
||
begin
|
||
LStrLen := Length(AStr);
|
||
if (Len > LStrLen) or (Len < 0) then begin
|
||
Result := AStr;
|
||
end else begin
|
||
//+1 is necessary for the Index because it is one based
|
||
Result := Copy(AStr, LStrLen - Len+1, Len);
|
||
end;
|
||
end;
|
||
|
||
function TimeZoneBias: TDateTime;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
{$IFNDEF FPC}
|
||
{$IFDEF UNIX}
|
||
var
|
||
T: Time_T;
|
||
TV: TimeVal;
|
||
{$IFDEF USE_VCL_POSIX}
|
||
UT: tm;
|
||
{$ELSE}
|
||
UT: TUnixTime;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
begin
|
||
{$IFNDEF FPC}
|
||
{$IFDEF UNIX}
|
||
// TODO: use -OffsetFromUTC here. It has this same Unix logic in it
|
||
{from http://edn.embarcadero.com/article/27890 }
|
||
gettimeofday(TV, nil);
|
||
T := TV.tv_sec;
|
||
{$IFDEF USE_VCL_POSIX}
|
||
localtime_r(T, UT);
|
||
// __tm_gmtoff is the bias in seconds from the UTC to the current time.
|
||
// so I multiply by -1 to compensate for this.
|
||
Result := (UT.tm_gmtoff / 60 / 60 / 24);
|
||
{$ELSE}
|
||
localtime_r(@T, UT);
|
||
// __tm_gmtoff is the bias in seconds from the UTC to the current time.
|
||
// so I multiply by -1 to compensate for this.
|
||
Result := (UT.__tm_gmtoff / 60 / 60 / 24);
|
||
{$ENDIF}
|
||
{$ELSE}
|
||
Result := -OffsetFromUTC;
|
||
{$ENDIF}
|
||
{$ELSE}
|
||
Result := -OffsetFromUTC;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function IndyStrToBool(const AString : String) : Boolean;
|
||
begin
|
||
// First check against each of the elements of the FalseBoolStrs
|
||
if PosInStrArray(AString, IndyFalseBoolStrs, False) <> -1 then begin
|
||
Result := False;
|
||
Exit;
|
||
end;
|
||
// Second check against each of the elements of the TrueBoolStrs
|
||
if PosInStrArray(AString, IndyTrueBoolStrs, False) <> -1 then begin
|
||
Result := True;
|
||
Exit;
|
||
end;
|
||
// None of the strings match, so convert to numeric (allowing an
|
||
// EConvertException to be thrown if not) and test against zero.
|
||
// If zero, return false, otherwise return true.
|
||
Result := IndyStrToInt(AString) <> 0;
|
||
end;
|
||
|
||
function IndySetLocalTime(Value: TDateTime): Boolean;
|
||
{$IFNDEF WINDOWS}
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
{$ELSE}
|
||
var
|
||
dSysTime: TSystemTime;
|
||
buffer: DWord;
|
||
tkp, tpko: TTokenPrivileges;
|
||
hToken: THandle;
|
||
{$ENDIF}
|
||
begin
|
||
Result := False;
|
||
|
||
{$IFDEF LINUX}
|
||
//TODO: Implement SetTime for Linux. This call is not critical.
|
||
{$ENDIF}
|
||
|
||
{$IFDEF DOTNET}
|
||
//TODO: Figure out how to do this
|
||
{$ENDIF}
|
||
|
||
{$IFDEF WINDOWS}
|
||
{I admit that this routine is a little more complicated than the one
|
||
in Indy 8.0. However, this routine does support Windows NT privileges
|
||
meaning it will work if you have administrative rights under that OS
|
||
|
||
Original author Kerry G. Neighbour with modifications and testing
|
||
from J. Peter Mugaas}
|
||
{$IFNDEF WINCE}
|
||
// RLebeau 2/1/2008: MSDN says that SetLocalTime() does the adjustment
|
||
// automatically, so why is it being done manually?
|
||
if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
|
||
if not Windows.OpenProcessToken(Windows.GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin
|
||
Exit;
|
||
end;
|
||
if not Windows.LookupPrivilegeValue(nil, 'SeSystemtimePrivilege', tkp.Privileges[0].Luid) then begin {Do not Localize}
|
||
Windows.CloseHandle(hToken);
|
||
Exit;
|
||
end;
|
||
tkp.PrivilegeCount := 1;
|
||
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
|
||
if not Windows.AdjustTokenPrivileges(hToken, FALSE, tkp, SizeOf(tkp), tpko, buffer) then begin
|
||
Windows.CloseHandle(hToken);
|
||
Exit;
|
||
end;
|
||
end;
|
||
{$ENDIF}
|
||
|
||
DateTimeToSystemTime(Value, dSysTime);
|
||
Result := Windows.SetLocalTime({$IFDEF FPC}@{$ENDIF}dSysTime);
|
||
|
||
{$IFNDEF WINCE}
|
||
if Result then begin
|
||
// RLebeau 2/1/2008: According to MSDN:
|
||
//
|
||
// "The system uses UTC internally. Therefore, when you call SetLocalTime(),
|
||
// the system uses the current time zone information to perform the conversion,
|
||
// including the daylight saving time setting. Note that the system uses the
|
||
// daylight saving time setting of the current time, not the new time you are
|
||
// setting. Therefore, to ensure the correct result, call SetLocalTime() a
|
||
// second time, now that the first call has updated the daylight saving time
|
||
// setting."
|
||
//
|
||
// TODO: adjust the Time manually so only 1 call to SetLocalTime() is needed...
|
||
|
||
if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
|
||
Windows.SetLocalTime({$IFDEF FPC}@{$ENDIF}dSysTime);
|
||
// Windows 2000+ will broadcast WM_TIMECHANGE automatically...
|
||
if not IndyCheckWindowsVersion(5) then begin // Windows 2000 = v5.0
|
||
SendMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
|
||
end;
|
||
end else begin
|
||
SendMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
|
||
end;
|
||
end;
|
||
|
||
{Undo the Process Privilege change we had done for the
|
||
set time and close the handle that was allocated}
|
||
if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
|
||
Windows.AdjustTokenPrivileges(hToken, False, tpko, SizeOf(tpko), tkp, Buffer);
|
||
Windows.CloseHandle(hToken);
|
||
end;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function StrToDay(const ADay: string): Byte;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
// RLebeau 03/04/2009: TODO - support localized strings as well...
|
||
Result := Succ(
|
||
PosInStrArray(ADay,
|
||
['SUN','MON','TUE','WED','THU','FRI','SAT'], {do not localize}
|
||
False));
|
||
end;
|
||
|
||
function StrToMonth(const AMonth: string): Byte;
|
||
const
|
||
// RLebeau 1/7/09: using Char() for #128-#255 because in D2009, the compiler
|
||
// may change characters >= #128 from their Ansi codepage value to their true
|
||
// Unicode codepoint value, depending on the codepage used for the source code.
|
||
// For instance, #128 may become #$20AC...
|
||
Months: array[0..7] of array[1..12] of string = (
|
||
|
||
// English
|
||
('JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'),
|
||
|
||
// English - alt. 4 letter abbreviations (Netware Print Services may return a 4 char month such as Sept)
|
||
('', '', '', '', '', 'JUNE','JULY', '', 'SEPT', '', '', ''),
|
||
|
||
// German
|
||
('', '', 'MRZ', '', 'MAI', '', '', '', '', 'OKT', '', 'DEZ'),
|
||
|
||
// Spanish
|
||
('ENO', 'FBRO','MZO', 'AB', '', '', '', 'AGTO','SBRE','OBRE','NBRE','DBRE'),
|
||
|
||
// Dutch
|
||
('', '', 'MRT', '', 'MEI', '', '', '', '', 'OKT', '', ''),
|
||
|
||
// French
|
||
('JANV','F'+Char($C9)+'V', 'MARS','AVR', 'MAI', 'JUIN','JUIL','AO'+Char($DB), 'SEPT','', '', 'D'+Char($C9)+'C'),
|
||
|
||
// French (alt)
|
||
('', 'F'+Char($C9)+'VR','', '', '', '', 'JUI', 'AO'+Char($DB)+'T','', '', '', ''),
|
||
|
||
// Slovenian
|
||
('', '', '', '', 'MAJ', '', '', '', 'AVG', '', '', ''));
|
||
var
|
||
i: Integer;
|
||
begin
|
||
if AMonth <> '' then begin
|
||
for i := Low(Months) to High(Months) do begin
|
||
for Result := Low(Months[i]) to High(Months[i]) do begin
|
||
if TextIsSame(AMonth, Months[i][Result]) then begin
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
Result := 0;
|
||
end;
|
||
|
||
function UpCaseFirst(const AStr: string): string;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
{$IFDEF STRING_IS_IMMUTABLE}
|
||
var
|
||
LSB: TIdStringBuilder;
|
||
{$ENDIF}
|
||
begin
|
||
// TODO: support Unicode surrogates in the first position?
|
||
{$IFDEF STRING_IS_IMMUTABLE}
|
||
LSB := TIdStringBuilder.Create(LowerCase(TrimLeft(AStr)));
|
||
if LSB.Length > 0 then begin {Do not Localize}
|
||
LSB[0] := UpCase(LSB[0]);
|
||
end;
|
||
Result := LSB.ToString;
|
||
{$ELSE}
|
||
Result := LowerCase(TrimLeft(AStr));
|
||
if Result <> '' then begin {Do not Localize}
|
||
Result[1] := UpCase(Result[1]);
|
||
end;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function UpCaseFirstWord(const AStr: string): string;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
for I := 1 to Length(AStr) do begin
|
||
if CharIsInSet(AStr, I, LWS) then begin
|
||
if I > 1 then begin
|
||
Result := UpperCase(Copy(AStr, 1, I-1)) + Copy(AStr, I, MaxInt);
|
||
Exit;
|
||
end;
|
||
Break;
|
||
end;
|
||
end;
|
||
Result := UpperCase(AStr);
|
||
end;
|
||
|
||
function IsHex(const AChar : Char) : Boolean;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := IndyPos(UpperCase(AChar), HexNumbers) > 0;
|
||
end;
|
||
|
||
function IsBinary(const AChar : Char) : Boolean;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := IndyPos(UpperCase(AChar), BinNumbers) > 0;
|
||
end;
|
||
|
||
function BinStrToInt(const ABinary: String): Integer;
|
||
var
|
||
I: Integer;
|
||
//From: http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20622755.html
|
||
begin
|
||
Result := 0;
|
||
for I := 1 to Length(ABinary) do begin
|
||
Result := Result shl 1 or (Byte(ABinary[I]) and 1);
|
||
end;
|
||
end;
|
||
|
||
function ABNFToText(const AText : String) : String;
|
||
type
|
||
TIdRuleMode = (data, rule, decimal, hex, binary);
|
||
var
|
||
i : Integer;
|
||
LR : TIdRuleMode;
|
||
LNum : String;
|
||
begin
|
||
LR := data;
|
||
Result := '';
|
||
for i := 1 to Length(AText) do begin
|
||
case LR of
|
||
data :
|
||
if (AText[i] = '%') and (i < Length(AText)) then begin
|
||
LR := rule;
|
||
end else begin
|
||
Result := Result + AText[i];
|
||
end;
|
||
rule :
|
||
case AText[i] of
|
||
'd','D' : LR := decimal;
|
||
'x','X' : LR := hex;
|
||
'b','B' : LR := binary;
|
||
else
|
||
begin
|
||
LR := data;
|
||
Result := Result + '%';
|
||
end;
|
||
end;
|
||
decimal :
|
||
If IsNumeric(AText[i]) then begin
|
||
LNum := LNum + AText[i];
|
||
if IndyStrToInt(LNum, 0) > $FF then begin
|
||
IdDelete(LNum,Length(LNum),1);
|
||
Result := Result + Char(IndyStrToInt(LNum, 0));
|
||
LR := Data;
|
||
Result := Result + AText[i];
|
||
end;
|
||
end else begin
|
||
Result := Result + Char(IndyStrToInt(LNum, 0));
|
||
LNum := '';
|
||
if AText[i] <> '.' then begin
|
||
LR := Data;
|
||
Result := Result + AText[i];
|
||
end;
|
||
end;
|
||
hex :
|
||
If IsHex(AText[i]) and (Length(LNum) < 2) then begin
|
||
LNum := LNum + AText[i];
|
||
if IndyStrToInt('$'+LNum, 0) > $FF then begin
|
||
IdDelete(LNum,Length(LNum),1);
|
||
Result := Result + Char(IndyStrToInt(LNum,0));
|
||
LR := Data;
|
||
Result := Result + AText[i];
|
||
end;
|
||
end else begin
|
||
Result := Result + Char(IndyStrToInt('$'+LNum, 0));
|
||
LNum := '';
|
||
if AText[i] <> '.' then begin
|
||
LR := Data;
|
||
Result := Result + AText[i];
|
||
end;
|
||
end;
|
||
binary :
|
||
If IsBinary(AText[i]) and (Length(LNum)<8) then begin
|
||
LNum := LNum + AText[i];
|
||
if (BinStrToInt(LNum)>$FF) then begin
|
||
IdDelete(LNum,Length(LNum),1);
|
||
Result := Result + Char(BinStrToInt(LNum));
|
||
LR := Data;
|
||
Result := Result + AText[i];
|
||
end;
|
||
end else begin
|
||
Result := Result + Char(IndyStrToInt('$'+LNum, 0));
|
||
LNum := '';
|
||
if AText[i] <> '.' then begin
|
||
LR := Data;
|
||
Result := Result + AText[i];
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function GetMIMETypeFromFile(const AFile: TIdFileName): string;
|
||
var
|
||
MIMEMap: TIdMIMETable;
|
||
begin
|
||
MIMEMap := TIdMimeTable.Create(True);
|
||
try
|
||
Result := MIMEMap.GetFileMIMEType(AFile);
|
||
finally
|
||
MIMEMap.Free;
|
||
end;
|
||
end;
|
||
|
||
function GetMIMEDefaultFileExt(const MIMEType: string): TIdFileName;
|
||
var
|
||
MIMEMap: TIdMIMETable;
|
||
begin
|
||
MIMEMap := TIdMimeTable.Create(True);
|
||
try
|
||
Result := MIMEMap.GetDefaultFileExt(MIMEType);
|
||
finally
|
||
MIMEMap.Free;
|
||
end;
|
||
end;
|
||
|
||
// RLebeau: According to RFC 2822 Section 4.3:
|
||
//
|
||
// In the obsolete time zone, "UT" and "GMT" are indications of
|
||
// "Universal Time" and "Greenwich Mean Time" respectively and are both
|
||
// semantically identical to "+0000".
|
||
//
|
||
// The remaining three character zones are the US time zones. The first
|
||
// letter, "E", "C", "M", or "P" stands for "Eastern", "Central",
|
||
// "Mountain" and "Pacific". The second letter is either "S" for
|
||
// "Standard" time, or "D" for "Daylight" (or summer) time. Their
|
||
// interpretations are as follows:
|
||
//
|
||
// EDT is semantically equivalent to -0400
|
||
// EST is semantically equivalent to -0500
|
||
// CDT is semantically equivalent to -0500
|
||
// CST is semantically equivalent to -0600
|
||
// MDT is semantically equivalent to -0600
|
||
// MST is semantically equivalent to -0700
|
||
// PDT is semantically equivalent to -0700
|
||
// PST is semantically equivalent to -0800
|
||
//
|
||
// The 1 character military time zones were defined in a non-standard
|
||
// way in [RFC822] and are therefore unpredictable in their meaning.
|
||
// The original definitions of the military zones "A" through "I" are
|
||
// equivalent to "+0100" through "+0900" respectively; "K", "L", and "M"
|
||
// are equivalent to "+1000", "+1100", and "+1200" respectively; "N"
|
||
// through "Y" are equivalent to "-0100" through "-1200" respectively;
|
||
// and "Z" is equivalent to "+0000". However, because of the error in
|
||
// [RFC822], they SHOULD all be considered equivalent to "-0000" unless
|
||
// there is out-of-band information confirming their meaning.
|
||
//
|
||
// Other multi-character (usually between 3 and 5) alphabetic time zones
|
||
// have been used in Internet messages. Any such time zone whose
|
||
// meaning is not known SHOULD be considered equivalent to "-0000"
|
||
// unless there is out-of-band information confirming their meaning.
|
||
|
||
// RLebeau: according to http://en.wikipedia.org/wiki/Central_European_Time:
|
||
//
|
||
// Central European Time (CET) is one of the names of the time zone that is
|
||
// 1 hour ahead of Coordinated Universal Time. It is used in most European
|
||
// and some North African countries.
|
||
//
|
||
// Its time offset is normally UTC+1. During daylight saving time, Central
|
||
// European Summer Time (CEST) is used instead (UTC+2). The current time
|
||
// offset is UTC+1.
|
||
|
||
// RLebeau: other abbreviations taken from:
|
||
// http://www.timeanddate.com/library/abbreviations/timezones/
|
||
|
||
function TimeZoneToGmtOffsetStr(const ATimeZone: String): String;
|
||
type
|
||
TimeZoneOffset = record
|
||
TimeZone: String;
|
||
Offset: String;
|
||
end;
|
||
const
|
||
cTimeZones: array[0..90] of TimeZoneOffset = (
|
||
(TimeZone:'A'; Offset:'+0100'), // Alpha Time Zone - Military {do not localize}
|
||
(TimeZone:'ACDT'; Offset:'+1030'), // Australian Central Daylight Time {do not localize}
|
||
(TimeZone:'ACST'; Offset:'+0930'), // Australian Central Standard Time {do not localize}
|
||
(TimeZone:'ADT'; Offset:'-0300'), // Atlantic Daylight Time - North America {do not localize}
|
||
(TimeZone:'AEDT'; Offset:'+1100'), // Australian Eastern Daylight Time {do not localize}
|
||
(TimeZone:'AEST'; Offset:'+1000'), // Australian Eastern Standard Time {do not localize}
|
||
(TimeZone:'AKDT'; Offset:'-0800'), // Alaska Daylight Time {do not localize}
|
||
(TimeZone:'AKST'; Offset:'-0900'), // Alaska Standard Time {do not localize}
|
||
(TimeZone:'AST'; Offset:'-0400'), // Atlantic Standard Time - North America {do not localize}
|
||
(TimeZone:'AWDT'; Offset:'+0900'), // Australian Western Daylight Time {do not localize}
|
||
(TimeZone:'AWST'; Offset:'+0800'), // Australian Western Standard Time {do not localize}
|
||
(TimeZone:'B'; Offset:'+0200'), // Bravo Time Zone - Military {do not localize}
|
||
(TimeZone:'BST'; Offset:'+0100'), // British Summer Time - Europe {do not localize}
|
||
(TimeZone:'C'; Offset:'+0300'), // Charlie Time Zone - Military {do not localize}
|
||
(TimeZone:'CDT'; Offset:'+1030'), // Central Daylight Time - Australia {do not localize}
|
||
(TimeZone:'CDT'; Offset:'-0500'), // Central Daylight Time - North America {do not localize}
|
||
(TimeZone:'CEDT'; Offset:'+0200'), // Central European Daylight Time {do not localize}
|
||
(TimeZone:'CEST'; Offset:'+0200'), // Central European Summer Time {do not localize}
|
||
(TimeZone:'CET'; Offset:'+0100'), // Central European Time {do not localize}
|
||
(TimeZone:'CST'; Offset:'+1030'), // Central Summer Time - Australia {do not localize}
|
||
(TimeZone:'CST'; Offset:'+0930'), // Central Standard Time - Australia {do not localize}
|
||
(TimeZone:'CST'; Offset:'-0600'), // Central Standard Time - North America {do not localize}
|
||
(TimeZone:'CXT'; Offset:'+0700'), // Christmas Island Time - Australia {do not localize}
|
||
(TimeZone:'D'; Offset:'+0400'), // Delta Time Zone - Military {do not localize}
|
||
(TimeZone:'E'; Offset:'+0500'), // Echo Time Zone - Military {do not localize}
|
||
(TimeZone:'EDT'; Offset:'+1100'), // Eastern Daylight Time - Australia {do not localize}
|
||
(TimeZone:'EDT'; Offset:'-0400'), // Eastern Daylight Time - North America {do not localize}
|
||
(TimeZone:'EEDT'; Offset:'+0300'), // Eastern European Daylight Time {do not localize}
|
||
(TimeZone:'EEST'; Offset:'+0300'), // Eastern European Summer Time {do not localize}
|
||
(TimeZone:'EET'; Offset:'+0200'), // Eastern European Time {do not localize}
|
||
(TimeZone:'EST'; Offset:'+1100'), // Eastern Summer Time - Australia {do not localize}
|
||
(TimeZone:'EST'; Offset:'+1000'), // Eastern Standard Time - Australia {do not localize}
|
||
(TimeZone:'EST'; Offset:'-0500'), // Eastern Standard Time - North America {do not localize}
|
||
(TimeZone:'F'; Offset:'+0600'), // Foxtrot Time Zone - Military {do not localize}
|
||
(TimeZone:'G'; Offset:'+0700'), // Golf Time Zone - Military {do not localize}
|
||
(TimeZone:'GMT'; Offset:'+0000'), // Greenwich Mean Time - Europe {do not localize}
|
||
(TimeZone:'H'; Offset:'+0800'), // Hotel Time Zone - Military {do not localize}
|
||
(TimeZone:'HAA'; Offset:'-0300'), // Heure Avanc<6E>e de l'Atlantique - North America {do not localize}
|
||
(TimeZone:'HAC'; Offset:'-0500'), // Heure Avanc<6E>e du Centre - North America {do not localize}
|
||
(TimeZone:'HADT'; Offset:'-0900'), // Hawaii-Aleutian Daylight Time - North America {do not localize}
|
||
(TimeZone:'HAE'; Offset:'-0400'), // Heure Avanc<6E>e de l'Est - North America {do not localize}
|
||
(TimeZone:'HAP'; Offset:'-0700'), // Heure Avanc<6E>e du Pacifique - North America {do not localize}
|
||
(TimeZone:'HAR'; Offset:'-0600'), // Heure Avanc<6E>e des Rocheuses - North America {do not localize}
|
||
(TimeZone:'HAST'; Offset:'-1000'), // Hawaii-Aleutian Standard Time - North America {do not localize}
|
||
(TimeZone:'HAT'; Offset:'-0230'), // Heure Avanc<6E>e de Terre-Neuve - North America {do not localize}
|
||
(TimeZone:'HAY'; Offset:'-0800'), // Heure Avanc<6E>e du Yukon - North America {do not localize}
|
||
(TimeZone:'HNA'; Offset:'-0400'), // Heure Normale de l'Atlantique - North America {do not localize}
|
||
(TimeZone:'HNC'; Offset:'-0600'), // Heure Normale du Centre - North America {do not localize}
|
||
(TimeZone:'HNE'; Offset:'-0500'), // Heure Normale de l'Est - North America {do not localize}
|
||
(TimeZone:'HNP'; Offset:'-0800'), // Heure Normale du Pacifique - North America {do not localize}
|
||
(TimeZone:'HNR'; Offset:'-0700'), // Heure Normale des Rocheuses - North America {do not localize}
|
||
(TimeZone:'HNT'; Offset:'-0330'), // Heure Normale de Terre-Neuve - North America {do not localize}
|
||
(TimeZone:'HNY'; Offset:'-0900'), // Heure Normale du Yukon - North America {do not localize}
|
||
(TimeZone:'I'; Offset:'+0900'), // India Time Zone - Military {do not localize}
|
||
(TimeZone:'IST'; Offset:'+0100'), // Irish Summer Time - Europe {do not localize}
|
||
(TimeZone:'K'; Offset:'+1000'), // Kilo Time Zone - Military {do not localize}
|
||
(TimeZone:'L'; Offset:'+1100'), // Lima Time Zone - Military {do not localize}
|
||
(TimeZone:'M'; Offset:'+1200'), // Mike Time Zone - Military {do not localize}
|
||
(TimeZone:'MDT'; Offset:'-0600'), // Mountain Daylight Time - North America {do not localize}
|
||
(TimeZone:'MEHSZ';Offset:'+0300'), // Mitteleurop<6F>ische Hochsommerzeit - Europe {do not localize}
|
||
(TimeZone:'MESZ'; Offset:'+0200'), // Mitteleuro<72>ische Sommerzeit - Europe {do not localize}
|
||
(TimeZone:'MEZ'; Offset:'+0100'), // Mitteleurop<6F>ische Zeit - Europe {do not localize}
|
||
(TimeZone:'MSD'; Offset:'+0400'), // Moscow Daylight Time - Europe {do not localize}
|
||
(TimeZone:'MSK'; Offset:'+0300'), // Moscow Standard Time - Europe {do not localize}
|
||
(TimeZone:'MST'; Offset:'-0700'), // Mountain Standard Time - North America {do not localize}
|
||
(TimeZone:'N'; Offset:'-0100'), // November Time Zone - Military {do not localize}
|
||
(TimeZone:'NDT'; Offset:'-0230'), // Newfoundland Daylight Time - North America {do not localize}
|
||
(TimeZone:'NFT'; Offset:'+1130'), // Norfolk (Island), Time - Australia {do not localize}
|
||
(TimeZone:'NST'; Offset:'-0330'), // Newfoundland Standard Time - North America {do not localize}
|
||
(TimeZone:'O'; Offset:'-0200'), // Oscar Time Zone - Military {do not localize}
|
||
(TimeZone:'P'; Offset:'-0300'), // Papa Time Zone - Military {do not localize}
|
||
(TimeZone:'PDT'; Offset:'-0700'), // Pacific Daylight Time - North America {do not localize}
|
||
(TimeZone:'PST'; Offset:'-0800'), // Pacific Standard Time - North America {do not localize}
|
||
(TimeZone:'Q'; Offset:'-0400'), // Quebec Time Zone - Military {do not localize}
|
||
(TimeZone:'R'; Offset:'-0500'), // Romeo Time Zone - Military {do not localize}
|
||
(TimeZone:'S'; Offset:'-0600'), // Sierra Time Zone - Military {do not localize}
|
||
(TimeZone:'T'; Offset:'-0700'), // Tango Time Zone - Military {do not localize}
|
||
(TimeZone:'U'; Offset:'-0800'), // Uniform Time Zone - Military {do not localize}
|
||
(TimeZone:'UT'; Offset:'+0000'), // Universal Time - Europe {do not localize}
|
||
(TimeZone:'UTC'; Offset:'+0000'), // Coordinated Universal Time - Europe {do not localize}
|
||
(TimeZone:'V'; Offset:'-0900'), // Victor Time Zone - Military {do not localize}
|
||
(TimeZone:'W'; Offset:'-1000'), // Whiskey Time Zone - Military {do not localize}
|
||
(TimeZone:'WDT'; Offset:'+0900'), // Western Daylight Time - Australia {do not localize}
|
||
(TimeZone:'WEDT'; Offset:'+0100'), // Western European Daylight Time - Europe {do not localize}
|
||
(TimeZone:'WEST'; Offset:'+0100'), // Western European Summer Time - Europe {do not localize}
|
||
(TimeZone:'WET'; Offset:'+0000'), // Western European Time - Europe {do not localize}
|
||
(TimeZone:'WST'; Offset:'+0900'), // Western Summer Time - Australia {do not localize}
|
||
(TimeZone:'WST'; Offset:'+0800'), // Western Standard Time - Australia {do not localize}
|
||
(TimeZone:'X'; Offset:'-1100'), // X-ray Time Zone - Military {do not localize}
|
||
(TimeZone:'Y'; Offset:'-1200'), // Yankee Time Zone - Military {do not localize}
|
||
(TimeZone:'Z'; Offset:'+0000') // Zulu Time Zone - Military {do not localize}
|
||
);
|
||
var
|
||
I: Integer;
|
||
begin
|
||
for I := Low(cTimeZones) to High(cTimeZones) do begin
|
||
if TextIsSame(ATimeZone, cTimeZones[I].TimeZone) then begin
|
||
Result := cTimeZones[I].Offset;
|
||
Exit;
|
||
end;
|
||
end;
|
||
Result := '-0000' {do not localize}
|
||
end;
|
||
|
||
function GmtOffsetStrToDateTime(const S: string): TDateTime;
|
||
var
|
||
sTmp: String;
|
||
begin
|
||
Result := 0.0;
|
||
sTmp := Trim(S);
|
||
sTmp := Fetch(sTmp);
|
||
if Length(sTmp) > 0 then begin
|
||
if not CharIsInSet(sTmp, 1, '-+') then begin {do not localize}
|
||
sTmp := TimeZoneToGmtOffsetStr(sTmp);
|
||
end else
|
||
begin
|
||
// ISO 8601 has a colon in the middle, ignore it
|
||
if Length(sTmp) = 6 then begin
|
||
if CharEquals(sTmp, 4, ':') then begin {do not localize}
|
||
IdDelete(sTmp, 4, 1);
|
||
end;
|
||
end
|
||
// ISO 8601 allows the minutes to be omitted, add them
|
||
else if Length(sTmp) = 3 then begin
|
||
sTmp := sTmp + '00';
|
||
end;
|
||
if (Length(sTmp) <> 5) or (not IsNumeric(sTmp, 2, 2)) or (not IsNumeric(sTmp, 2, 4)) then begin
|
||
Exit;
|
||
end;
|
||
end;
|
||
try
|
||
Result := EncodeTime(IndyStrToInt(Copy(sTmp, 2, 2)), IndyStrToInt(Copy(sTmp, 4, 2)), 0, 0);
|
||
if CharEquals(sTmp, 1, '-') then begin {do not localize}
|
||
Result := -Result;
|
||
end;
|
||
except
|
||
Result := 0.0;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{-Always returns date/time relative to GMT!! -Replaces StrInternetToDateTime}
|
||
function GMTToLocalDateTime(S: string): TDateTime;
|
||
var
|
||
DateTimeOffset: TDateTime;
|
||
begin
|
||
if RawStrInternetToDateTime(S, Result) then begin
|
||
DateTimeOffset := GmtOffsetStrToDateTime(S);
|
||
{-Apply GMT and local offsets}
|
||
Result := Result - DateTimeOffset + OffsetFromUTC;
|
||
end;
|
||
end;
|
||
|
||
{$IFNDEF HAS_TryStrToInt}
|
||
// TODO: declare this in the interface section...
|
||
function TryStrToInt(const S: string; out Value: Integer): Boolean;
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
var
|
||
E: Integer;
|
||
begin
|
||
Val(S, Value, E);
|
||
Result := E = 0;
|
||
end;
|
||
{$ENDIF}
|
||
|
||
{ Using the algorithm defined in RFC 6265 section 5.1.1 }
|
||
function CookieStrToLocalDateTime(S: string): TDateTime;
|
||
const
|
||
{
|
||
delimiter = %x09 / %x20-2F / %x3B-40 / %x5B-60 / %x7B-7E
|
||
non-delimiter = %x00-08 / %x0A-1F / DIGIT / ":" / ALPHA / %x7F-FF
|
||
}
|
||
cDelimiters = #9' !"#$%&''()*+,-./;<=>?@[\]^_`{|}~';
|
||
var
|
||
LStartPos, LEndPos: Integer;
|
||
LFoundTime, LFoundDayOfMonth, LFoundMonth, LFoundYear: Boolean;
|
||
LHour, LMinute, LSecond: Integer;
|
||
LYear, LMonth, LDayOfMonth: Integer;
|
||
|
||
function ExtractDigits(var AStr: String; MinDigits, MaxDigits: Integer): String;
|
||
var
|
||
LLength: Integer;
|
||
begin
|
||
Result := '';
|
||
LLength := 0;
|
||
while (LLength < Length(AStr)) and (LLength < MaxDigits) do
|
||
begin
|
||
if not IsNumeric(AStr[LLength+1]) then begin
|
||
Break;
|
||
end;
|
||
Inc(LLength);
|
||
end;
|
||
if (LLength > 0) and (LLength >= MinDigits) then begin
|
||
Result := Copy(AStr, 1, LLength);
|
||
AStr := Copy(AStr, LLength+1, MaxInt);
|
||
end;
|
||
end;
|
||
|
||
function ParseTime(const AStr: String): Boolean;
|
||
var
|
||
S, LTemp: String;
|
||
begin
|
||
{
|
||
non-digit = %x00-2F / %x3A-FF
|
||
time = hms-time [ non-digit *OCTET ]
|
||
hms-time = time-field ":" time-field ":" time-field
|
||
time-field = 1*2DIGIT
|
||
}
|
||
Result := False;
|
||
S := AStr;
|
||
|
||
LTemp := ExtractDigits(S, 1, 2);
|
||
if (LTemp = '') or (not CharEquals(S, 1, ':')) then begin
|
||
Exit;
|
||
end;
|
||
if not TryStrToInt(LTemp, LHour) then begin
|
||
Exit;
|
||
end;
|
||
IdDelete(S, 1, 1);
|
||
|
||
LTemp := ExtractDigits(S, 1, 2);
|
||
if (LTemp = '') or (not CharEquals(S, 1, ':')) then begin
|
||
Exit;
|
||
end;
|
||
if not TryStrToInt(LTemp, LMinute) then begin
|
||
Exit;
|
||
end;
|
||
IdDelete(S, 1, 1);
|
||
|
||
LTemp := ExtractDigits(S, 1, 2);
|
||
if LTemp = '' then begin
|
||
Exit;
|
||
end;
|
||
if S <> '' then begin
|
||
if IsNumeric(S, 1, 1) then begin
|
||
raise Exception.Create('Invalid Cookie Time');
|
||
end;
|
||
end;
|
||
if not TryStrToInt(LTemp, LSecond) then begin
|
||
Exit;
|
||
end;
|
||
|
||
if LHour > 23 then begin
|
||
raise Exception.Create('Invalid Cookie Time');
|
||
end;
|
||
if LMinute > 59 then begin
|
||
raise Exception.Create('Invalid Cookie Time');
|
||
end;
|
||
if LSecond > 59 then begin
|
||
raise Exception.Create('Invalid Cookie Time');
|
||
end;
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
function ParseDayOfMonth(const AStr: String): Boolean;
|
||
var
|
||
S, LTemp: String;
|
||
begin
|
||
{
|
||
non-digit = %x00-2F / %x3A-FF
|
||
day-of-month = 1*2DIGIT [ non-digit *OCTET ]
|
||
}
|
||
Result := False;
|
||
S := AStr;
|
||
|
||
LTemp := ExtractDigits(S, 1, 2);
|
||
if LTemp = '' then begin
|
||
Exit;
|
||
end;
|
||
if S <> '' then begin
|
||
if IsNumeric(S, 1, 1) then begin
|
||
raise Exception.Create('Invalid Cookie Day of Month');
|
||
end;
|
||
end;
|
||
if not TryStrToInt(LTemp, LDayOfMonth) then begin
|
||
Exit;
|
||
end;
|
||
if (LDayOfMonth < 1) or (LDayOfMonth > 31) then begin
|
||
raise Exception.Create('Invalid Cookie Day of Month');
|
||
end;
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
function ParseMonth(const AStr: String): Boolean;
|
||
var
|
||
S, LTemp: String;
|
||
begin
|
||
{
|
||
month = ( "jan" / "feb" / "mar" / "apr" /
|
||
"may" / "jun" / "jul" / "aug" /
|
||
"sep" / "oct" / "nov" / "dec" ) *OCTET
|
||
}
|
||
Result := False;
|
||
|
||
LMonth := PosInStrArray(Copy(AStr, 1, 3), ['jan', 'feb', 'mar', 'apr', 'may', 'jun', 'jul', 'aug', 'sep', 'oct', 'nov', 'dec'], False) + 1;
|
||
if LMonth = 0 then begin
|
||
// RLebeau: per JP, some cookies have been encountered that use numbers
|
||
// instead of names, even though this is not allowed by various RFCs...
|
||
S := AStr;
|
||
LTemp := ExtractDigits(S, 1, 2);
|
||
if LTemp = '' then begin
|
||
Exit;
|
||
end;
|
||
if S <> '' then begin
|
||
if IsNumeric(S, 1, 1) then begin
|
||
raise Exception.Create('Invalid Cookie Month');
|
||
end;
|
||
end;
|
||
if not TryStrToInt(LTemp, LMonth) then begin
|
||
Exit;
|
||
end;
|
||
if (LMonth < 1) or (LMonth > 12) then begin
|
||
raise Exception.Create('Invalid Cookie Month');
|
||
end;
|
||
end;
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
function ParseYear(const AStr: String): Boolean;
|
||
var
|
||
S, LTemp: String;
|
||
begin
|
||
// year = 2*4DIGIT [ non-digit *OCTET ]
|
||
|
||
Result := False;
|
||
S := AStr;
|
||
|
||
LTemp := ExtractDigits(S, 2, 4);
|
||
if (LTemp = '') or IsNumeric(S, 1, 1) then begin
|
||
Exit;
|
||
end;
|
||
if not TryStrToInt(AStr, LYear) then begin
|
||
Exit;
|
||
end;
|
||
if (LYear >= 70) and (LYear <= 99) then begin
|
||
Inc(LYear, 1900);
|
||
end
|
||
else if (LYear >= 0) and (LYear <= 69) then begin
|
||
Inc(LYear, 2000);
|
||
end;
|
||
if LYear < 1601 then begin
|
||
raise Exception.Create('Invalid Cookie Year');
|
||
end;
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
procedure ProcessToken(const AStr: String);
|
||
begin
|
||
if not LFoundTime then begin
|
||
if ParseTime(AStr) then begin
|
||
LFoundTime := True;
|
||
Exit;
|
||
end;
|
||
end;
|
||
if not LFoundDayOfMonth then begin
|
||
if ParseDayOfMonth(AStr) then begin
|
||
LFoundDayOfMonth := True;
|
||
Exit;
|
||
end;
|
||
end;
|
||
if not LFoundMonth then begin
|
||
if ParseMonth(AStr) then begin
|
||
LFoundMonth := True;
|
||
Exit;
|
||
end;
|
||
end;
|
||
if not LFoundYear then begin
|
||
if ParseYear(AStr) then begin
|
||
LFoundYear := True;
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
LFoundTime := False;
|
||
LFoundDayOfMonth := False;
|
||
LFoundMonth := False;
|
||
LFoundYear := False;
|
||
|
||
try
|
||
LEndPos := 0;
|
||
repeat
|
||
LStartPos := FindFirstNotOf(cDelimiters, S, -1, LEndPos+1);
|
||
if LStartPos = 0 then begin
|
||
Break;
|
||
end;
|
||
LEndPos := FindFirstOf(cDelimiters, S, -1, LStartPos+1);
|
||
if LEndPos = 0 then begin
|
||
ProcessToken(Copy(S, LStartPos, MaxInt));
|
||
Break;
|
||
end;
|
||
ProcessToken(Copy(S, LStartPos, LEndPos-LStartPos));
|
||
until False;
|
||
|
||
if (not LFoundDayOfMonth) or (not LFoundMonth) or (not LFoundYear) or (not LFoundTime) then begin
|
||
raise Exception.Create('Invalid Cookie Date format');
|
||
end;
|
||
|
||
Result := EncodeDate(LYear, LMonth, LDayOfMonth) + EncodeTime(LHour, LMinute, LSecond, 0) + OffsetFromUTC;
|
||
except
|
||
Result := 0.0;
|
||
end;
|
||
end;
|
||
|
||
{ Takes a UInt32 value and returns the string representation of it's binary value} {Do not Localize}
|
||
function IntToBin(Value: UInt32): string;
|
||
var
|
||
i: Integer;
|
||
{$IFDEF STRING_IS_IMMUTABLE}
|
||
LSB: TStringBuilder;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF STRING_IS_IMMUTABLE}
|
||
LSB := TStringBuilder.Create(32);
|
||
{$ELSE}
|
||
SetLength(Result, 32);
|
||
{$ENDIF}
|
||
for i := 1 to 32 do begin
|
||
if ((Value shl (i-1)) shr 31) = 0 then begin
|
||
{$IFDEF STRING_IS_IMMUTABLE}
|
||
LSB.Append(Char('0')); {do not localize}
|
||
{$ELSE}
|
||
Result[i] := '0'; {do not localize}
|
||
{$ENDIF}
|
||
end else begin
|
||
{$IFDEF STRING_IS_IMMUTABLE}
|
||
LSB.Append(Char('1')); {do not localize}
|
||
{$ELSE}
|
||
Result[i] := '1'; {do not localize}
|
||
{$ENDIF}
|
||
end;
|
||
end;
|
||
{$IFDEF STRING_IS_IMMUTABLE}
|
||
Result := LSB.ToString;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
{ TIdMimeTable }
|
||
|
||
{$IFDEF UNIX}
|
||
procedure LoadMIME(const AFileName : String; AMIMEList : TStrings);
|
||
var
|
||
KeyList: TStringList;
|
||
i, p: Integer;
|
||
s, LMimeType, LExtension: String;
|
||
begin
|
||
if FileExists(AFileName) then begin {Do not localize}
|
||
// build list from /etc/mime.types style list file
|
||
// I'm lazy so I'm using a stringlist to load the file, ideally
|
||
// this should not be done, reading the file line by line is better
|
||
// I think - at least in terms of storage
|
||
KeyList := TStringList.Create;
|
||
try
|
||
// TODO: use TStreamReader instead, on versions that support it
|
||
KeyList.LoadFromFile(AFileName); {Do not localize}
|
||
for i := 0 to KeyList.Count -1 do begin
|
||
s := KeyList[i];
|
||
p := IndyPos('#', s); {Do not localize}
|
||
if p > 0 then begin
|
||
SetLength(s, p-1);
|
||
end;
|
||
if s <> '' then begin {Do not localize}
|
||
s := Trim(s);
|
||
LMimeType := IndyLowerCase(Fetch(s));
|
||
if LMimeType <> '' then begin {Do not localize}
|
||
while s <> '' do begin {Do not localize}
|
||
LExtension := IndyLowerCase(Fetch(s));
|
||
if LExtension <> '' then {Do not localize}
|
||
try
|
||
if LExtension[1] <> '.' then begin
|
||
LExtension := '.' + LExtension; {Do not localize}
|
||
end;
|
||
AMIMEList.Values[LExtension] := LMimeType;
|
||
except
|
||
on EListError do {ignore} ;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
except
|
||
on EFOpenError do {ignore} ;
|
||
end;
|
||
End;
|
||
end;
|
||
{$ENDIF}
|
||
|
||
procedure FillMimeTable(const AMIMEList: TStrings; const ALoadFromOS: Boolean = True);
|
||
{$IFDEF WINDOWS}
|
||
var
|
||
reg: TRegistry;
|
||
KeyList: TStringList;
|
||
i: Integer;
|
||
s, LExt: String;
|
||
{$ENDIF}
|
||
begin
|
||
{ Protect if someone is already filled (custom MomeConst) }
|
||
if not Assigned(AMIMEList) then begin
|
||
Exit;
|
||
end;
|
||
if AMIMEList.Count > 0 then begin
|
||
Exit;
|
||
end;
|
||
{NOTE: All of these strings should never be translated
|
||
because they are protocol specific and are important for some
|
||
web-browsers}
|
||
|
||
{ Animation }
|
||
AMIMEList.Add('.nml=animation/narrative'); {Do not Localize}
|
||
|
||
{ Audio }
|
||
AMIMEList.Add('.aac=audio/mp4');
|
||
AMIMEList.Add('.aif=audio/x-aiff'); {Do not Localize}
|
||
AMIMEList.Add('.aifc=audio/x-aiff'); {Do not Localize}
|
||
AMIMEList.Add('.aiff=audio/x-aiff'); {Do not Localize}
|
||
|
||
AMIMEList.Add('.au=audio/basic'); {Do not Localize}
|
||
AMIMEList.Add('.gsm=audio/x-gsm'); {Do not Localize}
|
||
AMIMEList.Add('.kar=audio/midi'); {Do not Localize}
|
||
AMIMEList.Add('.m3u=audio/mpegurl'); {Do not Localize}
|
||
AMIMEList.Add('.m4a=audio/x-mpg'); {Do not Localize}
|
||
AMIMEList.Add('.mid=audio/midi'); {Do not Localize}
|
||
AMIMEList.Add('.midi=audio/midi'); {Do not Localize}
|
||
AMIMEList.Add('.mpega=audio/x-mpg'); {Do not Localize}
|
||
AMIMEList.Add('.mp2=audio/x-mpg'); {Do not Localize}
|
||
AMIMEList.Add('.mp3=audio/x-mpg'); {Do not Localize}
|
||
AMIMEList.Add('.mpga=audio/x-mpg'); {Do not Localize}
|
||
AMIMEList.Add('.m3u=audio/x-mpegurl'); {Do not Localize}
|
||
AMIMEList.Add('.pls=audio/x-scpls'); {Do not Localize}
|
||
AMIMEList.Add('.qcp=audio/vnd.qcelp'); {Do not Localize}
|
||
AMIMEList.Add('.ra=audio/x-realaudio'); {Do not Localize}
|
||
AMIMEList.Add('.ram=audio/x-pn-realaudio'); {Do not Localize}
|
||
AMIMEList.Add('.rm=audio/x-pn-realaudio'); {Do not Localize}
|
||
AMIMEList.Add('.sd2=audio/x-sd2'); {Do not Localize}
|
||
AMIMEList.Add('.sid=audio/prs.sid'); {Do not Localize}
|
||
AMIMEList.Add('.snd=audio/basic'); {Do not Localize}
|
||
AMIMEList.Add('.wav=audio/x-wav'); {Do not Localize}
|
||
AMIMEList.Add('.wax=audio/x-ms-wax'); {Do not Localize}
|
||
AMIMEList.Add('.wma=audio/x-ms-wma'); {Do not Localize}
|
||
|
||
AMIMEList.Add('.mjf=audio/x-vnd.AudioExplosion.MjuiceMediaFile'); {Do not Localize}
|
||
|
||
{ Image }
|
||
AMIMEList.Add('.art=image/x-jg'); {Do not Localize}
|
||
AMIMEList.Add('.bmp=image/bmp'); {Do not Localize}
|
||
AMIMEList.Add('.cdr=image/x-coreldraw'); {Do not Localize}
|
||
AMIMEList.Add('.cdt=image/x-coreldrawtemplate'); {Do not Localize}
|
||
AMIMEList.Add('.cpt=image/x-corelphotopaint'); {Do not Localize}
|
||
AMIMEList.Add('.djv=image/vnd.djvu'); {Do not Localize}
|
||
AMIMEList.Add('.djvu=image/vnd.djvu'); {Do not Localize}
|
||
AMIMEList.Add('.gif=image/gif'); {Do not Localize}
|
||
AMIMEList.Add('.ief=image/ief'); {Do not Localize}
|
||
AMIMEList.Add('.ico=image/x-icon'); {Do not Localize}
|
||
AMIMEList.Add('.jng=image/x-jng'); {Do not Localize}
|
||
AMIMEList.Add('.jpg=image/jpeg'); {Do not Localize}
|
||
AMIMEList.Add('.jpeg=image/jpeg'); {Do not Localize}
|
||
AMIMEList.Add('.jpe=image/jpeg'); {Do not Localize}
|
||
AMIMEList.Add('.pat=image/x-coreldrawpattern'); {Do not Localize}
|
||
AMIMEList.Add('.pcx=image/pcx'); {Do not Localize}
|
||
AMIMEList.Add('.pbm=image/x-portable-bitmap'); {Do not Localize}
|
||
AMIMEList.Add('.pgm=image/x-portable-graymap'); {Do not Localize}
|
||
AMIMEList.Add('.pict=image/x-pict'); {Do not Localize}
|
||
AMIMEList.Add('.png=image/x-png'); {Do not Localize}
|
||
AMIMEList.Add('.pnm=image/x-portable-anymap'); {Do not Localize}
|
||
AMIMEList.Add('.pntg=image/x-macpaint'); {Do not Localize}
|
||
AMIMEList.Add('.ppm=image/x-portable-pixmap'); {Do not Localize}
|
||
AMIMEList.Add('.psd=image/x-psd'); {Do not Localize}
|
||
AMIMEList.Add('.qtif=image/x-quicktime'); {Do not Localize}
|
||
AMIMEList.Add('.ras=image/x-cmu-raster'); {Do not Localize}
|
||
AMIMEList.Add('.rf=image/vnd.rn-realflash'); {Do not Localize}
|
||
AMIMEList.Add('.rgb=image/x-rgb'); {Do not Localize}
|
||
AMIMEList.Add('.rp=image/vnd.rn-realpix'); {Do not Localize}
|
||
AMIMEList.Add('.sgi=image/x-sgi'); {Do not Localize}
|
||
AMIMEList.Add('.svg=image/svg+xml'); {Do not Localize}
|
||
AMIMEList.Add('.svgz=image/svg+xml'); {Do not Localize}
|
||
AMIMEList.Add('.targa=image/x-targa'); {Do not Localize}
|
||
AMIMEList.Add('.tif=image/x-tiff'); {Do not Localize}
|
||
AMIMEList.Add('.wbmp=image/vnd.wap.wbmp'); {Do not Localize}
|
||
AMIMEList.Add('.webp=image/webp'); {Do not localize}
|
||
AMIMEList.Add('.xbm=image/xbm'); {Do not Localize}
|
||
AMIMEList.Add('.xbm=image/x-xbitmap'); {Do not Localize}
|
||
AMIMEList.Add('.xpm=image/x-xpixmap'); {Do not Localize}
|
||
AMIMEList.Add('.xwd=image/x-xwindowdump'); {Do not Localize}
|
||
|
||
{ Text }
|
||
AMIMEList.Add('.323=text/h323'); {Do not Localize}
|
||
|
||
AMIMEList.Add('.xml=text/xml'); {Do not Localize}
|
||
AMIMEList.Add('.uls=text/iuls'); {Do not Localize}
|
||
AMIMEList.Add('.txt=text/plain'); {Do not Localize}
|
||
AMIMEList.Add('.rtx=text/richtext'); {Do not Localize}
|
||
AMIMEList.Add('.wsc=text/scriptlet'); {Do not Localize}
|
||
AMIMEList.Add('.rt=text/vnd.rn-realtext'); {Do not Localize}
|
||
AMIMEList.Add('.htt=text/webviewhtml'); {Do not Localize}
|
||
AMIMEList.Add('.htc=text/x-component'); {Do not Localize}
|
||
AMIMEList.Add('.vcf=text/x-vcard'); {Do not Localize}
|
||
|
||
{ Video }
|
||
AMIMEList.Add('.asf=video/x-ms-asf'); {Do not Localize}
|
||
AMIMEList.Add('.asx=video/x-ms-asf'); {Do not Localize}
|
||
AMIMEList.Add('.avi=video/x-msvideo'); {Do not Localize}
|
||
AMIMEList.Add('.dl=video/dl'); {Do not Localize}
|
||
AMIMEList.Add('.dv=video/dv'); {Do not Localize}
|
||
AMIMEList.Add('.flc=video/flc'); {Do not Localize}
|
||
AMIMEList.Add('.fli=video/fli'); {Do not Localize}
|
||
AMIMEList.Add('.gl=video/gl'); {Do not Localize}
|
||
AMIMEList.Add('.lsf=video/x-la-asf'); {Do not Localize}
|
||
AMIMEList.Add('.lsx=video/x-la-asf'); {Do not Localize}
|
||
AMIMEList.Add('.mng=video/x-mng'); {Do not Localize}
|
||
|
||
AMIMEList.Add('.mp2=video/mpeg'); {Do not Localize}
|
||
AMIMEList.Add('.mp3=video/mpeg'); {Do not Localize}
|
||
AMIMEList.Add('.mp4=video/mpeg'); {Do not Localize}
|
||
AMIMEList.Add('.mpeg=video/x-mpeg2a'); {Do not Localize}
|
||
AMIMEList.Add('.mpa=video/mpeg'); {Do not Localize}
|
||
AMIMEList.Add('.mpe=video/mpeg'); {Do not Localize}
|
||
AMIMEList.Add('.mpg=video/mpeg'); {Do not Localize}
|
||
AMIMEList.Add('.ogv=video/ogg'); {Do not Localize}
|
||
AMIMEList.Add('.moov=video/quicktime'); {Do not Localize}
|
||
AMIMEList.Add('.mov=video/quicktime'); {Do not Localize}
|
||
AMIMEList.Add('.mxu=video/vnd.mpegurl'); {Do not Localize}
|
||
AMIMEList.Add('.qt=video/quicktime'); {Do not Localize}
|
||
AMIMEList.Add('.qtc=video/x-qtc'); {Do not loccalize}
|
||
AMIMEList.Add('.rv=video/vnd.rn-realvideo'); {Do not Localize}
|
||
AMIMEList.Add('.ivf=video/x-ivf'); {Do not Localize}
|
||
AMIMEList.Add('.webm=video/webm'); {Do not Localize}
|
||
AMIMEList.Add('.wm=video/x-ms-wm'); {Do not Localize}
|
||
AMIMEList.Add('.wmp=video/x-ms-wmp'); {Do not Localize}
|
||
AMIMEList.Add('.wmv=video/x-ms-wmv'); {Do not Localize}
|
||
AMIMEList.Add('.wmx=video/x-ms-wmx'); {Do not Localize}
|
||
AMIMEList.Add('.wvx=video/x-ms-wvx'); {Do not Localize}
|
||
AMIMEList.Add('.rms=video/vnd.rn-realvideo-secure'); {Do not Localize}
|
||
AMIMEList.Add('.asx=video/x-ms-asf-plugin'); {Do not Localize}
|
||
AMIMEList.Add('.movie=video/x-sgi-movie'); {Do not Localize}
|
||
|
||
{ Application }
|
||
AMIMEList.Add('.7z=application/x-7z-compressed'); {Do not Localize}
|
||
AMIMEList.Add('.a=application/x-archive'); {Do not Localize}
|
||
AMIMEList.Add('.aab=application/x-authorware-bin'); {Do not Localize}
|
||
AMIMEList.Add('.aam=application/x-authorware-map'); {Do not Localize}
|
||
AMIMEList.Add('.aas=application/x-authorware-seg'); {Do not Localize}
|
||
AMIMEList.Add('.abw=application/x-abiword'); {Do not Localize}
|
||
AMIMEList.Add('.ace=application/x-ace-compressed'); {Do not Localize}
|
||
AMIMEList.Add('.ai=application/postscript'); {Do not Localize}
|
||
AMIMEList.Add('.alz=application/x-alz-compressed'); {Do not Localize}
|
||
AMIMEList.Add('.ani=application/x-navi-animation'); {Do not Localize}
|
||
AMIMEList.Add('.arj=application/x-arj'); {Do not Localize}
|
||
AMIMEList.Add('.asf=application/vnd.ms-asf'); {Do not Localize}
|
||
AMIMEList.Add('.bat=application/x-msdos-program'); {Do not Localize}
|
||
AMIMEList.Add('.bcpio=application/x-bcpio'); {Do not Localize}
|
||
AMIMEList.Add('.boz=application/x-bzip2'); {Do not Localize}
|
||
AMIMEList.Add('.bz=application/x-bzip');
|
||
AMIMEList.Add('.bz2=application/x-bzip2'); {Do not Localize}
|
||
AMIMEList.Add('.cab=application/vnd.ms-cab-compressed'); {Do not Localize}
|
||
AMIMEList.Add('.cat=application/vnd.ms-pki.seccat'); {Do not Localize}
|
||
AMIMEList.Add('.ccn=application/x-cnc'); {Do not Localize}
|
||
AMIMEList.Add('.cco=application/x-cocoa'); {Do not Localize}
|
||
AMIMEList.Add('.cdf=application/x-cdf'); {Do not Localize}
|
||
AMIMEList.Add('.cer=application/x-x509-ca-cert'); {Do not Localize}
|
||
AMIMEList.Add('.chm=application/vnd.ms-htmlhelp'); {Do not Localize}
|
||
AMIMEList.Add('.chrt=application/vnd.kde.kchart'); {Do not Localize}
|
||
AMIMEList.Add('.cil=application/vnd.ms-artgalry'); {Do not Localize}
|
||
AMIMEList.Add('.class=application/java-vm'); {Do not Localize}
|
||
AMIMEList.Add('.com=application/x-msdos-program'); {Do not Localize}
|
||
AMIMEList.Add('.clp=application/x-msclip'); {Do not Localize}
|
||
AMIMEList.Add('.cpio=application/x-cpio'); {Do not Localize}
|
||
AMIMEList.Add('.cpt=application/mac-compactpro'); {Do not Localize}
|
||
AMIMEList.Add('.cqk=application/x-calquick'); {Do not Localize}
|
||
AMIMEList.Add('.crd=application/x-mscardfile'); {Do not Localize}
|
||
AMIMEList.Add('.crl=application/pkix-crl'); {Do not Localize}
|
||
AMIMEList.Add('.csh=application/x-csh'); {Do not Localize}
|
||
AMIMEList.Add('.dar=application/x-dar'); {Do not Localize}
|
||
AMIMEList.Add('.dbf=application/x-dbase'); {Do not Localize}
|
||
AMIMEList.Add('.dcr=application/x-director'); {Do not Localize}
|
||
AMIMEList.Add('.deb=application/x-debian-package'); {Do not Localize}
|
||
AMIMEList.Add('.dir=application/x-director'); {Do not Localize}
|
||
AMIMEList.Add('.dist=vnd.apple.installer+xml'); {Do not Localize}
|
||
AMIMEList.Add('.distz=vnd.apple.installer+xml'); {Do not Localize}
|
||
AMIMEList.Add('.dll=application/x-msdos-program'); {Do not Localize}
|
||
AMIMEList.Add('.dmg=application/x-apple-diskimage'); {Do not Localize}
|
||
AMIMEList.Add('.doc=application/msword'); {Do not Localize}
|
||
AMIMEList.Add('.dot=application/msword'); {Do not Localize}
|
||
AMIMEList.Add('.dvi=application/x-dvi'); {Do not Localize}
|
||
AMIMEList.Add('.dxr=application/x-director'); {Do not Localize}
|
||
AMIMEList.Add('.ebk=application/x-expandedbook'); {Do not Localize}
|
||
AMIMEList.Add('.eps=application/postscript'); {Do not Localize}
|
||
AMIMEList.Add('.evy=application/envoy'); {Do not Localize}
|
||
AMIMEList.Add('.exe=application/x-msdos-program'); {Do not Localize}
|
||
AMIMEList.Add('.fdf=application/vnd.fdf'); {Do not Localize}
|
||
AMIMEList.Add('.fif=application/fractals'); {Do not Localize}
|
||
AMIMEList.Add('.flm=application/vnd.kde.kivio'); {Do not Localize}
|
||
AMIMEList.Add('.fml=application/x-file-mirror-list'); {Do not Localize}
|
||
AMIMEList.Add('.gzip=application/x-gzip'); {Do not Localize}
|
||
AMIMEList.Add('.gnumeric=application/x-gnumeric'); {Do not Localize}
|
||
AMIMEList.Add('.gtar=application/x-gtar'); {Do not Localize}
|
||
AMIMEList.Add('.gz=application/x-gzip'); {Do not Localize}
|
||
AMIMEList.Add('.hdf=application/x-hdf'); {Do not Localize}
|
||
AMIMEList.Add('.hlp=application/winhlp'); {Do not Localize}
|
||
AMIMEList.Add('.hpf=application/x-icq-hpf'); {Do not Localize}
|
||
AMIMEList.Add('.hqx=application/mac-binhex40'); {Do not Localize}
|
||
AMIMEList.Add('.hta=application/hta'); {Do not Localize}
|
||
AMIMEList.Add('.ims=application/vnd.ms-ims'); {Do not Localize}
|
||
AMIMEList.Add('.ins=application/x-internet-signup'); {Do not Localize}
|
||
AMIMEList.Add('.iii=application/x-iphone'); {Do not Localize}
|
||
AMIMEList.Add('.iso=application/x-iso9660-image'); {Do not Localize}
|
||
AMIMEList.Add('.jar=application/java-archive'); {Do not Localize}
|
||
AMIMEList.Add('.karbon=application/vnd.kde.karbon'); {Do not Localize}
|
||
AMIMEList.Add('.kfo=application/vnd.kde.kformula'); {Do not Localize}
|
||
AMIMEList.Add('.kon=application/vnd.kde.kontour'); {Do not Localize}
|
||
AMIMEList.Add('.kpr=application/vnd.kde.kpresenter'); {Do not Localize}
|
||
AMIMEList.Add('.kpt=application/vnd.kde.kpresenter'); {Do not Localize}
|
||
AMIMEList.Add('.kwd=application/vnd.kde.kword'); {Do not Localize}
|
||
AMIMEList.Add('.kwt=application/vnd.kde.kword'); {Do not Localize}
|
||
AMIMEList.Add('.latex=application/x-latex'); {Do not Localize}
|
||
AMIMEList.Add('.lha=application/x-lzh'); {Do not Localize}
|
||
AMIMEList.Add('.lcc=application/fastman'); {Do not Localize}
|
||
AMIMEList.Add('.lrm=application/vnd.ms-lrm'); {Do not Localize}
|
||
AMIMEList.Add('.lz=application/x-lzip'); {Do not Localize}
|
||
AMIMEList.Add('.lzh=application/x-lzh'); {Do not Localize}
|
||
AMIMEList.Add('.lzma=application/x-lzma'); {Do not Localize}
|
||
AMIMEList.Add('.lzo=application/x-lzop'); {Do not Localize}
|
||
AMIMEList.Add('.lzx=application/x-lzx');
|
||
AMIMEList.Add('.m13=application/x-msmediaview'); {Do not Localize}
|
||
AMIMEList.Add('.m14=application/x-msmediaview'); {Do not Localize}
|
||
AMIMEList.Add('.mpp=application/vnd.ms-project'); {Do not Localize}
|
||
AMIMEList.Add('.mvb=application/x-msmediaview'); {Do not Localize}
|
||
AMIMEList.Add('.man=application/x-troff-man'); {Do not Localize}
|
||
AMIMEList.Add('.mdb=application/x-msaccess'); {Do not Localize}
|
||
AMIMEList.Add('.me=application/x-troff-me'); {Do not Localize}
|
||
AMIMEList.Add('.ms=application/x-troff-ms'); {Do not Localize}
|
||
AMIMEList.Add('.msi=application/x-msi'); {Do not Localize}
|
||
AMIMEList.Add('.mpkg=vnd.apple.installer+xml'); {Do not Localize}
|
||
AMIMEList.Add('.mny=application/x-msmoney'); {Do not Localize}
|
||
AMIMEList.Add('.nix=application/x-mix-transfer'); {Do not Localize}
|
||
AMIMEList.Add('.o=application/x-object'); {Do not Localize}
|
||
AMIMEList.Add('.oda=application/oda'); {Do not Localize}
|
||
AMIMEList.Add('.odb=application/vnd.oasis.opendocument.database'); {Do not Localize}
|
||
AMIMEList.Add('.odc=application/vnd.oasis.opendocument.chart'); {Do not Localize}
|
||
AMIMEList.Add('.odf=application/vnd.oasis.opendocument.formula'); {Do not Localize}
|
||
AMIMEList.Add('.odg=application/vnd.oasis.opendocument.graphics'); {Do not Localize}
|
||
AMIMEList.Add('.odi=application/vnd.oasis.opendocument.image'); {Do not Localize}
|
||
AMIMEList.Add('.odm=application/vnd.oasis.opendocument.text-master'); {Do not Localize}
|
||
AMIMEList.Add('.odp=application/vnd.oasis.opendocument.presentation'); {Do not Localize}
|
||
AMIMEList.Add('.ods=application/vnd.oasis.opendocument.spreadsheet'); {Do not Localize}
|
||
AMIMEList.Add('.ogg=application/ogg'); {Do not Localize}
|
||
AMIMEList.Add('.odt=application/vnd.oasis.opendocument.text'); {Do not Localize}
|
||
AMIMEList.Add('.otg=application/vnd.oasis.opendocument.graphics-template'); {Do not Localize}
|
||
AMIMEList.Add('.oth=application/vnd.oasis.opendocument.text-web'); {Do not Localize}
|
||
AMIMEList.Add('.otp=application/vnd.oasis.opendocument.presentation-template'); {Do not Localize}
|
||
AMIMEList.Add('.ots=application/vnd.oasis.opendocument.spreadsheet-template'); {Do not Localize}
|
||
AMIMEList.Add('.ott=application/vnd.oasis.opendocument.text-template'); {Do not Localize}
|
||
AMIMEList.Add('.p10=application/pkcs10'); {Do not Localize}
|
||
AMIMEList.Add('.p12=application/x-pkcs12'); {Do not Localize}
|
||
AMIMEList.Add('.p7b=application/x-pkcs7-certificates'); {Do not Localize}
|
||
AMIMEList.Add('.p7m=application/pkcs7-mime'); {Do not Localize}
|
||
AMIMEList.Add('.p7r=application/x-pkcs7-certreqresp'); {Do not Localize}
|
||
AMIMEList.Add('.p7s=application/pkcs7-signature'); {Do not Localize}
|
||
AMIMEList.Add('.package=application/vnd.autopackage'); {Do not Localize}
|
||
AMIMEList.Add('.pfr=application/font-tdpfr'); {Do not Localize}
|
||
AMIMEList.Add('.pkg=vnd.apple.installer+xml'); {Do not Localize}
|
||
AMIMEList.Add('.pdf=application/pdf'); {Do not Localize}
|
||
AMIMEList.Add('.pko=application/vnd.ms-pki.pko'); {Do not Localize}
|
||
AMIMEList.Add('.pl=application/x-perl'); {Do not Localize}
|
||
AMIMEList.Add('.pnq=application/x-icq-pnq'); {Do not Localize}
|
||
AMIMEList.Add('.pot=application/mspowerpoint'); {Do not Localize}
|
||
AMIMEList.Add('.pps=application/mspowerpoint'); {Do not Localize}
|
||
AMIMEList.Add('.ppt=application/mspowerpoint'); {Do not Localize}
|
||
AMIMEList.Add('.ppz=application/mspowerpoint'); {Do not Localize}
|
||
AMIMEList.Add('.ps=application/postscript'); {Do not Localize}
|
||
AMIMEList.Add('.pub=application/x-mspublisher'); {Do not Localize}
|
||
AMIMEList.Add('.qpw=application/x-quattropro'); {Do not Localize}
|
||
AMIMEList.Add('.qtl=application/x-quicktimeplayer'); {Do not Localize}
|
||
AMIMEList.Add('.rar=application/rar'); {Do not Localize}
|
||
AMIMEList.Add('.rdf=application/rdf+xml'); {Do not Localize}
|
||
AMIMEList.Add('.rjs=application/vnd.rn-realsystem-rjs'); {Do not Localize}
|
||
AMIMEList.Add('.rm=application/vnd.rn-realmedia'); {Do not Localize}
|
||
AMIMEList.Add('.rmf=application/vnd.rmf'); {Do not Localize}
|
||
AMIMEList.Add('.rmp=application/vnd.rn-rn_music_package'); {Do not Localize}
|
||
AMIMEList.Add('.rmx=application/vnd.rn-realsystem-rmx'); {Do not Localize}
|
||
AMIMEList.Add('.rnx=application/vnd.rn-realplayer'); {Do not Localize}
|
||
AMIMEList.Add('.rpm=application/x-redhat-package-manager');
|
||
AMIMEList.Add('.rsml=application/vnd.rn-rsml'); {Do not Localize}
|
||
AMIMEList.Add('.rtsp=application/x-rtsp'); {Do not Localize}
|
||
AMIMEList.Add('.rss=application/rss+xml'); {Do not Localize}
|
||
AMIMEList.Add('.scm=application/x-icq-scm'); {Do not Localize}
|
||
AMIMEList.Add('.ser=application/java-serialized-object'); {Do not Localize}
|
||
AMIMEList.Add('.scd=application/x-msschedule'); {Do not Localize}
|
||
AMIMEList.Add('.sda=application/vnd.stardivision.draw'); {Do not Localize}
|
||
AMIMEList.Add('.sdc=application/vnd.stardivision.calc'); {Do not Localize}
|
||
AMIMEList.Add('.sdd=application/vnd.stardivision.impress'); {Do not Localize}
|
||
AMIMEList.Add('.sdp=application/x-sdp'); {Do not Localize}
|
||
AMIMEList.Add('.setpay=application/set-payment-initiation'); {Do not Localize}
|
||
AMIMEList.Add('.setreg=application/set-registration-initiation'); {Do not Localize}
|
||
AMIMEList.Add('.sh=application/x-sh'); {Do not Localize}
|
||
AMIMEList.Add('.shar=application/x-shar'); {Do not Localize}
|
||
AMIMEList.Add('.shw=application/presentations'); {Do not Localize}
|
||
AMIMEList.Add('.sit=application/x-stuffit'); {Do not Localize}
|
||
AMIMEList.Add('.sitx=application/x-stuffitx'); {Do not localize}
|
||
AMIMEList.Add('.skd=application/x-koan'); {Do not Localize}
|
||
AMIMEList.Add('.skm=application/x-koan'); {Do not Localize}
|
||
AMIMEList.Add('.skp=application/x-koan'); {Do not Localize}
|
||
AMIMEList.Add('.skt=application/x-koan'); {Do not Localize}
|
||
AMIMEList.Add('.smf=application/vnd.stardivision.math'); {Do not Localize}
|
||
AMIMEList.Add('.smi=application/smil'); {Do not Localize}
|
||
AMIMEList.Add('.smil=application/smil'); {Do not Localize}
|
||
AMIMEList.Add('.spl=application/futuresplash'); {Do not Localize}
|
||
AMIMEList.Add('.ssm=application/streamingmedia'); {Do not Localize}
|
||
AMIMEList.Add('.sst=application/vnd.ms-pki.certstore'); {Do not Localize}
|
||
AMIMEList.Add('.stc=application/vnd.sun.xml.calc.template'); {Do not Localize}
|
||
AMIMEList.Add('.std=application/vnd.sun.xml.draw.template'); {Do not Localize}
|
||
AMIMEList.Add('.sti=application/vnd.sun.xml.impress.template'); {Do not Localize}
|
||
AMIMEList.Add('.stl=application/vnd.ms-pki.stl'); {Do not Localize}
|
||
AMIMEList.Add('.stw=application/vnd.sun.xml.writer.template'); {Do not Localize}
|
||
AMIMEList.Add('.svi=application/softvision'); {Do not Localize}
|
||
AMIMEList.Add('.sv4cpio=application/x-sv4cpio'); {Do not Localize}
|
||
AMIMEList.Add('.sv4crc=application/x-sv4crc'); {Do not Localize}
|
||
AMIMEList.Add('.swf=application/x-shockwave-flash'); {Do not Localize}
|
||
AMIMEList.Add('.swf1=application/x-shockwave-flash'); {Do not Localize}
|
||
AMIMEList.Add('.sxc=application/vnd.sun.xml.calc'); {Do not Localize}
|
||
AMIMEList.Add('.sxi=application/vnd.sun.xml.impress'); {Do not Localize}
|
||
AMIMEList.Add('.sxm=application/vnd.sun.xml.math'); {Do not Localize}
|
||
AMIMEList.Add('.sxw=application/vnd.sun.xml.writer'); {Do not Localize}
|
||
AMIMEList.Add('.sxg=application/vnd.sun.xml.writer.global'); {Do not Localize}
|
||
AMIMEList.Add('.t=application/x-troff'); {Do not Localize}
|
||
AMIMEList.Add('.tar=application/x-tar'); {Do not Localize}
|
||
AMIMEList.Add('.tcl=application/x-tcl'); {Do not Localize}
|
||
AMIMEList.Add('.tex=application/x-tex'); {Do not Localize}
|
||
AMIMEList.Add('.texi=application/x-texinfo'); {Do not Localize}
|
||
AMIMEList.Add('.texinfo=application/x-texinfo'); {Do not Localize}
|
||
AMIMEList.Add('.tbz=application/x-bzip-compressed-tar'); {Do not Localize}
|
||
AMIMEList.Add('.tbz2=application/x-bzip-compressed-tar'); {Do not Localize}
|
||
AMIMEList.Add('.tgz=application/x-compressed-tar'); {Do not Localize}
|
||
AMIMEList.Add('.tlz=application/x-lzma-compressed-tar'); {Do not Localize}
|
||
AMIMEList.Add('.tr=application/x-troff'); {Do not Localize}
|
||
AMIMEList.Add('.trm=application/x-msterminal'); {Do not Localize}
|
||
AMIMEList.Add('.troff=application/x-troff'); {Do not Localize}
|
||
AMIMEList.Add('.tsp=application/dsptype'); {Do not Localize}
|
||
AMIMEList.Add('.torrent=application/x-bittorrent'); {Do not Localize}
|
||
AMIMEList.Add('.ttz=application/t-time'); {Do not Localize}
|
||
AMIMEList.Add('.txz=application/x-xz-compressed-tar'); {Do not localize}
|
||
AMIMEList.Add('.udeb=application/x-debian-package'); {Do not Localize}
|
||
|
||
AMIMEList.Add('.uin=application/x-icq'); {Do not Localize}
|
||
AMIMEList.Add('.urls=application/x-url-list'); {Do not Localize}
|
||
AMIMEList.Add('.ustar=application/x-ustar'); {Do not Localize}
|
||
AMIMEList.Add('.vcd=application/x-cdlink'); {Do not Localize}
|
||
AMIMEList.Add('.vor=application/vnd.stardivision.writer'); {Do not Localize}
|
||
AMIMEList.Add('.vsl=application/x-cnet-vsl'); {Do not Localize}
|
||
AMIMEList.Add('.wcm=application/vnd.ms-works'); {Do not Localize}
|
||
AMIMEList.Add('.wb1=application/x-quattropro'); {Do not Localize}
|
||
AMIMEList.Add('.wb2=application/x-quattropro'); {Do not Localize}
|
||
AMIMEList.Add('.wb3=application/x-quattropro'); {Do not Localize}
|
||
AMIMEList.Add('.wdb=application/vnd.ms-works'); {Do not Localize}
|
||
AMIMEList.Add('.wks=application/vnd.ms-works'); {Do not Localize}
|
||
AMIMEList.Add('.wmd=application/x-ms-wmd'); {Do not Localize}
|
||
AMIMEList.Add('.wms=application/x-ms-wms'); {Do not Localize}
|
||
AMIMEList.Add('.wmz=application/x-ms-wmz'); {Do not Localize}
|
||
AMIMEList.Add('.wp5=application/wordperfect5.1'); {Do not Localize}
|
||
AMIMEList.Add('.wpd=application/wordperfect'); {Do not Localize}
|
||
AMIMEList.Add('.wpl=application/vnd.ms-wpl'); {Do not Localize}
|
||
AMIMEList.Add('.wps=application/vnd.ms-works'); {Do not Localize}
|
||
AMIMEList.Add('.wri=application/x-mswrite'); {Do not Localize}
|
||
AMIMEList.Add('.xfdf=application/vnd.adobe.xfdf'); {Do not Localize}
|
||
AMIMEList.Add('.xls=application/x-msexcel'); {Do not Localize}
|
||
AMIMEList.Add('.xlb=application/x-msexcel'); {Do not Localize}
|
||
AMIMEList.Add('.xpi=application/x-xpinstall'); {Do not Localize}
|
||
AMIMEList.Add('.xps=application/vnd.ms-xpsdocument'); {Do not Localize}
|
||
AMIMEList.Add('.xsd=application/vnd.sun.xml.draw'); {Do not Localize}
|
||
AMIMEList.Add('.xul=application/vnd.mozilla.xul+xml'); {Do not Localize}
|
||
AMIMEList.Add('.z=application/x-compress'); {Do not Localize}
|
||
AMIMEList.Add('.zoo=application/x-zoo'); {Do not Localize}
|
||
AMIMEList.Add('.zip=application/x-zip-compressed'); {Do not Localize}
|
||
|
||
{ WAP }
|
||
AMIMEList.Add('.wbmp=image/vnd.wap.wbmp'); {Do not Localize}
|
||
AMIMEList.Add('.wml=text/vnd.wap.wml'); {Do not Localize}
|
||
AMIMEList.Add('.wmlc=application/vnd.wap.wmlc'); {Do not Localize}
|
||
AMIMEList.Add('.wmls=text/vnd.wap.wmlscript'); {Do not Localize}
|
||
AMIMEList.Add('.wmlsc=application/vnd.wap.wmlscriptc'); {Do not Localize}
|
||
|
||
{ Non-web text}
|
||
{
|
||
IMPORTANT!!
|
||
|
||
You should not use a text MIME type definition unless you are
|
||
extremely certain that the file will NOT be a binary. Some browsers
|
||
will display the text instead of saving to disk and it looks ugly
|
||
if a web-browser shows all of the 8bit charactors.
|
||
}
|
||
//of course, we have to add this :-).
|
||
AMIMEList.Add('.asm=text/x-asm'); {Do not Localize}
|
||
AMIMEList.Add('.p=text/x-pascal'); {Do not Localize}
|
||
AMIMEList.Add('.pas=text/x-pascal'); {Do not Localize}
|
||
|
||
AMIMEList.Add('.cs=text/x-csharp'); {Do not Localize}
|
||
|
||
AMIMEList.Add('.c=text/x-csrc'); {Do not Localize}
|
||
AMIMEList.Add('.c++=text/x-c++src'); {Do not Localize}
|
||
AMIMEList.Add('.cpp=text/x-c++src'); {Do not Localize}
|
||
AMIMEList.Add('.cxx=text/x-c++src'); {Do not Localize}
|
||
AMIMEList.Add('.cc=text/x-c++src'); {Do not Localize}
|
||
AMIMEList.Add('.h=text/x-chdr'); {Do not localize}
|
||
AMIMEList.Add('.h++=text/x-c++hdr'); {Do not Localize}
|
||
AMIMEList.Add('.hpp=text/x-c++hdr'); {Do not Localize}
|
||
AMIMEList.Add('.hxx=text/x-c++hdr'); {Do not Localize}
|
||
AMIMEList.Add('.hh=text/x-c++hdr'); {Do not Localize}
|
||
AMIMEList.Add('.java=text/x-java'); {Do not Localize}
|
||
|
||
{ WEB }
|
||
AMIMEList.Add('.css=text/css'); {Do not Localize}
|
||
AMIMEList.Add('.js=text/javascript'); {Do not Localize}
|
||
AMIMEList.Add('.htm=text/html'); {Do not Localize}
|
||
AMIMEList.Add('.html=text/html'); {Do not Localize}
|
||
AMIMEList.Add('.xhtml=application/xhtml+xml'); {Do not localize}
|
||
AMIMEList.Add('.xht=application/xhtml+xml'); {Do not localize}
|
||
AMIMEList.Add('.rdf=application/rdf+xml'); {Do not localize}
|
||
AMIMEList.Add('.rss=application/rss+xml'); {Do not localize}
|
||
|
||
AMIMEList.Add('.ls=text/javascript'); {Do not Localize}
|
||
AMIMEList.Add('.mocha=text/javascript'); {Do not Localize}
|
||
AMIMEList.Add('.shtml=server-parsed-html'); {Do not Localize}
|
||
AMIMEList.Add('.xml=text/xml'); {Do not Localize}
|
||
AMIMEList.Add('.sgm=text/sgml'); {Do not Localize}
|
||
AMIMEList.Add('.sgml=text/sgml'); {Do not Localize}
|
||
|
||
{ Message }
|
||
AMIMEList.Add('.mht=message/rfc822'); {Do not Localize}
|
||
|
||
if not ALoadFromOS then begin
|
||
Exit;
|
||
end;
|
||
|
||
{$IFDEF WINDOWS}
|
||
// Build the file type/MIME type map
|
||
Reg := TRegistry.Create;
|
||
try
|
||
KeyList := TStringList.create;
|
||
try
|
||
Reg.RootKey := HKEY_CLASSES_ROOT;
|
||
if Reg.OpenKeyReadOnly('\') then begin {do not localize}
|
||
Reg.GetKeyNames(KeyList);
|
||
Reg.Closekey;
|
||
end;
|
||
// get a list of registered extentions
|
||
for i := 0 to KeyList.Count - 1 do begin
|
||
LExt := KeyList[i];
|
||
if TextStartsWith(LExt, '.') then begin {do not localize}
|
||
if Reg.OpenKeyReadOnly(LExt) then begin
|
||
s := Reg.ReadString('Content Type'); {do not localize}
|
||
if Length(s) > 0 then begin
|
||
AMIMEList.Values[IndyLowerCase(LExt)] := IndyLowerCase(s);
|
||
end;
|
||
Reg.CloseKey;
|
||
end;
|
||
end;
|
||
end;
|
||
if Reg.OpenKeyReadOnly('\MIME\Database\Content Type') then begin {do not localize}
|
||
// get a list of registered MIME types
|
||
KeyList.Clear;
|
||
Reg.GetKeyNames(KeyList);
|
||
Reg.CloseKey;
|
||
|
||
for i := 0 to KeyList.Count - 1 do begin
|
||
if Reg.OpenKeyReadOnly('\MIME\Database\Content Type\' + KeyList[i]) then begin {do not localize}
|
||
LExt := IndyLowerCase(Reg.ReadString('Extension')); {do not localize}
|
||
if Length(LExt) > 0 then begin
|
||
if LExt[1] <> '.' then begin
|
||
LExt := '.' + LExt; {do not localize}
|
||
end;
|
||
AMIMEList.Values[LExt] := IndyLowerCase(KeyList[i]);
|
||
end;
|
||
Reg.CloseKey;
|
||
end;
|
||
end;
|
||
end;
|
||
finally
|
||
KeyList.Free;
|
||
end;
|
||
finally
|
||
Reg.Free;
|
||
end;
|
||
{$ENDIF}
|
||
{$IFDEF UNIX}
|
||
{
|
||
/etc/mime.types is not present in all Linux distributions.
|
||
|
||
It turns out that "/etc/htdig/mime.types" and
|
||
"/etc/usr/share/webmin/mime..types" are in the same format as what
|
||
Johannes Berg had expected.
|
||
|
||
Just read those files for best coverage. MIME Tables are not centralized
|
||
on Linux.
|
||
}
|
||
LoadMIME('/etc/mime.types', AMIMEList); {do not localize}
|
||
LoadMIME('/etc/htdig/mime.types', AMIMEList); {do not localize}
|
||
LoadMIME('/etc/usr/share/webmin/mime.types', AMIMEList); {do not localize}
|
||
{$ENDIF}
|
||
end;
|
||
|
||
procedure TIdMimeTable.AddMimeType(const Ext, MIMEType: string; const ARaiseOnError: Boolean = True);
|
||
var
|
||
LExt,
|
||
LMIMEType: string;
|
||
begin
|
||
{ Check and fix extension }
|
||
LExt := IndyLowerCase(Ext);
|
||
if Length(LExt) = 0 then begin
|
||
if ARaiseOnError then begin
|
||
raise EIdException.Create(RSMIMEExtensionEmpty);
|
||
end;
|
||
Exit;
|
||
end;
|
||
{ Check and fix MIMEType }
|
||
LMIMEType := IndyLowerCase(MIMEType);
|
||
if Length(LMIMEType) = 0 then begin
|
||
if ARaiseOnError then begin
|
||
raise EIdException.Create(RSMIMEMIMETypeEmpty);
|
||
end;
|
||
Exit;
|
||
end;
|
||
if LExt[1] <> '.' then begin {do not localize}
|
||
LExt := '.' + LExt; {do not localize}
|
||
end;
|
||
{ Check list }
|
||
if FFileExt.IndexOf(LExt) = -1 then begin
|
||
FFileExt.Add(LExt);
|
||
FMIMEList.Add(LMIMEType);
|
||
end else begin
|
||
if ARaiseOnError then begin
|
||
raise EIdException.Create(RSMIMEMIMEExtAlreadyExists);
|
||
end;
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
procedure TIdMimeTable.BuildCache;
|
||
begin
|
||
if Assigned(FOnBuildCache) then begin
|
||
FOnBuildCache(Self);
|
||
end else begin
|
||
if FFileExt.Count = 0 then begin
|
||
BuildDefaultCache;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TIdMimeTable.BuildDefaultCache;
|
||
{This is just to provide some default values only}
|
||
var
|
||
LKeys : TStringList;
|
||
begin
|
||
LKeys := TStringList.Create;
|
||
try
|
||
FillMIMETable(LKeys, LoadTypesFromOS);
|
||
LoadFromStrings(LKeys);
|
||
finally
|
||
FreeAndNil(LKeys);
|
||
end;
|
||
end;
|
||
|
||
constructor TIdMimeTable.Create(const AutoFill: Boolean);
|
||
begin
|
||
inherited Create;
|
||
FLoadTypesFromOS := True;
|
||
FFileExt := TStringList.Create;
|
||
FMIMEList := TStringList.Create;
|
||
if AutoFill then begin
|
||
BuildCache;
|
||
end;
|
||
end;
|
||
|
||
destructor TIdMimeTable.Destroy;
|
||
begin
|
||
FreeAndNil(FMIMEList);
|
||
FreeAndNil(FFileExt);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TIdMimeTable.GetDefaultFileExt(const MIMEType: string): String;
|
||
var
|
||
Index : Integer;
|
||
LMimeType: string;
|
||
begin
|
||
LMimeType := IndyLowerCase(MIMEType);
|
||
Index := FMIMEList.IndexOf(LMimeType);
|
||
if Index = -1 then begin
|
||
BuildCache;
|
||
Index := FMIMEList.IndexOf(LMIMEType);
|
||
end;
|
||
if Index <> -1 then begin
|
||
Result := FFileExt[Index];
|
||
end else begin
|
||
Result := ''; {Do not Localize}
|
||
end;
|
||
end;
|
||
|
||
function TIdMimeTable.GetFileMIMEType(const AFileName: string): string;
|
||
var
|
||
Index : Integer;
|
||
LExt: string;
|
||
begin
|
||
LExt := IndyLowerCase(ExtractFileExt(AFileName));
|
||
|
||
Index := FFileExt.IndexOf(LExt);
|
||
if Index = -1 then begin
|
||
BuildCache;
|
||
Index := FFileExt.IndexOf(LExt);
|
||
end;
|
||
if Index <> -1 then begin
|
||
Result := FMIMEList[Index];
|
||
end else begin
|
||
Result := 'application/octet-stream' {do not localize}
|
||
end;
|
||
end;
|
||
|
||
procedure TIdMimeTable.LoadFromStrings(const AStrings: TStrings; const MimeSeparator: Char = '='); {Do not Localize}
|
||
var
|
||
I, P: Integer;
|
||
S, Ext: string;
|
||
begin
|
||
Assert(AStrings <> nil);
|
||
|
||
FFileExt.Clear;
|
||
FMIMEList.Clear;
|
||
|
||
for I := 0 to AStrings.Count - 1 do begin
|
||
S := AStrings[I];
|
||
P := Pos(MimeSeparator, S);
|
||
if P > 0 then begin
|
||
Ext := IndyLowerCase(Copy(S, 1, P - 1));
|
||
AddMimeType(Ext, Copy(S, P + 1, MaxInt), False);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
procedure TIdMimeTable.SaveToStrings(const AStrings: TStrings;
|
||
const MimeSeparator: Char);
|
||
var
|
||
I : Integer;
|
||
begin
|
||
Assert(AStrings <> nil);
|
||
AStrings.Clear;
|
||
for I := 0 to FFileExt.Count - 1 do begin
|
||
AStrings.Add(FFileExt[I] + MimeSeparator + FMIMEList[I]);
|
||
end;
|
||
end;
|
||
|
||
function IsValidIP(const S: String): Boolean;
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
var
|
||
LErr: Boolean;
|
||
begin
|
||
LErr := False; // keep the compiler happy
|
||
IPv4ToUInt32(S, LErr);
|
||
if LErr then begin
|
||
LErr := (MakeCanonicalIPv6Address(S) = '');
|
||
end;
|
||
Result := not LErr;
|
||
end;
|
||
|
||
//everything that does not start with '.' is treated as hostname
|
||
function IsHostname(const S: String): Boolean;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := (not TextStartsWith(S, '.')) and (not IsValidIP(S)) ; {Do not Localize}
|
||
end;
|
||
|
||
function IsTopDomain(const AStr: string): Boolean;
|
||
Var
|
||
i: Integer;
|
||
S1,LTmp: String;
|
||
begin
|
||
i := 0;
|
||
|
||
LTmp := UpperCase(Trim(AStr));
|
||
while IndyPos('.', LTmp) > 0 do begin {Do not Localize}
|
||
S1 := LTmp;
|
||
Fetch(LTmp, '.'); {Do not Localize}
|
||
i := i + 1;
|
||
end;
|
||
|
||
Result := ((Length(LTmp) > 2) and (i = 1));
|
||
if Length(LTmp) = 2 then begin // Country domain names
|
||
S1 := Fetch(S1, '.'); {Do not Localize}
|
||
// here will be the exceptions check: com.uk, co.uk, com.tw and etc.
|
||
if LTmp = 'UK' then begin {Do not Localize}
|
||
if S1 = 'CO' then begin
|
||
result := i = 2; {Do not Localize}
|
||
end;
|
||
if S1 = 'COM' then begin
|
||
result := i = 2; {Do not Localize}
|
||
end;
|
||
end;
|
||
if LTmp = 'TW' then begin {Do not Localize}
|
||
if S1 = 'CO' then begin
|
||
result := i = 2; {Do not Localize}
|
||
end;
|
||
if S1 = 'COM' then begin
|
||
result := i = 2; {Do not Localize}
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function IsDomain(const S: String): Boolean;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := (not IsHostname(S)) and (IndyPos('.', S) > 0) and (not IsTopDomain(S)); {Do not Localize}
|
||
end;
|
||
|
||
function DomainName(const AHost: String): String;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := Copy(AHost, IndyPos('.', AHost), Length(AHost)); {Do not Localize}
|
||
end;
|
||
|
||
function IsFQDN(const S: String): Boolean;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := IsHostName(S) and IsDomain(DomainName(S));
|
||
end;
|
||
|
||
// The password for extracting password.bin from password.zip is indyrules
|
||
|
||
function PadString(const AString : String; const ALen : Integer; const AChar: Char): String;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
if Length(Result) >= ALen then begin
|
||
Result := AString;
|
||
end else begin
|
||
Result := AString + StringOfChar(AChar, ALen-Length(AString));
|
||
end;
|
||
end;
|
||
|
||
function ProcessPath(const ABasePath: string;
|
||
const APath: string;
|
||
const APathDelim: string = '/'): string; {Do not Localize}
|
||
// Dont add / - sometimes a file is passed in as well and the only way to determine is
|
||
// to test against the actual targets
|
||
var
|
||
i: Integer;
|
||
LPreserveTrail: Boolean;
|
||
LWork: string;
|
||
begin
|
||
if TextStartsWith(APath, APathDelim) then begin
|
||
Result := APath;
|
||
end else begin
|
||
Result := ''; {Do not Localize}
|
||
LPreserveTrail := (Length(APath) = 0) or TextEndsWith(APath, APathDelim);
|
||
LWork := ABasePath;
|
||
// If LWork = '' then we just want it to be APath, no prefixed / {Do not Localize}
|
||
if (Length(LWork) > 0) and (not TextEndsWith(LWork, APathDelim)) then begin
|
||
LWork := LWork + APathDelim;
|
||
end;
|
||
LWork := LWork + APath;
|
||
if Length(LWork) > 0 then begin
|
||
i := 1;
|
||
while i <= Length(LWork) do begin
|
||
if LWork[i] = APathDelim then begin
|
||
if i = 1 then begin
|
||
Result := APathDelim;
|
||
end
|
||
else if not TextEndsWith(Result, APathDelim) then begin
|
||
Result := Result + LWork[i];
|
||
end;
|
||
end else begin
|
||
if LWork[i] = '.' then begin {Do not Localize}
|
||
// If the last character was a PathDelim then the . is a relative path modifier.
|
||
// If it doesnt follow a PathDelim, its part of a filename
|
||
if TextEndsWith(Result, APathDelim) and (Copy(LWork, i, 2) = '..') then begin {Do not Localize}
|
||
// Delete the last PathDelim
|
||
Delete(Result, Length(Result), 1);
|
||
// Delete up to the next PathDelim
|
||
while (Length(Result) > 0) and (not TextEndsWith(Result, APathDelim)) do begin
|
||
Delete(Result, Length(Result), 1);
|
||
end;
|
||
// Skip over second .
|
||
Inc(i);
|
||
end else begin
|
||
Result := Result + LWork[i];
|
||
end;
|
||
end else begin
|
||
Result := Result + LWork[i];
|
||
end;
|
||
end;
|
||
Inc(i);
|
||
end;
|
||
end;
|
||
// Sometimes .. semantics can put a PathDelim on the end
|
||
// But dont modify if it is only a PathDelim and nothing else, or it was there to begin with
|
||
if (Result <> APathDelim) and TextEndsWith(Result, APathDelim) and (not LPreserveTrail) then begin
|
||
Delete(Result, Length(Result), 1);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{** HTML Parsing code for extracting Metadata. It can also be the basis of a Full HTML parser ***}
|
||
|
||
const
|
||
HTML_DOCWHITESPACE = #0+#9+#10+#13+#32; {do not localize}
|
||
HTML_ALLOWABLE_ALPHANUMBERIC = 'abcdefghijklmnopqrstuvwxyz'+ {do not localize}
|
||
'ABCDEFGHIJKLMNOPQRSTUVWXYZ'+ {do not localize}
|
||
'1234567890-_:.'; {do not localize}
|
||
HTML_QUOTECHARS = '''"'; {do not localize}
|
||
HTML_MainDocParts : array [0..2] of string = ('TITLE','HEAD', 'BODY'); {do not localize}
|
||
HTML_HeadDocAttrs : array [0..3] of string = ('META','TITLE','SCRIPT','LINK'); {do not localize}
|
||
HTML_MetaAttrs : array [0..1] of string = ('HTTP-EQUIV', 'charset'); {do not localize}
|
||
|
||
function ParseUntilEndOfTag(const AStr : String; var VPos : Integer;
|
||
const ALen : Integer): String; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
var
|
||
LStart: Integer;
|
||
begin
|
||
LStart := VPos;
|
||
while VPos <= ALen do begin
|
||
if AStr[VPos] = '>' then begin {do not localize}
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
Result := Copy(AStr, LStart, VPos - LStart);
|
||
end;
|
||
|
||
procedure DiscardUntilEndOfTag(const AStr : String; var VPos : Integer;
|
||
const ALen : Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
while VPos <= ALen do begin
|
||
if AStr[VPos] = '>' then begin {do not localize}
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
end;
|
||
|
||
function ExtractDocWhiteSpace(const AStr : String; var VPos : Integer;
|
||
const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
var
|
||
LStart: Integer;
|
||
begin
|
||
LStart := VPos;
|
||
while VPos <= ALen do begin
|
||
if not CharIsInSet(AStr, VPos, HTML_DOCWHITESPACE) then begin
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
Result := Copy(AStr, LStart, VPos-LStart);
|
||
end;
|
||
|
||
procedure DiscardDocWhiteSpace(const AStr : String; var VPos : Integer; const ALen : Integer); {$IFDEF USE_INLINE}inline; {$ENDIF}
|
||
begin
|
||
while VPos <= ALen do begin
|
||
if not CharIsInSet(AStr, VPos, HTML_DOCWHITESPACE) then begin
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
end;
|
||
|
||
function ParseWord(const AStr : String; var VPos : Integer;
|
||
const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
var
|
||
LStart: Integer;
|
||
begin
|
||
LStart := VPos;
|
||
while VPos <= ALen do begin
|
||
if not CharIsInSet(AStr, VPos, HTML_ALLOWABLE_ALPHANUMBERIC) then begin
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
Result := Copy(AStr, LStart, VPos-LStart);
|
||
end;
|
||
|
||
procedure DiscardWord(const AStr : String; var VPos : Integer;
|
||
const ALen : Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
while VPos <= ALen do begin
|
||
if not CharIsInSet(AStr, VPos, HTML_ALLOWABLE_ALPHANUMBERIC) then begin
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
end;
|
||
|
||
function ParseUntil(const AStr : String; const AChar : Char;
|
||
var VPos : Integer; const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
var
|
||
LStart: Integer;
|
||
begin
|
||
LStart := VPos;
|
||
while VPos <= ALen do begin
|
||
if AStr[VPos] = AChar then begin
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
Result := Copy(AStr, LStart, VPos-LStart);
|
||
end;
|
||
|
||
procedure DiscardUntil(const AStr : String; const AChar : Char;
|
||
var VPos : Integer; const ALen : Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
while VPos <= ALen do begin
|
||
if AStr[VPos] = AChar then begin
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
end;
|
||
|
||
function ParseUntilCharOrEndOfTag(const AStr : String; const AChar: Char;
|
||
var VPos : Integer; const ALen : Integer): String; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
var
|
||
LStart: Integer;
|
||
begin
|
||
LStart := VPos;
|
||
while VPos <= ALen do begin
|
||
if (AStr[VPos] = AChar) or (AStr[VPos] = '>') then begin {do not localize}
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
Result := Copy(AStr, LStart, VPos - LStart);
|
||
end;
|
||
|
||
procedure DiscardUntilCharOrEndOfTag(const AStr : String; const AChar: Char;
|
||
var VPos : Integer; const ALen : Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
while VPos <= ALen do begin
|
||
if (AStr[VPos] = AChar) or (AStr[VPos] = '>') then begin {do not localize}
|
||
Break;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
end;
|
||
|
||
function ParseHTTPMetaEquiveData(const AStr : String; var VPos : Integer;
|
||
const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
var
|
||
LQuoteChar : Char;
|
||
LWord : String;
|
||
begin
|
||
Result := '';
|
||
DiscardDocWhiteSpace(AStr, VPos, ALen);
|
||
if CharIsInSet(AStr, VPos, HTML_QUOTECHARS) then begin
|
||
LQuoteChar := AStr[VPos];
|
||
Inc(VPos);
|
||
if VPos > ALen then begin
|
||
Exit;
|
||
end;
|
||
LWord := ParseUntil(AStr, LQuoteChar, VPos, ALen);
|
||
Inc(VPos);
|
||
end else begin
|
||
if VPos > ALen then begin
|
||
Exit;
|
||
end;
|
||
LWord := ParseWord(AStr, VPos, ALen);
|
||
end;
|
||
Result := LWord + ':'; {do not localize}
|
||
repeat
|
||
DiscardDocWhiteSpace(AStr, VPos, ALen);
|
||
if VPos > ALen then begin
|
||
Break;
|
||
end;
|
||
if AStr[VPos] = '/' then begin {do not localize}
|
||
Inc(VPos);
|
||
if VPos > ALen then begin
|
||
Break;
|
||
end;
|
||
end;
|
||
if AStr[VPos] = '>' then begin {do not localize}
|
||
Break;
|
||
end;
|
||
LWord := ParseWord(AStr, VPos, ALen);
|
||
if VPos > ALen then begin
|
||
Break;
|
||
end;
|
||
if AStr[VPos] = '=' then begin {do not localize}
|
||
Inc(VPos);
|
||
DiscardDocWhiteSpace(AStr, VPos, ALen);
|
||
if CharIsInSet(AStr, VPos, HTML_QUOTECHARS) then begin
|
||
LQuoteChar := AStr[VPos];
|
||
Inc(VPos);
|
||
if TextIsSame(LWord, 'CONTENT') then begin
|
||
Result := Result + ' ' + ParseUntil(AStr, LQuoteChar, VPos, ALen);
|
||
Inc(VPos);
|
||
// RLebeau: this is a special case for handling a malformed tag
|
||
// that was encountered in the wild:
|
||
// <meta http-equiv="Content-Type" content="text/html; charset="window-1255">
|
||
if VPos > ALen then begin
|
||
Break;
|
||
end;
|
||
if CharIsInSet(AStr, VPos, HTML_DOCWHITESPACE + '/>') then begin
|
||
Continue;
|
||
end;
|
||
Result := Result + ParseUntil(AStr, LQuoteChar, VPos, ALen);
|
||
Inc(VPos);
|
||
end else begin
|
||
DiscardUntil(AStr, LQuoteChar, VPos, ALen);
|
||
Inc(VPos);
|
||
end;
|
||
end else begin
|
||
if TextIsSame(LWord, 'CONTENT') then begin
|
||
Result := Result + ' ' + ParseUntilCharOrEndOfTag(AStr, ' ', VPos, ALen); {do not localize}
|
||
end else begin
|
||
DiscardUntilCharOrEndOfTag(AStr, ' ', VPos, ALen); {do not localize}
|
||
end;
|
||
end;
|
||
end else begin
|
||
Inc(VPos);
|
||
end;
|
||
until False;
|
||
end;
|
||
|
||
function ParseMetaCharsetData(const AStr : String; var VPos : Integer;
|
||
const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
var
|
||
LQuoteChar : Char;
|
||
LWord : String;
|
||
begin
|
||
Result := '';
|
||
DiscardDocWhiteSpace(AStr, VPos, ALen);
|
||
if CharIsInSet(AStr, VPos, HTML_QUOTECHARS) then begin
|
||
LQuoteChar := AStr[VPos];
|
||
Inc(VPos);
|
||
if VPos > ALen then begin
|
||
Exit;
|
||
end;
|
||
LWord := ParseUntil(AStr, LQuoteChar, VPos, ALen);
|
||
Inc(VPos);
|
||
end else begin
|
||
if VPos > ALen then begin
|
||
Exit;
|
||
end;
|
||
LWord := ParseWord(AStr, VPos, ALen);
|
||
end;
|
||
DiscardUntilEndOfTag(AStr, VPos, ALen);
|
||
Result := LWord;
|
||
end;
|
||
|
||
procedure DiscardToEndOfComment(const AStr : String; var VPos : Integer; const ALen : Integer); {$IFDEF USE_INLINE}inline; {$ENDIF}
|
||
var
|
||
i : Integer;
|
||
begin
|
||
DiscardUntil(AStr, '-', VPos, ALen); {do not localize}
|
||
i := 0;
|
||
while VPos <= ALen do begin
|
||
if AStr[VPos] = '-' then begin {do not localize}
|
||
if i < 2 then begin
|
||
Inc(i);
|
||
end;
|
||
end else begin
|
||
if (AStr[VPos] = '>') and (i = 2) then begin {do not localize}
|
||
Break;
|
||
end;
|
||
i := 0;
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
end;
|
||
|
||
function ParseForCloseTag(const AStr, ATagWord : String; var VPos : Integer; const ALen : Integer) : String; {$IFDEF USE_INLINE}inline; {$ENDIF}
|
||
var
|
||
LWord, LTmp : String;
|
||
begin
|
||
Result := '';
|
||
while VPos <= ALen do begin
|
||
Result := Result + ParseUntil(AStr, '<', VPos, ALen); {do not localize}
|
||
if AStr[VPos] = '<' then begin
|
||
Inc(VPos);
|
||
end;
|
||
LTmp := '<' + ExtractDocWhiteSpace(AStr, VPos, ALen); {do not localize}
|
||
if AStr[VPos] = '/' then begin {do not localize}
|
||
Inc(VPos);
|
||
LTmp := LTmp + '/'; {do not localize}
|
||
LWord := ParseWord(AStr, VPos, ALen);
|
||
if TextIsSame(LWord, ATagWord) then begin
|
||
DiscardUntilEndOfTag(AStr, VPos, ALen);
|
||
Break;
|
||
end;
|
||
end;
|
||
Result := Result + LTmp + LWord + ParseUntilEndOfTag(AStr, VPos, ALen); {do not localize}
|
||
Inc(VPos);
|
||
end;
|
||
end;
|
||
|
||
procedure DiscardUntilCloseTag(const AStr, ATagWord : String; var VPos : Integer;
|
||
const ALen : Integer; const AIsScript : Boolean = False); {$IFDEF USE_INLINE}inline; {$ENDIF}
|
||
var
|
||
LWord, LTmp : String;
|
||
begin
|
||
while VPos <= ALen do begin
|
||
DiscardUntil(AStr, '<', VPos, ALen); {do not localize}
|
||
if AStr[VPos] = '<' then begin {do not localize}
|
||
Inc(VPos);
|
||
end;
|
||
LTmp := '<' + ExtractDocWhiteSpace(AStr, VPos, ALen);
|
||
if AStr[VPos] = '/' then begin {do not localize}
|
||
Inc(VPos);
|
||
LTmp := LTmp + '/'; {do not localize}
|
||
LWord := ParseWord(AStr, VPos, ALen);
|
||
if TextIsSame(LWord, ATagWord) then begin
|
||
DiscardUntilEndOfTag(AStr, VPos, ALen);
|
||
Break;
|
||
end;
|
||
end;
|
||
if not AIsScript then begin
|
||
DiscardUntilEndOfTag(AStr, VPos, ALen);
|
||
end;
|
||
Inc(VPos);
|
||
end;
|
||
end;
|
||
|
||
procedure ParseMetaHTTPEquiv(AStream: TStream; AHeaders : TStrings; var VCharSet: string);
|
||
type
|
||
TIdHTMLMode = (none, html, title, head, body, comment);
|
||
var
|
||
LRawData : String;
|
||
LWord : String;
|
||
LMode : TIdHTMLMode;
|
||
LPos : Integer;
|
||
LLen : Integer;
|
||
LEncoding: IIdTextEncoding;
|
||
begin
|
||
VCharSet := '';
|
||
// AHeaders.Clear;
|
||
AStream.Position := 0;
|
||
LEncoding := IndyTextEncoding_8Bit;
|
||
// TODO: parse the stream as-is without reading it into a String first...
|
||
LRawData := ReadStringFromStream(AStream, -1, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
|
||
LEncoding := nil;
|
||
LMode := none;
|
||
LPos := 0;
|
||
LLen := Length(LRawData);
|
||
repeat
|
||
Inc(LPos);
|
||
if LPos > LLen then begin
|
||
Break;
|
||
end;
|
||
if LRawData[LPos] = '<' then begin {do not localize}
|
||
Inc(LPos);
|
||
if LPos > LLen then begin
|
||
Break;
|
||
end;
|
||
if LRawData[LPos] = '?' then begin {do not localize}
|
||
Inc(LPos);
|
||
if LPos > LLen then begin
|
||
Break;
|
||
end;
|
||
end
|
||
else if LRawData[LPos] = '!' then begin {do not localize}
|
||
Inc(LPos);
|
||
if LPos > LLen then begin
|
||
Break;
|
||
end;
|
||
//we have to handle comments separately since they appear in any mode.
|
||
if Copy(LRawData, LPos, 2) = '--' then begin {do not localize}
|
||
Inc(LPos, 2);
|
||
DiscardToEndOfComment(LRawData, LPos, LLen);
|
||
Continue;
|
||
end;
|
||
end;
|
||
DiscardDocWhiteSpace(LRawData, LPos, LLen);
|
||
LWord := ParseWord(LRawData, LPos, LLen);
|
||
case LMode of
|
||
none :
|
||
begin
|
||
DiscardUntilEndOfTag(LRawData, LPos, LLen);
|
||
if TextIsSame(LWord, 'HTML') then begin
|
||
LMode := html;
|
||
end;
|
||
end;
|
||
html :
|
||
begin
|
||
DiscardUntilEndOfTag(LRawData, LPos, LLen);
|
||
case PosInStrArray(LWord, HTML_MainDocParts, False) of
|
||
0 : LMode := title;//title
|
||
1 : LMode := head; //head
|
||
2 : LMode := body; //body
|
||
end;
|
||
end;
|
||
head :
|
||
begin
|
||
case PosInStrArray(LWord, HTML_HeadDocAttrs, False) of
|
||
0 : //'META'
|
||
begin
|
||
DiscardDocWhiteSpace(LRawData, LPos, LLen);
|
||
LWord := ParseWord(LRawData, LPos, LLen);
|
||
// '<meta http-equiv="..." content="...">'
|
||
// '<meta charset="...">' (used in HTML5)
|
||
// TODO: use ParseUntilEndOfTag() here
|
||
case PosInStrArray(LWord, HTML_MetaAttrs, False) of {do not localize}
|
||
0: // HTTP-EQUIV
|
||
begin
|
||
DiscardDocWhiteSpace(LRawData, LPos, LLen);
|
||
if LRawData[LPos] = '=' then begin {do not localize}
|
||
Inc(LPos);
|
||
if LPos > LLen then begin
|
||
Break;
|
||
end;
|
||
if AHeaders <> nil then begin
|
||
AHeaders.Add( ParseHTTPMetaEquiveData(LRawData, LPos, LLen) );
|
||
end else begin
|
||
ParseHTTPMetaEquiveData(LRawData, LPos, LLen);
|
||
end;
|
||
end;
|
||
end;
|
||
1: // charset
|
||
begin
|
||
DiscardDocWhiteSpace(LRawData, LPos, LLen);
|
||
if LRawData[LPos] = '=' then begin {do not localize}
|
||
Inc(LPos);
|
||
if LPos > LLen then begin
|
||
Break;
|
||
end;
|
||
VCharset := ParseMetaCharsetData(LRawData, LPos, LLen);
|
||
end;
|
||
end;
|
||
else
|
||
DiscardUntilEndOfTag(LRawData, LPos, LLen);
|
||
end;
|
||
end;
|
||
1 : //'TITLE'
|
||
begin
|
||
DiscardUntilEndOfTag(LRawData, LPos, LLen);
|
||
DiscardUntilCloseTag(LRawData, 'TITLE', LPos, LLen); {do not localize}
|
||
end;
|
||
2 : //'SCRIPT'
|
||
begin
|
||
DiscardUntilEndOfTag(LRawData, LPos, LLen);
|
||
DiscardUntilCloseTag(LRawData, 'SCRIPT', LPos, LLen, True); {do not localize}
|
||
end;
|
||
3 : //'LINK'
|
||
begin
|
||
DiscardUntilEndOfTag(LRawData, LPos, LLen); {do not localize}
|
||
end;
|
||
end;
|
||
end;
|
||
body: begin
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
until False;
|
||
end;
|
||
|
||
{*************************************************************************************************}
|
||
|
||
// make sure that an RFC MsgID has angle brackets on it
|
||
function EnsureMsgIDBrackets(const AMsgID: String): String;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := AMsgID;
|
||
if Length(Result) > 0 then begin
|
||
if Result[1] <> '<' then begin {do not localize}
|
||
Result := '<' + Result; {do not localize}
|
||
end;
|
||
if Result[Length(Result)] <> '>' then begin {do not localize}
|
||
Result := Result + '>'; {do not localize}
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function ExtractHeaderItem(const AHeaderLine: String): String;
|
||
var
|
||
s: string;
|
||
begin
|
||
// Store in s and not Result because of Fetch semantics
|
||
s := AHeaderLine;
|
||
Result := Trim(Fetch(s, ';')); {do not localize}
|
||
end;
|
||
|
||
const
|
||
QuoteSpecials: array[TIdHeaderQuotingType] of String = (
|
||
{Plain } '', {do not localize}
|
||
{RFC822} '()<>@,;:\"./', {do not localize}
|
||
{MIME } '()<>@,;:\"/[]?=', {do not localize}
|
||
{HTTP } '()<>@,;:\"/[]?={} '#9 {do not localize}
|
||
);
|
||
|
||
{$IFDEF USE_OBJECT_ARC}
|
||
// Under ARC, SplitHeaderSubItems() cannot put a non-TObject pointer value in
|
||
// the TStrings.Objects[] property...
|
||
type
|
||
TIdHeaderNameValueItem = record
|
||
Name, Value: String;
|
||
Quoted: Boolean;
|
||
constructor Create(const AName, AValue: String; const AQuoted: Boolean);
|
||
end;
|
||
|
||
TIdHeaderNameValueList = class(TList<TIdHeaderNameValueItem>)
|
||
public
|
||
function GetValue(const AName: string): string;
|
||
function IndexOfName(const AName: string): Integer;
|
||
procedure SetValue(const AIndex: Integer; const AValue: String);
|
||
end;
|
||
|
||
constructor TIdHeaderNameValueItem.Create(const AName, AValue: String; const AQuoted: Boolean);
|
||
begin
|
||
Name := AName;
|
||
Value := AValue;
|
||
Quoted := AQuoted;
|
||
end;
|
||
|
||
function TIdHeaderNameValueList.GetValue(const AName: string): string;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
I := IndexOfName(AName);
|
||
if I <> -1 then begin
|
||
Result := Items[I].Value;
|
||
end else begin
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function TIdHeaderNameValueList.IndexOfName(const AName: string): Integer;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
Result := -1;
|
||
for I := 0 to Count-1 do
|
||
begin
|
||
if TextIsSame(Items[I].Name, AName) then
|
||
begin
|
||
Result := I;
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TIdHeaderNameValueList.SetValue(const AIndex: Integer; const AValue: String);
|
||
var
|
||
LItem: TIdHeaderNameValueItem;
|
||
begin
|
||
LItem := Items[AIndex];
|
||
LItem.Value := AValue;
|
||
Items[AIndex] := LItem;
|
||
end;
|
||
{$ENDIF}
|
||
|
||
procedure SplitHeaderSubItems(AHeaderLine: String;
|
||
AItems: {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStrings{$ENDIF};
|
||
AQuoteType: TIdHeaderQuotingType);
|
||
var
|
||
LName, LValue, LSep: String;
|
||
LQuoted: Boolean;
|
||
I: Integer;
|
||
|
||
function FetchQuotedString(var VHeaderLine: string): string;
|
||
begin
|
||
Result := '';
|
||
Delete(VHeaderLine, 1, 1);
|
||
I := 1;
|
||
while I <= Length(VHeaderLine) do begin
|
||
if VHeaderLine[I] = '\' then begin
|
||
// TODO: disable this logic for HTTP 1.0
|
||
if I < Length(VHeaderLine) then begin
|
||
Delete(VHeaderLine, I, 1);
|
||
end;
|
||
end
|
||
else if VHeaderLine[I] = '"' then begin
|
||
Result := Copy(VHeaderLine, 1, I-1);
|
||
VHeaderLine := Copy(VHeaderLine, I+1, MaxInt);
|
||
Break;
|
||
end;
|
||
Inc(I);
|
||
end;
|
||
Fetch(VHeaderLine, ';');
|
||
end;
|
||
|
||
begin
|
||
Fetch(AHeaderLine, ';'); {do not localize}
|
||
LSep := CharRange(#0, #32) + QuoteSpecials[AQuoteType] + #127;
|
||
while AHeaderLine <> '' do
|
||
begin
|
||
AHeaderLine := TrimLeft(AHeaderLine);
|
||
if AHeaderLine = '' then begin
|
||
Exit;
|
||
end;
|
||
LName := Trim(Fetch(AHeaderLine, '=')); {do not localize}
|
||
AHeaderLine := TrimLeft(AHeaderLine);
|
||
LQuoted := TextStartsWith(AHeaderLine, '"'); {do not localize}
|
||
if LQuoted then
|
||
begin
|
||
LValue := FetchQuotedString(AHeaderLine);
|
||
end else begin
|
||
I := FindFirstOf(LSep, AHeaderLine);
|
||
if I <> 0 then
|
||
begin
|
||
LValue := Copy(AHeaderLine, 1, I-1);
|
||
if AHeaderLine[I] = ';' then begin {do not localize}
|
||
Inc(I);
|
||
end;
|
||
Delete(AHeaderLine, 1, I-1);
|
||
end else begin
|
||
LValue := AHeaderLine;
|
||
AHeaderLine := '';
|
||
end;
|
||
end;
|
||
if (LName <> '') and ((LValue <> '') or LQuoted) then begin
|
||
{$IFDEF USE_OBJECT_ARC}
|
||
AItems.Add(TIdHeaderNameValueItem.Create(LName, LValue, LQuoted));
|
||
{$ELSE}
|
||
AItems.AddObject(LName + '=' + LValue, TObject(LQuoted));
|
||
{$ENDIF}
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function ExtractHeaderSubItem(const AHeaderLine, ASubItem: String;
|
||
AQuoteType: TIdHeaderQuotingType): String;
|
||
var
|
||
LItems: {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStringList{$ENDIF};
|
||
{$IFNDEF USE_OBJECT_ARC}
|
||
{$IFNDEF HAS_TStringList_CaseSensitive}
|
||
I: Integer;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
begin
|
||
Result := '';
|
||
// TODO: instead of splitting the header into a list of name=value pairs,
|
||
// allocating memory for it, just parse the input string in-place and extract
|
||
// the necessary substring from it...
|
||
LItems := {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStringList{$ENDIF}.Create;
|
||
try
|
||
SplitHeaderSubItems(AHeaderLine, LItems, AQuoteType);
|
||
{$IFDEF USE_OBJECT_ARC}
|
||
Result := LItems.GetValue(ASubItem);
|
||
{$ELSE}
|
||
{$IFDEF HAS_TStringList_CaseSensitive}
|
||
LItems.CaseSensitive := False;
|
||
Result := LItems.Values[ASubItem];
|
||
{$ELSE}
|
||
I := IndyIndexOfName(LItems, ASubItem);
|
||
if I <> -1 then begin
|
||
Result := IndyValueFromIndex(LItems, I);
|
||
end;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
finally
|
||
LItems.Free;
|
||
end;
|
||
end;
|
||
|
||
function ReplaceHeaderSubItem(const AHeaderLine, ASubItem, AValue: String;
|
||
AQuoteType: TIdHeaderQuotingType): String;
|
||
var
|
||
LOld: String;
|
||
begin
|
||
Result := ReplaceHeaderSubItem(AHeaderLine, ASubItem, AValue, LOld, AQuoteType);
|
||
end;
|
||
|
||
function ReplaceHeaderSubItem(const AHeaderLine, ASubItem, AValue: String;
|
||
var VOld: String; AQuoteType: TIdHeaderQuotingType): String;
|
||
var
|
||
LItems: {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStringList{$ENDIF};
|
||
I: Integer;
|
||
LValue: string;
|
||
|
||
function QuoteString(const S: String; const AForceQuotes: Boolean): String;
|
||
var
|
||
I: Integer;
|
||
LAddQuotes: Boolean;
|
||
LNeedQuotes, LNeedEscape: String;
|
||
begin
|
||
Result := '';
|
||
if Length(S) = 0 then begin
|
||
Exit;
|
||
end;
|
||
LAddQuotes := AForceQuotes;
|
||
LNeedQuotes := CharRange(#0, #32) + QuoteSpecials[AQuoteType] + #127;
|
||
// TODO: disable this logic for HTTP 1.0
|
||
LNeedEscape := '"\'; {Do not Localize}
|
||
if AQuoteType in [QuoteRFC822, QuoteMIME] then begin
|
||
LNeedEscape := LNeedEscape + CR; {Do not Localize}
|
||
end;
|
||
for I := 1 to Length(S) do begin
|
||
if CharIsInSet(S, I, LNeedEscape) then begin
|
||
LAddQuotes := True;
|
||
Result := Result + '\'; {do not localize}
|
||
end
|
||
else if CharIsInSet(S, I, LNeedQuotes) then begin
|
||
LAddQuotes := True;
|
||
end;
|
||
Result := Result + S[I];
|
||
end;
|
||
if LAddQuotes then begin
|
||
Result := '"' + Result + '"';
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
Result := '';
|
||
// TODO: instead of splitting the header into a list of name=value pairs,
|
||
// allocating memory for it, and then putting the list back together, just
|
||
// parse the input string in-place and extract/replace the necessary
|
||
// substring from it as needed, preserving the rest of the string as-is...
|
||
LItems := {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStringList{$ENDIF}.Create;
|
||
try
|
||
SplitHeaderSubItems(AHeaderLine, LItems, AQuoteType);
|
||
{$IFDEF USE_OBJECT_ARC}
|
||
I := LItems.IndexOfName(ASubItem);
|
||
{$ELSE}
|
||
{$IFDEF HAS_TStringList_CaseSensitive}
|
||
LItems.CaseSensitive := False;
|
||
{$ENDIF}
|
||
I := IndyIndexOfName(LItems, ASubItem);
|
||
{$ENDIF}
|
||
if I >= 0 then begin
|
||
{$IFDEF USE_OBJECT_ARC}
|
||
VOld := LItems[I].Value;
|
||
{$ELSE}
|
||
VOld := LItems.Strings[I];
|
||
Fetch(VOld, '=');
|
||
{$ENDIF}
|
||
end else begin
|
||
VOld := '';
|
||
end;
|
||
LValue := Trim(AValue);
|
||
if LValue <> '' then begin
|
||
{$IFDEF USE_OBJECT_ARC}
|
||
if I < 0 then begin
|
||
LItems.Add(TIdHeaderNameValueItem.Create(ASubItem, LValue, False));
|
||
end else begin
|
||
LItems.SetValue(I, LValue);
|
||
end;
|
||
{$ELSE}
|
||
if I < 0 then begin
|
||
LItems.Add(ASubItem + '=' + LValue); {do not localize}
|
||
end else begin
|
||
{$IFDEF HAS_TStrings_ValueFromIndex}
|
||
LItems.ValueFromIndex[I] := LValue;
|
||
{$ELSE}
|
||
LItems.Strings[I] := ASubItem + '=' + LValue; {do not localize}
|
||
{$ENDIF}
|
||
end;
|
||
{$ENDIF}
|
||
end
|
||
else if I < 0 then begin
|
||
// subitem not found, just return the original header as-is...
|
||
Result := AHeaderLine;
|
||
Exit;
|
||
end else begin
|
||
LItems.Delete(I);
|
||
end;
|
||
Result := ExtractHeaderItem(AHeaderLine);
|
||
if Result <> '' then begin
|
||
for I := 0 to LItems.Count-1 do begin
|
||
{$IFDEF USE_OBJECT_ARC}
|
||
Result := Result + '; ' + LItems[I].Name + '=' + QuoteString(LItems[I].Value, LItems[I].Quoted); {do not localize}
|
||
{$ELSE}
|
||
Result := Result + '; ' + LItems.Names[I] + '=' + QuoteString(IndyValueFromIndex(LItems, I), Boolean(LItems.Objects[I])); {do not localize}
|
||
{$ENDIF}
|
||
end;
|
||
end;
|
||
finally
|
||
LItems.Free;
|
||
end;
|
||
end;
|
||
|
||
function MediaTypeMatches(const AValue, AMediaType: String): Boolean;
|
||
begin
|
||
if Pos('/', AMediaType) > 0 then begin {do not localize}
|
||
Result := TextIsSame(AValue, AMediaType);
|
||
end else begin
|
||
Result := TextStartsWith(AValue, AMediaType + '/'); {do not localize}
|
||
end;
|
||
end;
|
||
|
||
function IsHeaderMediaType(const AHeaderLine, AMediaType: String): Boolean;
|
||
begin
|
||
Result := MediaTypeMatches(ExtractHeaderItem(AHeaderLine), AMediaType);
|
||
end;
|
||
|
||
function IsHeaderMediaTypes(const AHeaderLine: String; const AMediaTypes: array of String): Boolean;
|
||
var
|
||
LHeader: String;
|
||
I: Integer;
|
||
begin
|
||
Result := False;
|
||
LHeader := ExtractHeaderItem(AHeaderLine);
|
||
for I := Low(AMediaTypes) to High(AMediaTypes) do begin
|
||
if MediaTypeMatches(LHeader, AMediaTypes[I]) then begin
|
||
Result := True;
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function ExtractHeaderMediaType(const AHeaderLine: String): String;
|
||
var
|
||
S: String;
|
||
I: Integer;
|
||
begin
|
||
S := ExtractHeaderItem(AHeaderLine);
|
||
I := Pos('/', S);
|
||
if I > 0 then begin
|
||
Result := Copy(S, 1, I-1);
|
||
end else begin
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function ExtractHeaderMediaSubType(const AHeaderLine: String): String;
|
||
var
|
||
S: String;
|
||
I: Integer;
|
||
begin
|
||
S := ExtractHeaderItem(AHeaderLine);
|
||
I := Pos('/', S);
|
||
if I > 0 then begin
|
||
Result := Copy(S, I+1, Length(S));
|
||
end else begin
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function IsHeaderValue(const AHeaderLine: String; const AValue: String): Boolean;
|
||
begin
|
||
Result := TextIsSame(ExtractHeaderItem(AHeaderLine), AValue);
|
||
end;
|
||
|
||
function GetClockValue : Int64;
|
||
{$IFDEF DOTNET}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF WINDOWS}
|
||
type
|
||
TInt64Rec = record
|
||
case Integer of
|
||
0 : (High : UInt32;
|
||
Low : UInt32);
|
||
1 : (Long : Int64);
|
||
end;
|
||
|
||
var
|
||
LFTime : TFileTime;
|
||
{$ENDIF}
|
||
{$IFDEF UNIX}
|
||
{$IFNDEF USE_VCL_POSIX}
|
||
var
|
||
TheTms: tms;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF WINDOWS}
|
||
{$IFDEF WINCE}
|
||
// TODO
|
||
{$ELSE}
|
||
Windows.GetSystemTimeAsFileTime(LFTime);
|
||
TInt64Rec(Result).Low := LFTime.dwLowDateTime;
|
||
TInt64Rec(Result).High := LFTime.dwHighDateTime;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF UNIX}
|
||
//Is the following correct?
|
||
{$IFDEF USE_BASEUNIX}
|
||
Result := fptimes(TheTms);
|
||
{$ENDIF}
|
||
{$IFDEF KYLIXCOMPAT}
|
||
Result := Times(TheTms);
|
||
{$ENDIF}
|
||
{$IFDEF USE_VCL_POSIX}
|
||
Result := time(nil);
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF DOTNET}
|
||
Result := System.DateTime.Now.Ticks;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
{$UNDEF NO_NATIVE_ASM}
|
||
{$IFDEF DOTNET}
|
||
{$DEFINE NO_NATIVE_ASM}
|
||
{$ENDIF}
|
||
{$IFDEF IOS}
|
||
{$IFDEF CPUARM}
|
||
{$DEFINE NO_NATIVE_ASM}
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF ANDROID}
|
||
{$DEFINE NO_NATIVE_ASM}
|
||
{$ENDIF}
|
||
{$IFDEF FPC}
|
||
{$IFNDEF CPUI386}
|
||
{$DEFINE NO_NATIVE_ASM}
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
|
||
{$IFDEF NO_NATIVE_ASM}
|
||
function ROL(const AVal: UInt32; AShift: Byte): UInt32;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := (AVal shl AShift) or (AVal shr (32 - AShift));
|
||
end;
|
||
|
||
function ROR(const AVal: UInt32; AShift: Byte): UInt32;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := (AVal shr AShift) or (AVal shl (32 - AShift)) ;
|
||
end;
|
||
|
||
{$ELSE}
|
||
|
||
// 32-bit: Arg1=EAX, Arg2=DL
|
||
// 64-bit: Arg1=ECX, Arg2=DL
|
||
function ROL(const AVal: UInt32; AShift: Byte): UInt32; assembler;
|
||
asm
|
||
{$IFDEF CPU64}
|
||
mov eax, ecx
|
||
{$ENDIF}
|
||
mov cl, dl
|
||
rol eax, cl
|
||
end;
|
||
|
||
function ROR(const AVal: UInt32; AShift: Byte): UInt32; assembler;
|
||
asm
|
||
{$IFDEF CPU64}
|
||
mov eax, ecx
|
||
{$ENDIF}
|
||
mov cl, dl
|
||
ror eax, cl
|
||
end;
|
||
{$ENDIF}
|
||
|
||
function IndyComputerName: string;
|
||
{$IFDEF DOTNET}
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF UNIX}
|
||
const
|
||
sMaxHostName = 255;
|
||
var
|
||
LHost: array[0..sMaxHostName] of TIdAnsiChar;
|
||
{$IFDEF USE_MARSHALLED_PTRS}
|
||
LHostPtr: TPtrWrapper;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF WINDOWS}
|
||
var
|
||
{$IFDEF WINCE}
|
||
Reg: TRegistry;
|
||
{$ELSE}
|
||
LHost: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
|
||
i: DWORD;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
begin
|
||
Result := '';
|
||
|
||
{$IFDEF UNIX}
|
||
//TODO: No need for LHost at all? Prob can use just Result
|
||
{$IFDEF KYLIXCOMPAT}
|
||
if GetHostname(LHost, sMaxHostName) <> -1 then begin
|
||
Result := String(LHost);
|
||
end;
|
||
{$ENDIF}
|
||
{$IFDEF USE_BASE_UNIX}
|
||
Result := GetHostName;
|
||
{$ENDIF}
|
||
{$IFDEF USE_VCL_POSIX}
|
||
{$IFDEF USE_MARSHALLED_PTRS}
|
||
LHostPtr := TPtrWrapper.Create(@LHost[0]);
|
||
{$ENDIF}
|
||
if Posix.Unistd.gethostname(
|
||
{$IFDEF USE_MARSHALLED_PTRS}
|
||
LHostPtr.ToPointer
|
||
{$ELSE}
|
||
LHost
|
||
{$ENDIF},
|
||
sMaxHostName) <> -1 then
|
||
begin
|
||
LHost[sMaxHostName] := TIdAnsiChar(0);
|
||
{$IFDEF USE_MARSHALLED_PTRS}
|
||
Result := TMarshal.ReadStringAsAnsi(LHostPtr);
|
||
{$ELSE}
|
||
Result := String(LHost);
|
||
{$ENDIF}
|
||
end;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF WINDOWS}
|
||
{$IFDEF WINCE}
|
||
Reg := TRegistry.Create;
|
||
try
|
||
Reg.RootKey := HKEY_LOCAL_MACHINE;
|
||
if Reg.OpenKeyReadOnly('\Ident') then begin
|
||
Result := Reg.ReadString('Name');
|
||
Reg.CloseKey;
|
||
end;
|
||
finally
|
||
Reg.Free;
|
||
end;
|
||
{$ELSE}
|
||
i := MAX_COMPUTERNAME_LENGTH;
|
||
if GetComputerName(LHost, i) then begin
|
||
SetString(Result, LHost, i);
|
||
end;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$IFDEF DOTNET}
|
||
Result := Environment.MachineName;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
{$IFDEF STRING_IS_ANSI}
|
||
function IsLeadChar(ACh : Char): Boolean;
|
||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||
begin
|
||
Result := ACh in LeadBytes;
|
||
end;
|
||
{$ENDIF}
|
||
|
||
function IdGetDefaultCharSet: TIdCharSet;
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
{$IFDEF UNIX}
|
||
Result := GIdDefaultCharSet;
|
||
{$ENDIF}
|
||
{$IFDEF DOTNET}
|
||
Result := idcs_UNICODE_1_1;
|
||
// not a particular Unicode encoding - just unicode in general
|
||
// i.e. DotNet native string is 2 byte Unicode, we do not concern ourselves
|
||
// with Byte order. (though we have to concern ourselves once we start
|
||
// writing to some stream or Bytes
|
||
{$ENDIF}
|
||
{$IFDEF WINDOWS}
|
||
// Many defaults are set here when the choice is ambiguous. However for
|
||
// IdMessage OnInitializeISO can be used by user to choose other.
|
||
case SysLocale.PriLangID of
|
||
LANG_CHINESE: begin
|
||
if SysLocale.SubLangID = SUBLANG_CHINESE_SIMPLIFIED then begin
|
||
Result := idcs_GB2312;
|
||
end else begin
|
||
Result := idcs_Big5;
|
||
end;
|
||
end;
|
||
LANG_JAPANESE: Result := idcs_ISO_2022_JP;
|
||
LANG_KOREAN: Result := idcs_csEUCKR;
|
||
// Kudzu
|
||
// 1251 is the Windows standard for Russian but its not used in emails.
|
||
// KOI8-R is by far the most widely used and thus the default.
|
||
LANG_RUSSIAN: Result := idcs_KOI8_R;
|
||
// Kudzu
|
||
// Ukranian is about 50/50 KOI8u and 1251, but 1251 is the newer one and
|
||
// the Windows one so we default to it.
|
||
LANG_UKRAINIAN: Result := idcs_windows_1251;
|
||
else begin
|
||
{$IFDEF STRING_IS_UNICODE}
|
||
Result := idcs_UNICODE_1_1;
|
||
// not a particular Unicode encoding - just unicode in general
|
||
// i.e. Delphi/C++Builder 2009+ native string is 2 byte Unicode,
|
||
// we do not concern ourselves with Byte order. (though we have
|
||
// to concern ourselves once we start writing to some stream or
|
||
// Bytes
|
||
{$ELSE}
|
||
Result := idcs_ISO_8859_1;
|
||
{$ENDIF}
|
||
end;
|
||
end;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
//The following is for working on email headers and message part headers.
|
||
//For example, to remove the boundary from the ContentType header, call
|
||
//ContentType := RemoveHeaderEntry(ContentType, 'boundary', QuoteMIME);
|
||
function RemoveHeaderEntry(const AHeader, AEntry: string;
|
||
AQuoteType: TIdHeaderQuotingType): string;
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
Result := ReplaceHeaderSubItem(AHeader, AEntry, '', AQuoteType);
|
||
end;
|
||
|
||
function RemoveHeaderEntry(const AHeader, AEntry: string; var VOld: String;
|
||
AQuoteType: TIdHeaderQuotingType): string;
|
||
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
begin
|
||
Result := ReplaceHeaderSubItem(AHeader, AEntry, '', VOld, AQuoteType);
|
||
end;
|
||
|
||
function RemoveHeaderEntries(const AHeader: string; AEntries: array of string;
|
||
AQuoteType: TIdHeaderQuotingType): string;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
Result := AHeader;
|
||
if Length(AEntries) > 0 then begin
|
||
for I := Low(AEntries) to High(AEntries) do begin
|
||
Result := ReplaceHeaderSubItem(Result, AEntries[I], '', AQuoteType);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{
|
||
Three functions for easier manipulating of strings. Don't know of any
|
||
system functions to perform these actions. If there aren't and someone
|
||
can find an optimised way of performing then please implement...
|
||
}
|
||
function FindFirstOf(const AFind, AText: string; const ALength: Integer = -1;
|
||
const AStartPos: Integer = 1): Integer;
|
||
var
|
||
I, LLength, LPos: Integer;
|
||
begin
|
||
Result := 0;
|
||
if Length(AFind) > 0 then begin
|
||
LLength := IndyLength(AText, ALength, AStartPos);
|
||
if LLength > 0 then begin
|
||
for I := 0 to LLength-1 do begin
|
||
LPos := AStartPos + I;
|
||
if IndyPos(AText[LPos], AFind) <> 0 then begin
|
||
Result := LPos;
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function FindFirstNotOf(const AFind, AText: string; const ALength: Integer = -1;
|
||
const AStartPos: Integer = 1): Integer;
|
||
var
|
||
I, LLength, LPos: Integer;
|
||
begin
|
||
Result := 0;
|
||
LLength := IndyLength(AText, ALength, AStartPos);
|
||
if LLength > 0 then begin
|
||
if Length(AFind) = 0 then begin
|
||
Result := AStartPos;
|
||
Exit;
|
||
end;
|
||
for I := 0 to LLength-1 do begin
|
||
LPos := AStartPos + I;
|
||
if IndyPos(AText[LPos], AFind) = 0 then begin
|
||
Result := LPos;
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TrimAllOf(const ATrim, AText: string): string;
|
||
var
|
||
Len: Integer;
|
||
begin
|
||
Result := AText;
|
||
Len := Length(Result);
|
||
while Len > 0 do begin
|
||
if IndyPos(Result[1], ATrim) > 0 then begin
|
||
IdDelete(Result, 1, 1);
|
||
Dec(Len);
|
||
end else begin
|
||
Break;
|
||
end;
|
||
end;
|
||
while Len > 0 do begin
|
||
if IndyPos(Result[Len], ATrim) > 0 then begin
|
||
IdDelete(Result, Len, 1);
|
||
Dec(Len);
|
||
end else begin
|
||
Break;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function ContentTypeToEncoding(const AContentType: String;
|
||
AQuoteType: TIdHeaderQuotingType): IIdTextEncoding;
|
||
var
|
||
LCharset: String;
|
||
begin
|
||
LCharset := ExtractHeaderSubItem(AContentType, 'charset', AQuoteType); {do not localize}
|
||
Result := CharsetToEncoding(LCharset);
|
||
end;
|
||
|
||
function CharsetToEncoding(const ACharset: String): IIdTextEncoding;
|
||
{$IFNDEF DOTNET_OR_ICONV}
|
||
var
|
||
CP: Word;
|
||
{$ENDIF}
|
||
begin
|
||
Result := nil;
|
||
if ACharSet <> '' then
|
||
begin
|
||
// let the user provide a custom encoding first, if desired...
|
||
if Assigned(GIdEncodingNeeded) then begin
|
||
Result := GIdEncodingNeeded(ACharSet);
|
||
if Assigned(Result) then begin
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
// RLebeau 3/13/09: if there is a problem initializing an encoding
|
||
// class for the requested charset, either because the charset is
|
||
// not known to Indy, or because the OS does not support it natively,
|
||
// just return the 8-bit encoding as a fallback for now. The data
|
||
// being handled by it likely won't be encoded/decoded properly, but
|
||
// at least the error won't cause exceptions in the user's code, and
|
||
// maybe the user will know how to encode/decode the data manually
|
||
// as a workaround...
|
||
|
||
try
|
||
{$IFDEF DOTNET_OR_ICONV}
|
||
Result := IndyTextEncoding(ACharset);
|
||
{$ELSE}
|
||
CP := CharsetToCodePage(ACharset);
|
||
if CP <> 0 then begin
|
||
Result := IndyTextEncoding(CP);
|
||
end;
|
||
{$ENDIF}
|
||
except end;
|
||
end;
|
||
|
||
{JPM - I have decided to temporarily make this 8-bit because I'm concerned
|
||
about how binary files will be handled by the ASCII encoder (where there may
|
||
be 8bit byte-values. In addition, there are numerous charsets for various
|
||
languages and codepages that do some special mapping for them would be a mess.}
|
||
|
||
{RLebeau: technically, we should be returning a 7-bit encoding, as the
|
||
default charset for "text/" content types is "us-ascii".}
|
||
|
||
if not Assigned(Result) then
|
||
begin
|
||
{ TODO: finish implementing this
|
||
if PosInStrArray(
|
||
ACharSet,
|
||
['ISO-2022-JP', 'ISO-2022-JP-1', 'ISO-2022-JP-2', 'ISO-2022-JP-3', 'ISO-2022-JP-2004'], {do not localize
|
||
False) <> -1 then
|
||
begin
|
||
Result := TIdTextEncoding_ISO2022JP.Create;
|
||
Exit;
|
||
end;
|
||
}
|
||
Result := IndyTextEncoding_8Bit;
|
||
end;
|
||
end;
|
||
|
||
procedure WriteStringAsContentType(AStream: TStream; const AStr, AContentType: String;
|
||
AQuoteType: TIdHeaderQuotingType
|
||
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
begin
|
||
WriteStringToStream(AStream, AStr, ContentTypeToEncoding(AContentType, AQuoteType){$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
|
||
end;
|
||
|
||
procedure WriteStringsAsContentType(AStream: TStream; const AStrings: TStrings;
|
||
const AContentType: String; AQuoteType: TIdHeaderQuotingType
|
||
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
begin
|
||
// RLebeau 10/06/2010: not using TStrings.SaveToStream() in D2009+
|
||
// anymore, as it may save a BOM which we do not want here...
|
||
|
||
// TODO: instead of writing AString.Text as a whole, loop through AStrings
|
||
// writing the individual strings to avoid unnecessary memory allocations...
|
||
|
||
WriteStringToStream(AStream, AStrings.Text, ContentTypeToEncoding(AContentType, AQuoteType){$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
|
||
end;
|
||
|
||
procedure WriteStringAsCharset(AStream: TStream; const AStr, ACharset: string
|
||
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
begin
|
||
WriteStringToStream(AStream, AStr, CharsetToEncoding(ACharset){$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
|
||
end;
|
||
|
||
procedure WriteStringsAsCharset(AStream: TStream; const AStrings: TStrings;
|
||
const ACharset: string
|
||
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
|
||
begin
|
||
// RLebeau 10/06/2010: not using TStrings.SaveToStream() in D2009+
|
||
// anymore, as it may save a BOM which we do not want here...
|
||
|
||
// TODO: instead of writing AString.Text as a whole, loop through AStrings
|
||
// writing the individual strings to avoid unnecessary memory allocations...
|
||
|
||
WriteStringToStream(AStream, AStrings.Text, CharsetToEncoding(ACharset){$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
|
||
end;
|
||
|
||
function ReadStringAsContentType(AStream: TStream; const AContentType: String;
|
||
AQuoteType: TIdHeaderQuotingType
|
||
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
||
): String;
|
||
begin
|
||
Result := ReadStringFromStream(AStream, -1, ContentTypeToEncoding(AContentType, AQuoteType){$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
||
end;
|
||
|
||
procedure ReadStringsAsContentType(AStream: TStream; AStrings: TStrings;
|
||
const AContentType: String; AQuoteType: TIdHeaderQuotingType
|
||
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
||
);
|
||
begin
|
||
AStrings.Text := ReadStringFromStream(AStream, -1, ContentTypeToEncoding(AContentType, AQuoteType){$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
||
end;
|
||
|
||
function ReadStringAsCharset(AStream: TStream; const ACharset: String
|
||
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
||
): String;
|
||
begin
|
||
//TODO: Figure out what should happen with Unicode content type.
|
||
Result := ReadStringFromStream(AStream, -1, CharsetToEncoding(ACharset){$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
||
end;
|
||
|
||
procedure ReadStringsAsCharset(AStream: TStream; AStrings: TStrings; const ACharset: String
|
||
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
||
);
|
||
begin
|
||
AStrings.Text := ReadStringFromStream(AStream, -1, CharsetToEncoding(ACharset){$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
||
end;
|
||
|
||
{ TIdInterfacedObject }
|
||
|
||
function TIdInterfacedObject._AddRef: Integer;
|
||
begin
|
||
{$IFDEF DOTNET}
|
||
Result := 1;
|
||
{$ELSE}
|
||
Result := inherited _AddRef;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function TIdInterfacedObject._Release: Integer;
|
||
begin
|
||
{$IFDEF DOTNET}
|
||
Result := 1;
|
||
{$ELSE}
|
||
Result := inherited _Release;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
initialization
|
||
{$IFDEF WINDOWS}
|
||
ATempPath := TempPath;
|
||
{$ENDIF}
|
||
SetLength(IndyFalseBoolStrs, 1);
|
||
IndyFalseBoolStrs[Low(IndyFalseBoolStrs)] := 'FALSE'; {Do not Localize}
|
||
SetLength(IndyTrueBoolStrs, 1);
|
||
IndyTrueBoolStrs[Low(IndyTrueBoolStrs)] := 'TRUE'; {Do not Localize}
|
||
end.
|