9180 lines
294 KiB
Plaintext
9180 lines
294 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$
|
|
}
|
|
{
|
|
Rev 1.54 2/9/2005 8:45:38 PM JPMugaas
|
|
Should work.
|
|
|
|
Rev 1.53 2/8/05 6:37:38 PM RLebeau
|
|
Added default value to ASize parameter of ReadStringFromStream()
|
|
|
|
Rev 1.52 2/8/05 5:57:10 PM RLebeau
|
|
added AppendString(), CopyTIdLongWord(), and CopyTIdString() functions
|
|
|
|
Rev 1.51 1/31/05 6:01:40 PM RLebeau
|
|
Renamed GetCurrentThreadHandle() to CurrentThreadId() and changed the return
|
|
type from THandle to to TIdPID.
|
|
|
|
Reworked conditionals for SetThreadName() and updated the implementation to
|
|
support naming threads under DotNet.
|
|
|
|
Rev 1.50 1/27/05 3:40:04 PM RLebeau
|
|
Updated BytesToShort() to actually use the AIndex parameter that was added
|
|
earlier.
|
|
|
|
Rev 1.49 1/24/2005 7:35:36 PM JPMugaas
|
|
Foxed ma,e om CopyTIdIPV6Address/
|
|
|
|
Rev 1.48 1/17/2005 7:26:44 PM JPMugaas
|
|
Made an IPv6 address byte copy function.
|
|
|
|
Rev 1.47 1/15/2005 6:01:38 PM JPMugaas
|
|
Removed some new procedures for extracting int values from a TIdBytes and
|
|
made some other procedures have an optional index paramter.
|
|
|
|
Rev 1.46 1/13/05 11:11:20 AM RLebeau
|
|
Changed BytesToRaw() to pass TIdBytes by 'const' rather than by 'var'
|
|
|
|
Rev 1.45 1/8/2005 3:56:58 PM JPMugaas
|
|
Added routiens for copying integer values to and from TIdBytes. These are
|
|
useful for some protocols.
|
|
|
|
Rev 1.44 24/11/2004 16:26:24 ANeillans
|
|
GetTickCount corrected, as per Paul Cooper's post in
|
|
atozedsoftware.indy.general.
|
|
|
|
Rev 1.43 11/13/04 10:47:28 PM RLebeau
|
|
Fixed compiler errors
|
|
|
|
Rev 1.42 11/12/04 1:02:42 PM RLebeau
|
|
Added RawToBytesF() and BytesToRaw() functions
|
|
|
|
Added asserts to BytesTo...() functions
|
|
|
|
Rev 1.41 10/26/2004 8:20:02 PM JPMugaas
|
|
Fixed some oversights with conversion. OOPS!!!
|
|
|
|
Rev 1.40 10/26/2004 8:00:54 PM JPMugaas
|
|
Now uses TIdStrings for DotNET portability.
|
|
|
|
Rev 1.39 2004.10.26 7:35:16 PM czhower
|
|
Moved IndyCat to CType in IdBaseComponent
|
|
|
|
Rev 1.38 24/10/2004 21:29:52 ANeillans
|
|
Corrected error in GetTickCount,
|
|
was Result := Trunc(nTime / (Freq * 1000))
|
|
should be Result := Trunc((nTime / Freq) * 1000)
|
|
|
|
Rev 1.37 20/10/2004 01:08:20 CCostelloe
|
|
Bug fix
|
|
|
|
Rev 1.36 28.09.2004 20:36:58 Andreas Hausladen
|
|
Works now with Delphi 5
|
|
|
|
Rev 1.35 9/23/2004 11:36:04 PM DSiders
|
|
Modified Ticks function (Win32) to correct RangeOverflow error. (Reported by
|
|
Mike Potter)
|
|
|
|
Rev 1.34 24.09.2004 02:16:04 Andreas Hausladen
|
|
Added ReadTIdBytesFromStream and ReadCharFromStream function to supress .NET
|
|
warnings.
|
|
|
|
Rev 1.33 9/5/2004 2:55:00 AM JPMugaas
|
|
function BytesToWord(const AValue: TIdBytes): Word; was not listed in the
|
|
interface.
|
|
|
|
Rev 1.32 04.09.2004 17:12:56 Andreas Hausladen
|
|
New PosIdx function (without pointers)
|
|
|
|
Rev 1.31 27.08.2004 22:02:20 Andreas Hausladen
|
|
Speed optimization ("const" for string parameters)
|
|
rewritten PosIdx function with AStartPos = 0 handling
|
|
new ToArrayF() functions (faster in native code because the TIdBytes array
|
|
must have the required len before the ToArrayF function is called)
|
|
|
|
Rev 1.30 24.08.2004 19:48:28 Andreas Hausladen
|
|
Some optimizations
|
|
Removed IFDEF for IdDelete and IdInsert
|
|
|
|
Rev 1.29 8/17/2004 2:54:08 PM JPMugaas
|
|
Fix compiler warning about widening operends. Int64 can sometimes incur a
|
|
performance penalty.
|
|
|
|
Rev 1.28 8/15/04 5:57:06 PM RLebeau
|
|
Tweaks to PosIdx()
|
|
|
|
Rev 1.27 7/23/04 10:13:16 PM RLebeau
|
|
Updated ReadStringFromStream() to resize the result using the actual number
|
|
of bytes read from the stream
|
|
|
|
Rev 1.26 7/18/2004 2:45:38 PM DSiders
|
|
Added localization comments.
|
|
|
|
Rev 1.25 7/9/04 4:25:20 PM RLebeau
|
|
Renamed ToBytes(raw) to RawToBytes() to fix an ambiquity error with
|
|
ToBytes(TIdBytes)
|
|
|
|
Rev 1.24 7/9/04 4:07:06 PM RLebeau
|
|
Compiler fix for TIdBaseStream.Write()
|
|
|
|
Rev 1.23 09/07/2004 22:17:52 ANeillans
|
|
Fixed IdGlobal.pas(761) Error: ';', ')' or '=' expected but ':=' found
|
|
|
|
Rev 1.22 7/8/04 11:56:10 PM RLebeau
|
|
Added additional parameters to BytesToString()
|
|
|
|
Bug fix for ReadStringFromStream()
|
|
|
|
Updated TIdBaseStream.Write() to use ToBytes()
|
|
|
|
Rev 1.21 7/8/04 4:22:36 PM RLebeau
|
|
Added ToBytes() overload for raw pointers under non-DotNet platfoms.
|
|
|
|
Rev 1.20 2004.07.03 19:39:38 czhower
|
|
UTF8
|
|
|
|
Rev 1.19 6/15/2004 7:18:06 PM JPMugaas
|
|
IdInsert for stuff needing to call the Insert procedure.
|
|
|
|
Rev 1.18 2004.06.13 8:06:46 PM czhower
|
|
.NET update
|
|
|
|
Rev 1.17 6/11/2004 8:28:30 AM DSiders
|
|
Added "Do not Localize" comments.
|
|
|
|
Rev 1.16 2004.06.08 7:11:14 PM czhower
|
|
Typo fix.
|
|
|
|
Rev 1.15 2004.06.08 6:34:48 PM czhower
|
|
.NET bug with Ticks workaround.
|
|
|
|
Rev 1.14 07/06/2004 21:30:32 CCostelloe
|
|
Kylix 3 changes
|
|
|
|
Rev 1.13 5/3/04 12:17:44 PM RLebeau
|
|
Updated ToBytes(string) and BytesToString() under DotNet to use
|
|
System.Text.Encoding.ASCII instead of AnsiEncoding
|
|
|
|
Rev 1.12 4/24/04 12:41:36 PM RLebeau
|
|
Conversion support to/from TIdBytes for Char values
|
|
|
|
Rev 1.11 4/18/04 2:45:14 PM RLebeau
|
|
Conversion support to/from TIdBytes for Int64 values
|
|
|
|
Rev 1.10 2004.04.08 4:50:06 PM czhower
|
|
Comments
|
|
|
|
Rev 1.9 2004.04.08 1:45:42 AM czhower
|
|
tiny string optimization
|
|
|
|
Rev 1.8 4/7/2004 3:20:50 PM JPMugaas
|
|
PosIdx was not working in DotNET. In DotNET, it was returning a Pos value
|
|
without adding the startvalue -1. It was throwing off the FTP list parsers.
|
|
|
|
Two uneeded IFDEF's were removed.
|
|
|
|
Rev 1.7 2004.03.13 5:51:28 PM czhower
|
|
Fixed stack overflow in Sleep for .net
|
|
|
|
Rev 1.6 3/6/2004 5:16:02 PM JPMugaas
|
|
Bug 67 fixes. Do not write to const values.
|
|
|
|
Rev 1.5 3/6/2004 4:54:12 PM JPMugaas
|
|
Write to const bug fix.
|
|
|
|
Rev 1.4 2/17/2004 12:02:44 AM JPMugaas
|
|
A few routines that might be needed later for RFC 3490 support.
|
|
|
|
Rev 1.3 2/16/2004 1:56:04 PM JPMugaas
|
|
Moved some routines here to lay the groundwork for RFC 3490 support. Started
|
|
work on RFC 3490 support.
|
|
|
|
Rev 1.2 2/11/2004 5:12:30 AM JPMugaas
|
|
Moved IPv6 address definition here.
|
|
|
|
I also made a function for converting a TIdBytes to an IPv6 address.
|
|
|
|
Rev 1.1 2004.02.03 3:15:52 PM czhower
|
|
Updates to move to System.
|
|
|
|
Rev 1.0 2004.02.03 2:28:30 PM czhower
|
|
Move
|
|
|
|
Rev 1.91 2/1/2004 11:16:04 PM BGooijen
|
|
ToBytes
|
|
|
|
Rev 1.90 2/1/2004 1:28:46 AM JPMugaas
|
|
Disabled IdPort functionality in DotNET. It can't work there in it's current
|
|
form and trying to get it to work will introduce more problems than it
|
|
solves. It was only used by the bindings editor and we did something
|
|
different in DotNET so IdPorts wouldn't used there.
|
|
|
|
Rev 1.89 2004.01.31 1:51:10 AM czhower
|
|
IndyCast for VB.
|
|
|
|
Rev 1.88 30/1/2004 4:47:46 PM SGrobety
|
|
Added "WriteMemoryStreamToStream" to take care of Win32/dotnet difference in
|
|
the TMemoryStream.Memory type and the Write buffer parameter
|
|
|
|
Rev 1.87 1/30/2004 11:59:24 AM BGooijen
|
|
Added WriteTIdBytesToStream, because we can convert almost everything to
|
|
TIdBytes, and TIdBytes couldn't be written to streams easily
|
|
|
|
Rev 1.86 2004.01.27 11:44:36 PM czhower
|
|
.Net Updates
|
|
|
|
Rev 1.85 2004.01.27 8:15:54 PM czhower
|
|
Fixed compile error + .net helper.
|
|
|
|
Rev 1.84 27/1/2004 1:55:10 PM SGrobety
|
|
TIdStringStream introduced to fix a bug in DOTNET TStringStream
|
|
implementation.
|
|
|
|
Rev 1.83 2004.01.27 1:42:00 AM czhower
|
|
Added parameter check
|
|
|
|
Rev 1.82 25/01/2004 21:55:40 CCostelloe
|
|
Added portable IdFromBeginning/FromCurrent/FromEnd, to be used instead of
|
|
soFromBeginning/soBeginning, etc.
|
|
|
|
Rev 1.81 24/01/2004 20:18:46 CCostelloe
|
|
Added IndyCompareStr (to be used in place of AnsiCompareStr for .NET
|
|
compatibility)
|
|
|
|
Rev 1.80 2004.01.23 9:56:30 PM czhower
|
|
CharIsInSet now checks length and returns false if no character.
|
|
|
|
Rev 1.79 2004.01.23 9:49:40 PM czhower
|
|
CharInSet no longer accepts -1, was unneeded and redundant.
|
|
|
|
Rev 1.78 1/22/2004 5:47:46 PM SPerry
|
|
fixed CharIsInSet
|
|
|
|
Rev 1.77 2004.01.22 5:33:46 PM czhower
|
|
TIdCriticalSection
|
|
|
|
Rev 1.76 2004.01.22 3:23:18 PM czhower
|
|
IsCharInSet
|
|
|
|
Rev 1.75 2004.01.22 2:00:14 PM czhower
|
|
iif change
|
|
|
|
Rev 1.74 14/01/2004 00:17:34 CCostelloe
|
|
Added IndyLowerCase/IndyUpperCase to replace AnsiLowerCase/AnsiUpperCase for
|
|
.NET code
|
|
|
|
Rev 1.73 1/11/2004 9:50:54 PM BGooijen
|
|
Added ToBytes function for Socks
|
|
|
|
Rev 1.72 2003.12.31 7:32:40 PM czhower
|
|
InMainThread now for .net too.
|
|
|
|
Rev 1.71 2003.12.29 6:48:38 PM czhower
|
|
TextIsSame
|
|
|
|
Rev 1.70 2003.12.28 1:11:04 PM czhower
|
|
Conditional typo fixed.
|
|
|
|
Rev 1.69 2003.12.28 1:05:48 PM czhower
|
|
.Net changes.
|
|
|
|
Rev 1.68 5/12/2003 9:11:00 AM GGrieve
|
|
Add WriteStringToStream
|
|
|
|
Rev 1.67 5/12/2003 12:32:48 AM GGrieve
|
|
fix DotNet warnings
|
|
|
|
Rev 1.66 22/11/2003 12:03:02 AM GGrieve
|
|
fix IdMultiPathFormData.pas implementation
|
|
|
|
Rev 1.65 11/15/2003 1:15:36 PM VVassiliev
|
|
Move AppendByte from IdDNSCommon to IdCoreGlobal
|
|
|
|
Rev 1.64 10/28/2003 8:43:48 PM BGooijen
|
|
compiles, and removed call to setstring
|
|
|
|
Rev 1.63 2003.10.24 10:44:50 AM czhower
|
|
IdStream implementation, bug fixes.
|
|
|
|
Rev 1.62 10/18/2003 4:53:18 PM BGooijen
|
|
Added ToHex
|
|
|
|
Rev 1.61 2003.10.17 6:17:24 PM czhower
|
|
Some parts moved to stream
|
|
|
|
Rev 1.60 10/15/2003 8:28:16 PM DSiders
|
|
Added localization comments.
|
|
|
|
Rev 1.59 2003.10.14 9:27:12 PM czhower
|
|
Fixed compile erorr with missing )
|
|
|
|
Rev 1.58 10/14/2003 3:31:04 PM SPerry
|
|
Modified ByteToHex() and IPv4ToHex
|
|
|
|
Rev 1.57 10/13/2003 5:06:46 PM BGooijen
|
|
Removed local constant IdOctalDigits in favor of the unit constant. - attempt
|
|
2
|
|
|
|
Rev 1.56 10/13/2003 10:07:12 AM DSiders
|
|
Reverted prior change; local constant for IdOctalDigits is restored.
|
|
|
|
Rev 1.55 10/12/2003 11:55:42 AM DSiders
|
|
Removed local constant IdOctalDigits in favor of the unit constant.
|
|
|
|
Rev 1.54 2003.10.11 5:47:22 PM czhower
|
|
-VCL fixes for servers
|
|
-Chain suport for servers (Super core)
|
|
-Scheduler upgrades
|
|
-Full yarn support
|
|
|
|
Rev 1.53 10/8/2003 10:14:34 PM GGrieve
|
|
add WriteStringToStream
|
|
|
|
Rev 1.52 10/8/2003 9:55:30 PM GGrieve
|
|
Add IdDelete
|
|
|
|
Rev 1.51 10/7/2003 11:33:30 PM GGrieve
|
|
Fix ReadStringFromStream
|
|
|
|
Rev 1.50 10/7/2003 10:07:30 PM GGrieve
|
|
Get IdHTTP compiling for DotNet
|
|
|
|
Rev 1.49 6/10/2003 5:48:48 PM SGrobety
|
|
DotNet updates
|
|
|
|
Rev 1.48 10/5/2003 12:26:46 PM BGooijen
|
|
changed parameter names at some places
|
|
|
|
Rev 1.47 10/4/2003 7:08:26 PM BGooijen
|
|
added some conversion routines type->TIdBytes->type, and fixed existing ones
|
|
|
|
Rev 1.46 10/4/2003 3:53:40 PM BGooijen
|
|
added some ToBytes functions
|
|
|
|
Rev 1.45 04/10/2003 13:38:28 HHariri
|
|
Write(Integer) support
|
|
|
|
Rev 1.44 10/3/2003 10:44:54 PM BGooijen
|
|
Added WriteBytesToStream
|
|
|
|
Rev 1.43 2003.10.02 8:29:14 PM czhower
|
|
Changed names of byte conversion routines to be more readily understood and
|
|
not to conflict with already in use ones.
|
|
|
|
Rev 1.42 10/2/2003 5:15:16 PM BGooijen
|
|
Added Grahame's functions
|
|
|
|
Rev 1.41 10/1/2003 8:02:20 PM BGooijen
|
|
Removed some ifdefs and improved code
|
|
|
|
Rev 1.40 2003.10.01 9:10:58 PM czhower
|
|
.Net
|
|
|
|
Rev 1.39 2003.10.01 2:46:36 PM czhower
|
|
.Net
|
|
|
|
Rev 1.38 2003.10.01 2:30:36 PM czhower
|
|
.Net
|
|
|
|
Rev 1.37 2003.10.01 12:30:02 PM czhower
|
|
.Net
|
|
|
|
Rev 1.35 2003.10.01 1:12:32 AM czhower
|
|
.Net
|
|
|
|
Rev 1.34 2003.09.30 7:37:14 PM czhower
|
|
Typo fix.
|
|
|
|
Rev 1.33 30/9/2003 3:58:08 PM SGrobety
|
|
More .net updates
|
|
|
|
Rev 1.31 2003.09.30 3:19:30 PM czhower
|
|
Updates for .net
|
|
|
|
Rev 1.30 2003.09.30 1:22:54 PM czhower
|
|
Stack split for DotNet
|
|
|
|
Rev 1.29 2003.09.30 12:09:36 PM czhower
|
|
DotNet changes.
|
|
|
|
Rev 1.28 2003.09.30 10:36:02 AM czhower
|
|
Moved stack creation to IdStack
|
|
Added DotNet stack.
|
|
|
|
Rev 1.27 9/29/2003 03:03:28 PM JPMugaas
|
|
Changed CIL to DOTNET.
|
|
|
|
Rev 1.26 9/28/2003 04:22:00 PM JPMugaas
|
|
IFDEF'ed out MemoryPos in NET because that will not work there.
|
|
|
|
Rev 1.25 9/26/03 11:20:50 AM RLebeau
|
|
Updated defines used with SetThreadName() to allow it to work under BCB6.
|
|
|
|
Rev 1.24 9/24/2003 11:42:42 PM JPMugaas
|
|
Minor changes to help compile under NET
|
|
|
|
Rev 1.23 2003.09.20 10:25:42 AM czhower
|
|
Added comment and chaned for D6 compat.
|
|
|
|
Rev 1.22 9/18/2003 07:43:12 PM JPMugaas
|
|
Moved GetThreadHandle to IdGlobals so the ThreadComponent can be in this
|
|
package.
|
|
|
|
Rev 1.21 9/8/2003 11:44:38 AM JPMugaas
|
|
Fix for problem that was introduced in an optimization.
|
|
|
|
Rev 1.20 2003.08.19 1:54:34 PM czhower
|
|
Removed warning
|
|
|
|
Rev 1.19 11/8/2003 6:25:44 PM SGrobety
|
|
IPv4ToDWord: Added overflow checking disabling ($Q+) and changed "* 256" by
|
|
"SHL 8".
|
|
|
|
Rev 1.18 2003.07.08 2:41:42 PM czhower
|
|
This time I saved the file before checking in.
|
|
|
|
Rev 1.16 7/1/2003 03:39:38 PM JPMugaas
|
|
Started numeric IP function API calls for more efficiency.
|
|
|
|
Rev 1.15 2003.07.01 3:49:56 PM czhower
|
|
Added SetThreadName
|
|
|
|
Rev 1.14 7/1/2003 12:03:56 AM BGooijen
|
|
Added functions to switch between IPv6 addresses in string and in
|
|
TIdIPv6Address form
|
|
|
|
Rev 1.13 6/30/2003 06:33:58 AM JPMugaas
|
|
Fix for range check error.
|
|
|
|
Rev 1.12 6/27/2003 04:43:30 PM JPMugaas
|
|
Made IPv4ToDWord overload that returns a flag for an error message.
|
|
Moved MakeCanonicalIPv4Address code into IPv4ToDWord because most of that
|
|
simply reduces IPv4 addresses into a DWord. That also should make the
|
|
function more useful in reducing various alternative forms of IPv4 addresses
|
|
down to DWords.
|
|
|
|
Rev 1.11 6/27/2003 01:19:38 PM JPMugaas
|
|
Added MakeCanonicalIPv4Address for converting various IPv4 address forms
|
|
(mentioned at http://www.pc-help.org/obscure.htm) into a standard dotted IP
|
|
address. Hopefully, we should soon support octal and hexidecimal addresses.
|
|
|
|
Rev 1.9 6/27/2003 04:36:08 AM JPMugaas
|
|
Function for converting DWord to IP adcdress.
|
|
|
|
Rev 1.8 6/26/2003 07:54:38 PM JPMugaas
|
|
Routines for converting standard dotted IPv4 addresses into dword,
|
|
hexidecimal, and octal forms.
|
|
|
|
Rev 1.7 5/11/2003 11:57:06 AM BGooijen
|
|
Added RaiseLastOSError
|
|
|
|
Rev 1.6 4/28/2003 03:19:00 PM JPMugaas
|
|
Made a function for obtaining the services file FQN. That's in case
|
|
something else besides IdPorts needs it.
|
|
|
|
Rev 1.5 2003.04.16 10:06:42 PM czhower
|
|
Moved DebugOutput to IdCoreGlobal
|
|
|
|
Rev 1.4 12/29/2002 2:15:30 PM JPMugaas
|
|
GetCurrentThreadHandle function created as per Bas's instructions. Moved
|
|
THandle to IdCoreGlobal for this function.
|
|
|
|
Rev 1.3 12-15-2002 17:02:58 BGooijen
|
|
Added comments to TIdExtList
|
|
|
|
Rev 1.2 12-15-2002 16:45:42 BGooijen
|
|
Added TIdList
|
|
|
|
Rev 1.1 29/11/2002 10:08:50 AM SGrobety Version: 1.1
|
|
Changed GetTickCount to use high-performance timer if available under windows
|
|
|
|
Rev 1.0 21/11/2002 12:36:18 PM SGrobety Version: Indy 10
|
|
|
|
Rev 1.0 11/13/2002 08:41:24 AM JPMugaas
|
|
}
|
|
|
|
unit IdGlobal;
|
|
|
|
interface
|
|
|
|
{$I IdCompilerDefines.inc}
|
|
|
|
uses
|
|
SysUtils,
|
|
{$IFDEF DOTNET}
|
|
System.Collections.Specialized,
|
|
System.net,
|
|
System.net.Sockets,
|
|
System.Diagnostics,
|
|
System.Threading,
|
|
System.IO,
|
|
System.Text,
|
|
{$ELSE}
|
|
{$IFDEF HAS_UNIT_Generics_Collections}
|
|
System.Generics.Collections,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
{$IFDEF FPC}
|
|
windows,
|
|
{$ELSE}
|
|
Windows,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Classes,
|
|
syncobjs,
|
|
{$IFDEF UNIX}
|
|
{$IFDEF KYLIXCOMPAT}
|
|
Libc,
|
|
{$ELSE}
|
|
{$IFDEF FPC}
|
|
DynLibs, // better add DynLibs only for fpc
|
|
{$ENDIF}
|
|
{$IFDEF USE_VCL_POSIX}
|
|
Posix.SysTypes, Posix.Pthread, Posix.Unistd,
|
|
{$ENDIF}
|
|
{$IFDEF USE_BASEUNIX}
|
|
BaseUnix, Unix, Sockets, UnixType,
|
|
{$ENDIF}
|
|
{$IFDEF USE_ICONV_ENC}iconvenc, {$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF DARWIN}
|
|
{$IFNDEF FPC}
|
|
//RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
|
|
Macapi.Mach,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
IdException;
|
|
|
|
{$IFNDEF HAS_Int8}
|
|
type
|
|
Int8 = {$IFDEF DOTNET}System.SByte{$ELSE}Shortint{$ENDIF};
|
|
{$NODEFINE Int8}
|
|
{$ENDIF}
|
|
{$IFNDEF HAS_PInt8}
|
|
{$IFNDEF DOTNET}
|
|
type
|
|
PInt8 = PShortint;
|
|
{$NODEFINE PInt8}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF HAS_UInt8}
|
|
type
|
|
UInt8 = {$IFDEF DOTNET}System.Byte{$ELSE}Byte{$ENDIF};
|
|
{$NODEFINE UInt8}
|
|
{$ENDIF}
|
|
{$IFNDEF HAS_PUInt8}
|
|
{$IFNDEF DOTNET}
|
|
type
|
|
PUInt8 = PByte;
|
|
{$NODEFINE PUInt8}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF HAS_Int16}
|
|
type
|
|
Int16 = Smallint;
|
|
{$NODEFINE Int16}
|
|
{$ENDIF}
|
|
{$IFNDEF HAS_PInt16}
|
|
{$IFNDEF DOTNET}
|
|
type
|
|
PInt16 = PSmallint;
|
|
{$NODEFINE PInt16}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF HAS_UInt16}
|
|
type
|
|
UInt16 = Word;
|
|
{$NODEFINE UInt16}
|
|
{$ENDIF}
|
|
{$IFNDEF HAS_PUInt16}
|
|
{$IFNDEF DOTNET}
|
|
type
|
|
PUInt16 = PWord;
|
|
{$NODEFINE PUInt16}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF HAS_Int32}
|
|
type
|
|
Int32 = Integer;
|
|
{$NODEFINE Int32}
|
|
{$ENDIF}
|
|
{$IFNDEF HAS_PInt32}
|
|
{$IFNDEF DOTNET}
|
|
type
|
|
PInt32 = PInteger;
|
|
{$NODEFINE PInt32}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF HAS_UInt32}
|
|
type
|
|
UInt32 = Cardinal;
|
|
{$NODEFINE UInt32}
|
|
{$ENDIF}
|
|
{$IFNDEF HAS_PUInt32}
|
|
{$IFNDEF DOTNET}
|
|
type
|
|
PUInt32 = PCardinal;
|
|
{$NODEFINE PUInt32}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF HAS_UInt64}
|
|
{$DEFINE UInt64_IS_NATIVE}
|
|
// In C++Builder 2006 and 2007, UInt64 is emitted as signed __int64 in HPP
|
|
// files instead of as unsigned __int64. This causes conflicts in overloaded
|
|
// routines that have (U)Int64 parameters. This was fixed in C++Builder 2009...
|
|
{$IFNDEF BROKEN_UINT64_HPPEMIT}
|
|
type
|
|
TIdUInt64 = UInt64;
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF HAS_QWord}
|
|
{$DEFINE UInt64_IS_NATIVE}
|
|
type
|
|
UInt64 = QWord;
|
|
{$NODEFINE UInt64}
|
|
TIdUInt64 = QWord;
|
|
{$ELSE}
|
|
type
|
|
UInt64 = Int64;
|
|
{$NODEFINE UInt64}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TIdUInt64_IS_NOT_NATIVE}
|
|
// For compilers that do not have a native UInt64 type, or for C++Builder
|
|
// 2006/2007 with its broken UInt64 HPP emit, let's define a record type
|
|
// that can hold UInt64 values, and then use it wherever UInt64 parameters
|
|
// are needed...
|
|
type
|
|
TIdUInt64 = packed record
|
|
case Integer of
|
|
0: (
|
|
{$IFDEF ENDIAN_BIG}
|
|
HighPart: UInt32;
|
|
LowPart: UInt32
|
|
{$ELSE}
|
|
LowPart: UInt32;
|
|
HighPart: UInt32
|
|
{$ENDIF}
|
|
);
|
|
1: (
|
|
QuadPart: UInt64
|
|
);
|
|
end;
|
|
{$NODEFINE TIdUInt64}
|
|
|
|
(*$HPPEMIT 'namespace Idglobal'*)
|
|
(*$HPPEMIT '{'*)
|
|
(*$HPPEMIT ' #pragma pack(push, 1)' *)
|
|
(*$HPPEMIT ' struct TIdUInt64'*)
|
|
(*$HPPEMIT ' {'*)
|
|
(*$HPPEMIT ' union {'*)
|
|
(*$HPPEMIT ' struct {'*)
|
|
{$IFDEF ENDIAN_BIG}
|
|
(*$HPPEMIT ' unsigned __int32 HighPart;'*)
|
|
(*$HPPEMIT ' unsigned __int32 LowPart;'*)
|
|
{$ELSE}
|
|
(*$HPPEMIT ' unsigned __int32 LowPart;'*)
|
|
(*$HPPEMIT ' unsigned __int32 HighPart;'*)
|
|
{$ENDIF}
|
|
(*$HPPEMIT ' };'*)
|
|
(*$HPPEMIT ' unsigned __int64 QuadPart;'*)
|
|
(*$HPPEMIT ' };'*)
|
|
(*$HPPEMIT ' TIdUInt64(unsigned __int64 value) { QuadPart = value; }'*)
|
|
(*$HPPEMIT ' operator unsigned __int64() const { return QuadPart; }'*)
|
|
(*$HPPEMIT ' };'*)
|
|
(*$HPPEMIT ' #pragma pack(pop)' *)
|
|
(*$HPPEMIT '}'*)
|
|
{$ENDIF}
|
|
|
|
const
|
|
{This is the only unit with references to OS specific units and IFDEFs. NO OTHER units
|
|
are permitted to do so except .pas files which are counterparts to dfm/xfm files, and only for
|
|
support of that.}
|
|
|
|
//We make the version things an Inc so that they can be managed independantly
|
|
//by the package builder.
|
|
{$I IdVers.inc}
|
|
|
|
{$IFNDEF HAS_TIMEUNITS}
|
|
HoursPerDay = 24;
|
|
MinsPerHour = 60;
|
|
SecsPerMin = 60;
|
|
MSecsPerSec = 1000;
|
|
MinsPerDay = HoursPerDay * MinsPerHour;
|
|
SecsPerDay = MinsPerDay * SecsPerMin;
|
|
MSecsPerDay = SecsPerDay * MSecsPerSec;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DOTNET}
|
|
// Timeout.Infinite is -1 which violates Cardinal which VCL uses for parameter
|
|
// so we are just setting it to this as a hard coded constant until
|
|
// the synchro classes and other are all ported directly to portable classes
|
|
// (SyncObjs is platform specific)
|
|
//Infinite = Timeout.Infinite;
|
|
INFINITE = UInt32($FFFFFFFF); { Infinite timeout }
|
|
{$ENDIF}
|
|
|
|
{$IFDEF KYLIX}
|
|
NilHandle = 0;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI}
|
|
NilHandle = 0;
|
|
{$ENDIF}
|
|
LF = #10;
|
|
CR = #13;
|
|
|
|
// RLebeau: EOL is NOT to be used as a platform-specific line break! Most
|
|
// text-based protocols that Indy implements are defined to use CRLF line
|
|
// breaks. DO NOT change this! If you need a platform-based line break,
|
|
// use sLineBreak instead.
|
|
EOL = CR + LF;
|
|
//
|
|
CHAR0 = #0;
|
|
BACKSPACE = #8;
|
|
|
|
TAB = #9;
|
|
CHAR32 = #32;
|
|
|
|
//Timeout values
|
|
IdTimeoutDefault = -1;
|
|
IdTimeoutInfinite = -2;
|
|
//Fetch Defaults
|
|
IdFetchDelimDefault = ' '; {Do not Localize}
|
|
IdFetchDeleteDefault = True;
|
|
IdFetchCaseSensitiveDefault = True;
|
|
|
|
IdWhiteSpace = [0..12, 14..32]; {do not localize}
|
|
|
|
IdHexDigits: array [0..15] of Char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'); {do not localize}
|
|
IdOctalDigits: array [0..7] of Char = ('0','1','2','3','4','5','6','7'); {do not localize}
|
|
IdHexPrefix = '0x'; {Do not translate}
|
|
|
|
type
|
|
//thread and PID stuff
|
|
{$IFDEF DOTNET}
|
|
TIdPID = UInt32;
|
|
TIdThreadId = UInt32;
|
|
TIdThreadHandle = System.Threading.Thread;
|
|
{$IFDEF DOTNETDISTRO}
|
|
TIdThreadPriority = System.Threading.ThreadPriority;
|
|
{$ELSE}
|
|
TIdThreadPriority = TThreadPriority;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF UNIX}
|
|
{$IFDEF KYLIXCOMPAT}
|
|
TIdPID = Int32;
|
|
TIdThreadId = Int32;
|
|
{$IFDEF FPC}
|
|
TIdThreadHandle = TThreadID;
|
|
{$ELSE}
|
|
TIdThreadHandle = UInt32;
|
|
{$ENDIF}
|
|
{$IFDEF INT_THREAD_PRIORITY}
|
|
TIdThreadPriority = -20..19;
|
|
{$ELSE}
|
|
TIdThreadPriority = TThreadPriority;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF USE_BASEUNIX}
|
|
TIdPID = TPid;
|
|
TIdThreadId = TThreadId;
|
|
TIdThreadHandle = TIdThreadId;
|
|
TIdThreadPriority = TThreadPriority;
|
|
{$ENDIF}
|
|
{$IFDEF USE_VCL_POSIX}
|
|
TIdPID = pid_t;
|
|
TIdThreadId = NativeUInt;
|
|
TIdThreadHandle = NativeUInt;
|
|
{$IFDEF INT_THREAD_PRIORITY}
|
|
TIdThreadPriority = -20..19;
|
|
{$ELSE}
|
|
TIdThreadPriority = TThreadPriority;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
TIdPID = UInt32;
|
|
TIdThreadId = UInt32;
|
|
TIdThreadHandle = THandle;
|
|
{$I IdSymbolPlatformOff.inc}
|
|
TIdThreadPriority = TThreadPriority;
|
|
{$I IdSymbolPlatformOn.inc}
|
|
{$ENDIF}
|
|
|
|
TIdTicks = UInt64;
|
|
|
|
{$IFDEF INT_THREAD_PRIORITY}
|
|
const
|
|
// approximate values, its finer grained on Linux
|
|
tpIdle = 19;
|
|
tpLowest = 12;
|
|
tpLower = 6;
|
|
tpNormal = 0;
|
|
tpHigher = -7;
|
|
tpHighest = -13;
|
|
tpTimeCritical = -20;
|
|
{$ENDIF}
|
|
{CH tpIdLowest = tpLowest; }
|
|
{CH tpIdBelowNormal = tpLower; }
|
|
{CH tpIdNormal = tpNormal; }
|
|
{CH tpIdAboveNormal = tpHigher; }
|
|
{CH tpIdHighest = tpHighest; }
|
|
//end thread stuff
|
|
|
|
const
|
|
//leave this as zero. It's significant in many socket calls that specify ports
|
|
DEF_PORT_ANY = 0;
|
|
|
|
type
|
|
{$IFDEF DOTNET}
|
|
TIdUnicodeString = System.String;
|
|
{$ELSE}
|
|
{$IFDEF HAS_UnicodeString}
|
|
TIdUnicodeString = UnicodeString;
|
|
{$ELSE}
|
|
TIdUnicodeString = WideString;
|
|
// RP 9/12/2014: Synopse just released a unit that patches the System unit
|
|
// in pre-Unicode versions of Delphi to redirect WideString memory management
|
|
// to the RTL's memory manager (FastMM, etc) instead of the Win32 COM API!
|
|
//
|
|
// http://blog.synopse.info/post/2014/09/12/Faster-WideString-process-for-good-old-non-Unicode-Delphi-6-2007
|
|
// https://github.com/synopse/mORMot/blob/master/SynFastWideString.pas
|
|
//
|
|
// We should consider providing an optional setting to enable that patch
|
|
// so we can get a performance boost for Unicode-enabled code that uses
|
|
// TIdUnicodeString...
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
// the Delphi next-gen compiler eliminates AnsiString/AnsiChar/PAnsiChar,
|
|
// but we still need to deal with Ansi data. Unfortunately, the compiler
|
|
// won't let us use its secret _AnsiChr types either, so we have to use
|
|
// Byte instead unless we can find a better solution...
|
|
|
|
{$IFDEF HAS_AnsiChar}
|
|
TIdAnsiChar = AnsiChar;
|
|
{$ELSE}
|
|
TIdAnsiChar = Byte;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF HAS_PAnsiChar}
|
|
PIdAnsiChar = PAnsiChar;
|
|
{$ELSE}
|
|
{$IFDEF HAS_MarshaledAString}
|
|
PIdAnsiChar = MarshaledAString;
|
|
{$ELSE}
|
|
PIdAnsiChar = PByte;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF HAS_PPAnsiChar}
|
|
PPIdAnsiChar = PPAnsiChar;
|
|
{$ELSE}
|
|
PPIdAnsiChar = ^PIdAnsiChar;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
TIdWideChar = Char;
|
|
PIdWideChar = PChar;
|
|
{$ELSE}
|
|
TIdWideChar = WideChar;
|
|
PIdWideChar = PWideChar;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF WINDOWS}
|
|
// .NET and Delphi 2009+ support UNICODE strings natively!
|
|
//
|
|
// FreePascal 2.4.0+ supports UnicodeString, but does not map its native
|
|
// String type to UnicodeString except when {$MODE DelphiUnicode} or
|
|
// {$MODESWITCH UnicodeStrings} is enabled. However, UNICODE is not
|
|
// defined in that mode yet until FreePascal's RTL has been updated to
|
|
// support UnicodeString. STRING_UNICODE_MISMATCH is defined in
|
|
// IdCompilerDefines.inc when the compiler's native String/Char types do
|
|
// not map to the same types that API functions are expecting based on
|
|
// whether UNICODE is defined or not. So we will create special Platform
|
|
// typedefs here to help with API function calls when dealing with that
|
|
// mismatch...
|
|
{$IFDEF UNICODE}
|
|
TIdPlatformString = TIdUnicodeString;
|
|
TIdPlatformChar = TIdWideChar;
|
|
PIdPlatformChar = PIdWideChar;
|
|
{$ELSE}
|
|
TIdPlatformString = AnsiString;
|
|
TIdPlatformChar = TIdAnsiChar;
|
|
PIdPlatformChar = PIdAnsiChar;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
TIdBytes = array of Byte;
|
|
TIdWideChars = array of TIdWideChar;
|
|
|
|
//NOTE: The code below assumes a 32bit Linux architecture (such as target i386-linux)
|
|
{$UNDEF CPU32_OR_KYLIX}
|
|
{$IFNDEF DOTNET}
|
|
{$IFDEF CPU32}
|
|
{$DEFINE CPU32_OR_KYLIX}
|
|
{$ENDIF}
|
|
{$IFDEF KYLIX}
|
|
{$DEFINE CPU32_OR_KYLIX}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
// native signed and unsigned integer sized pointer types
|
|
|
|
{$IFDEF DOTNET}
|
|
TIdNativeInt = IntPtr;
|
|
TIdNativeUInt = UIntPtr;
|
|
{$ELSE}
|
|
{$IFDEF HAS_NativeInt}
|
|
TIdNativeInt = NativeInt;
|
|
{$ELSE}
|
|
{$IFDEF CPU32}
|
|
TIdNativeInt = Int32;
|
|
{$ENDIF}
|
|
{$IFDEF CPU64}
|
|
TIdNativeInt = Int64;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF HAS_NativeUInt}
|
|
TIdNativeUInt = NativeUInt;
|
|
{$ELSE}
|
|
{$IFDEF CPU32}
|
|
TIdNativeUInt = UInt32;
|
|
{$ENDIF}
|
|
{$IFDEF CPU64}
|
|
TIdNativeUInt = UInt64;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF HAS_PtrInt}
|
|
PtrInt = TIdNativeInt;
|
|
{$ENDIF}
|
|
{$IFNDEF HAS_PtrUInt}
|
|
PtrUInt = TIdNativeUInt;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF STREAM_SIZE_64}
|
|
TIdStreamSize = Int64;
|
|
{$ELSE}
|
|
TIdStreamSize = Int32;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF HAS_SIZE_T}
|
|
{$EXTERNALSYM size_t}
|
|
size_t = PtrUInt;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF HAS_PSIZE_T}
|
|
{$EXTERNALSYM Psize_t}
|
|
Psize_t = ^size_t;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
// In .NET and Delphi next-gen, strings are immutable (and zero-indexed), so we
|
|
// need to use a StringBuilder whenever we need to modify individual characters
|
|
// of a string...
|
|
TIdStringBuilder = {$IFDEF DOTNET}System.Text.StringBuilder{$ELSE}TStringBuilder{$ENDIF};
|
|
{$ENDIF}
|
|
|
|
{
|
|
Delphi/C++Builder 2009+ have a TEncoding class which mirrors System.Text.Encoding
|
|
in .NET, but does not have a TDecoder class which mirrors System.Text.Decoder
|
|
in .NET. TEncoding's interface changes from version to version, in some ways
|
|
that cause compatibility issues when trying to write portable code, so we will
|
|
not rely on it. IIdTextEncoding is our own wrapper so we have control over
|
|
text encodings.
|
|
|
|
This way, Indy can have a unified internal interface for String<->Byte conversions
|
|
without using IFDEFs everywhere.
|
|
|
|
Note: Having the wrapper class use WideString in earlier versions adds extra
|
|
overhead to string operations, but this is the only way to ensure that strings
|
|
are encoded properly. Later on, perhaps we can optimize the operations when
|
|
Ansi-compatible encodings are being used with AnsiString values.
|
|
}
|
|
|
|
{$IFNDEF HAS_IInterface}
|
|
IInterface = IUnknown;
|
|
{$ENDIF}
|
|
|
|
IIdTextEncoding = interface(IInterface)
|
|
['{FA87FAE5-E3E3-4632-8FCA-2FB786848655}']
|
|
function GetByteCount(const AChars: TIdWideChars): Integer; overload;
|
|
function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
|
|
{$IFNDEF DOTNET}
|
|
function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload;
|
|
{$ENDIF}
|
|
function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
|
|
function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
|
|
function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
|
|
function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
|
|
function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
|
|
{$IFNDEF DOTNET}
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes; overload;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload;
|
|
{$ENDIF}
|
|
function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
|
|
function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
|
|
function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
|
|
function GetCharCount(const ABytes: TIdBytes): Integer; overload;
|
|
function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
|
|
{$IFNDEF DOTNET}
|
|
function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload;
|
|
{$ENDIF}
|
|
function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
|
|
function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
|
|
function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
|
|
{$IFNDEF DOTNET}
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars; overload;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload;
|
|
{$ENDIF}
|
|
function GetIsSingleByte: Boolean;
|
|
function GetMaxByteCount(ACharCount: Integer): Integer;
|
|
function GetMaxCharCount(AByteCount: Integer): Integer;
|
|
function GetPreamble: TIdBytes;
|
|
function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
|
|
function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
|
|
{$IFNDEF DOTNET}
|
|
function GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString; overload;
|
|
{$ENDIF}
|
|
property IsSingleByte: Boolean read GetIsSingleByte;
|
|
end;
|
|
|
|
IdTextEncodingType = (encIndyDefault, encOSDefault, enc8Bit, encASCII, encUTF16BE, encUTF16LE, encUTF7, encUTF8);
|
|
|
|
function IndyTextEncoding(AType: IdTextEncodingType): IIdTextEncoding; overload;
|
|
function IndyTextEncoding(ACodepage: UInt16): IIdTextEncoding; overload;
|
|
function IndyTextEncoding(const ACharSet: String): IIdTextEncoding; overload;
|
|
{$IFDEF DOTNET}
|
|
function IndyTextEncoding(AEncoding: System.Text.Encoding): IIdTextEncoding; overload;
|
|
{$ENDIF}
|
|
{$IFDEF HAS_TEncoding}
|
|
function IndyTextEncoding(AEncoding: TEncoding; AFreeEncoding: Boolean = False): IIdTextEncoding; overload;
|
|
{$ENDIF}
|
|
|
|
function IndyTextEncoding_Default: IIdTextEncoding;
|
|
function IndyTextEncoding_OSDefault: IIdTextEncoding;
|
|
function IndyTextEncoding_8Bit: IIdTextEncoding;
|
|
function IndyTextEncoding_ASCII: IIdTextEncoding;
|
|
function IndyTextEncoding_UTF16BE: IIdTextEncoding;
|
|
function IndyTextEncoding_UTF16LE: IIdTextEncoding;
|
|
function IndyTextEncoding_UTF7: IIdTextEncoding;
|
|
function IndyTextEncoding_UTF8: IIdTextEncoding;
|
|
|
|
// These are for backwards compatibility with past Indy 10 releases
|
|
function enDefault: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_Default() or a nil IIdTextEncoding pointer'{$ENDIF};{$ENDIF}
|
|
{$NODEFINE enDefault}
|
|
function en7Bit: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_ASCII()'{$ENDIF};{$ENDIF}
|
|
{$NODEFINE en7Bit}
|
|
function en8Bit: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_8Bit()'{$ENDIF};{$ENDIF}
|
|
{$NODEFINE en8Bit}
|
|
function enUTF8: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF8()'{$ENDIF};{$ENDIF}
|
|
{$NODEFINE enUTF8}
|
|
|
|
function Indy8BitEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_8Bit()'{$ENDIF};{$ENDIF}
|
|
function IndyASCIIEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_ASCII()'{$ENDIF};{$ENDIF}
|
|
function IndyUTF16BigEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF16BE()'{$ENDIF};{$ENDIF}
|
|
function IndyUTF16LittleEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF16LE()'{$ENDIF};{$ENDIF}
|
|
function IndyOSDefaultEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_OSDefault()'{$ENDIF};{$ENDIF}
|
|
function IndyUTF7Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF7()'{$ENDIF};{$ENDIF}
|
|
function IndyUTF8Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF8()'{$ENDIF};{$ENDIF}
|
|
|
|
(*$HPPEMIT '// These are helper macros to handle differences between C++Builder versions'*)
|
|
(*$HPPEMIT '#define TIdTextEncoding_ASCII IndyTextEncoding_ASCII()'*)
|
|
(*$HPPEMIT '#define TIdTextEncoding_BigEndianUnicode IndyTextEncoding_UTF16BE()'*)
|
|
(*$HPPEMIT '#define TIdTextEncoding_Default IndyTextEncoding_OSDefault()'*)
|
|
(*$HPPEMIT '#define TIdTextEncoding_Unicode IndyTextEncoding_UTF16LE()'*)
|
|
(*$HPPEMIT '#define TIdTextEncoding_UTF7 IndyTextEncoding_UTF7()'*)
|
|
(*$HPPEMIT '#define TIdTextEncoding_UTF8 IndyTextEncoding_UTF8()'*)
|
|
(*$HPPEMIT ''*)
|
|
|
|
(*$HPPEMIT '// These are for backwards compatibility with earlier Indy 10 releases'*)
|
|
(*$HPPEMIT '#define enDefault ( ( IIdTextEncoding* )NULL )'*)
|
|
(*$HPPEMIT '#define en8Bit IndyTextEncoding_8Bit()'*)
|
|
(*$HPPEMIT '#define en7Bit IndyTextEncoding_ASCII()'*)
|
|
(*$HPPEMIT '#define enUTF8 IndyTextEncoding_UTF8()'*)
|
|
(*$HPPEMIT ''*)
|
|
|
|
var
|
|
{RLebeau: using ASCII by default because most Internet protocols that Indy
|
|
implements are based on ASCII specifically, not Ansi. Non-ASCII data has
|
|
to be explicitally allowed by RFCs, in which case the caller should not be
|
|
using nil IIdTextEncoding objects to begin with...}
|
|
GIdDefaultTextEncoding: IdTextEncodingType = encASCII;
|
|
|
|
{$IFDEF USE_ICONV}
|
|
// This indicates whether encOSDefault should map to an OS dependant Ansi
|
|
// locale or to ASCII. Defaulting to ASCII for now to maintain compatibility
|
|
// with earlier Indy 10 releases...
|
|
GIdIconvUseLocaleDependantAnsiEncoding: Boolean = False;
|
|
|
|
// This indicates whether Iconv should ignore characters that cannot be
|
|
// converted. Defaulting to false for now to maintain compatibility with
|
|
// earlier Indy 10 releases...
|
|
GIdIconvIgnoreIllegalChars: Boolean = False;
|
|
|
|
// This indicates whether Iconv should transliterate characters that cannot
|
|
// be converted. Defaulting to false for now to maintain compatibility with
|
|
// earlier Indy 10 releases...
|
|
GIdIconvUseTransliteration: Boolean = False;
|
|
{$ENDIF}
|
|
|
|
procedure EnsureEncoding(var VEncoding : IIdTextEncoding; ADefEncoding: IdTextEncodingType = encIndyDefault);
|
|
procedure CheckByteEncoding(var VBytes: TIdBytes; ASrcEncoding, ADestEncoding: IIdTextEncoding);
|
|
|
|
type
|
|
TIdAppendFileStream = class(TFileStream)
|
|
public
|
|
constructor Create(const AFile : String);
|
|
end;
|
|
|
|
TIdReadFileExclusiveStream = class(TFileStream)
|
|
public
|
|
constructor Create(const AFile : String);
|
|
end;
|
|
|
|
TIdReadFileNonExclusiveStream = class(TFileStream)
|
|
public
|
|
constructor Create(const AFile : String);
|
|
end;
|
|
|
|
TIdFileCreateStream = class(TFileStream)
|
|
public
|
|
constructor Create(const AFile : String);
|
|
end;
|
|
|
|
{$IFDEF DOTNET}
|
|
{$IFNDEF DOTNET_2_OR_ABOVE}
|
|
// dotNET implementation
|
|
TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
|
|
|
|
TEvent = class(TObject)
|
|
protected
|
|
FEvent: WaitHandle;
|
|
public
|
|
constructor Create(EventAttributes: IntPtr; ManualReset,
|
|
InitialState: Boolean; const Name: string = ''); overload;
|
|
constructor Create; overload;
|
|
destructor Destroy; override;
|
|
procedure SetEvent;
|
|
procedure ResetEvent;
|
|
function WaitFor(Timeout: UInt32): TWaitResult; virtual;
|
|
end;
|
|
|
|
TCriticalSection = class(TObject)
|
|
public
|
|
procedure Acquire; virtual;
|
|
procedure Release; virtual;
|
|
function TryEnter: Boolean;
|
|
procedure Enter;
|
|
procedure Leave;
|
|
end;
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
{$IFNDEF NO_REDECLARE}
|
|
// TCriticalSection = SyncObjs.TCriticalSection;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
TIdLocalEvent = class(TEvent)
|
|
public
|
|
constructor Create(const AInitialState: Boolean = False;
|
|
const AManualReset: Boolean = False); reintroduce;
|
|
function WaitForEver: TWaitResult; overload;
|
|
end;
|
|
|
|
// This is here to reduce all the warnings about imports. We may also ifdef
|
|
// it to provide a non warning implementatino on this unit too later.
|
|
TIdCriticalSection = class(TCriticalSection)
|
|
end;
|
|
|
|
//Only needed for ToBytes(Short) and BytesToShort
|
|
{$IFDEF DOTNET}
|
|
Short = System.Int16 {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Int16'{$ENDIF}{$ENDIF};
|
|
{$ENDIF}
|
|
{$IFDEF UNIX}
|
|
Short = Int16 {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Int16'{$ENDIF}{$ENDIF};
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF DOTNET}
|
|
{$IFNDEF NO_REDECLARE}
|
|
PShort = ^Short;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF DOTNET}
|
|
{$IFNDEF HAS_PCardinal}
|
|
PCardinal = ^Cardinal;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF HAS_QWord}
|
|
{$IFNDEF HAS_PQWord}
|
|
PQWord = ^QWord;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF HAS_UInt64}
|
|
{$IFNDEF HAS_PUInt64}
|
|
PUInt64 = ^UInt64;
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
PUInt64 = {$IFDEF HAS_QWord}PQWord{$ELSE}PInt64{$ENDIF};
|
|
{$ENDIF}
|
|
|
|
//This usually is a property editor exception
|
|
EIdCorruptServicesFile = class(EIdException);
|
|
EIdEndOfStream = class(EIdException);
|
|
EIdInvalidIPv6Address = class(EIdException);
|
|
EIdNoEncodingSpecified = class(EIdException);
|
|
//This is called whenever there is a failure to retreive the time zone information
|
|
EIdFailedToRetreiveTimeZoneInfo = class(EIdException);
|
|
|
|
TIdPort = UInt16;
|
|
|
|
//We don't have a native type that can hold an IPv6 address.
|
|
{$NODEFINE TIdIPv6Address}
|
|
TIdIPv6Address = array [0..7] of UInt16;
|
|
|
|
// C++ does not allow an array to be returned by a function,
|
|
// so wrapping the array in a struct as a workaround...
|
|
//
|
|
// This is one place where Word is being used instead of UInt16.
|
|
// On OSX/iOS, UInt16 is defined in mactypes.h, not in System.hpp!
|
|
// don't want to use a bunch of IFDEF's trying to figure out where
|
|
// UInt16 is coming from...
|
|
//
|
|
(*$HPPEMIT 'namespace Idglobal'*)
|
|
(*$HPPEMIT '{'*)
|
|
(*$HPPEMIT ' struct TIdIPv6Address'*)
|
|
(*$HPPEMIT ' {'*)
|
|
(*$HPPEMIT ' ::System::Word data[8];'*)
|
|
(*$HPPEMIT ' ::System::Word& operator[](int index) { return data[index]; }'*)
|
|
(*$HPPEMIT ' const ::System::Word& operator[](int index) const { return data[index]; }'*)
|
|
(*$HPPEMIT ' operator const ::System::Word*() const { return data; }'*)
|
|
(*$HPPEMIT ' operator ::System::Word*() { return data; }'*)
|
|
(*$HPPEMIT ' };'*)
|
|
(*$HPPEMIT '}'*)
|
|
|
|
{This way instead of a boolean for future expansion of other actions}
|
|
TIdMaxLineAction = (maException, maSplit);
|
|
TIdOSType = (otUnknown, otUnix, otWindows, otDotNet);
|
|
//This is for IPv6 support when merged into the core
|
|
TIdIPVersion = (Id_IPv4, Id_IPv6);
|
|
|
|
{$IFNDEF NO_REDECLARE}
|
|
{$IFDEF LINUX}
|
|
{$IFNDEF VCL_6_OR_ABOVE}
|
|
THandle = UInt32; //D6.System
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF DOTNET}
|
|
THandle = Int32;
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
// THandle = Windows.THandle;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
TPosProc = function(const substr, str: String): Integer;
|
|
{$IFNDEF DOTNET}
|
|
TStrScanProc = function(Str: PChar; Chr: Char): PChar;
|
|
{$ENDIF}
|
|
TIdReuseSocket = (rsOSDependent, rsTrue, rsFalse);
|
|
|
|
{$IFNDEF STREAM_SIZE_64}
|
|
type
|
|
TSeekOrigin = (soBeginning, soCurrent, soEnd);
|
|
{$ENDIF}
|
|
|
|
// TIdBaseStream is defined here to allow TIdMultiPartFormData to be defined
|
|
// without any $IFDEFs in the unit IdMultiPartFormData - in accordance with Indy Coding rules
|
|
TIdBaseStream = class(TStream)
|
|
protected
|
|
function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
|
|
function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
|
|
function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; virtual; abstract;
|
|
procedure IdSetSize(ASize: Int64); virtual; abstract;
|
|
{$IFDEF DOTNET}
|
|
procedure SetSize(ASize: Int64); override;
|
|
{$ELSE}
|
|
{$IFDEF STREAM_SIZE_64}
|
|
procedure SetSize(const NewSize: Int64); override;
|
|
{$ELSE}
|
|
procedure SetSize(ASize: Integer); override;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
public
|
|
{$IFDEF DOTNET}
|
|
function Read(var VBuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
|
|
function Write(const ABuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
|
|
function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
|
|
{$ELSE}
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
{$IFDEF STREAM_SIZE_64}
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
|
|
{$ELSE}
|
|
function Seek(Offset: Longint; Origin: Word): Longint; override;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
TIdCalculateSizeStream = class(TIdBaseStream)
|
|
protected
|
|
FPosition: Int64;
|
|
FSize: Int64;
|
|
function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
|
|
function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
|
|
function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
|
|
procedure IdSetSize(ASize: Int64); override;
|
|
end;
|
|
|
|
TIdStreamReadEvent = procedure(var VBuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint) of object;
|
|
TIdStreamWriteEvent = procedure(const ABuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint) of object;
|
|
TIdStreamSeekEvent = procedure(const AOffset: Int64; AOrigin: TSeekOrigin; var VPosition: Int64) of object;
|
|
TIdStreamSetSizeEvent = procedure(const ANewSize: Int64) of object;
|
|
|
|
TIdEventStream = class(TIdBaseStream)
|
|
protected
|
|
FOnRead: TIdStreamReadEvent;
|
|
FOnWrite: TIdStreamWriteEvent;
|
|
FOnSeek: TIdStreamSeekEvent;
|
|
FOnSetSize: TIdStreamSetSizeEvent;
|
|
function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
|
|
function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
|
|
function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
|
|
procedure IdSetSize(ASize: Int64); override;
|
|
public
|
|
property OnRead: TIdStreamReadEvent read FOnRead write FOnRead;
|
|
property OnWrite: TIdStreamWriteEvent read FOnWrite write FOnWrite;
|
|
property OnSeek: TIdStreamSeekEvent read FOnSeek write FOnSeek;
|
|
property OnSetSize: TIdStreamSetSizeEvent read FOnSetSize write FOnSetSize;
|
|
end;
|
|
|
|
{$IFNDEF DOTNET} // what is the .NET equivilent?
|
|
TIdMemoryBufferStream = class(TCustomMemoryStream)
|
|
public
|
|
constructor Create(APtr: Pointer; ASize: TIdNativeInt);
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
const
|
|
{$IFDEF UNIX}
|
|
GOSType = otUnix;
|
|
GPathDelim = '/'; {do not localize}
|
|
INFINITE = UInt32($FFFFFFFF); { Infinite timeout }
|
|
{$ENDIF}
|
|
|
|
{$IFDEF WINDOWS}
|
|
GOSType = otWindows;
|
|
GPathDelim = '\'; {do not localize}
|
|
Infinite = Windows.INFINITE; { redeclare here for use elsewhere without using Windows.pas } // cls modified 1/23/2002
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DOTNET}
|
|
GOSType = otDotNet;
|
|
GPathDelim = '\'; {do not localize}
|
|
// Infinite = ?; { redeclare here for use elsewhere without using Windows.pas } // cls modified 1/23/2002
|
|
{$ENDIF}
|
|
|
|
// S.G. 4/9/2002: IP version general switch for defaults
|
|
{$IFDEF IdIPv6}
|
|
ID_DEFAULT_IP_VERSION = Id_IPv6;
|
|
{$ELSE}
|
|
ID_DEFAULT_IP_VERSION = Id_IPv4;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF HAS_sLineBreak}
|
|
{$IFDEF WINDOWS}
|
|
sLineBreak = CR + LF;
|
|
{$ELSE}
|
|
sLineBreak = LF;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
//The power constants are for processing IP addresses
|
|
//They are powers of 255.
|
|
const
|
|
POWER_1 = $000000FF;
|
|
POWER_2 = $0000FFFF;
|
|
POWER_3 = $00FFFFFF;
|
|
POWER_4 = $FFFFFFFF;
|
|
|
|
// utility functions to calculate the usable length of a given buffer.
|
|
// If ALength is <0 then the actual Buffer length is returned,
|
|
// otherwise the minimum of the two lengths is returned instead.
|
|
function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer; overload;
|
|
function IndyLength(const ABuffer: TIdBytes; const ALength: Integer = -1; const AIndex: Integer = 0): Integer; overload;
|
|
function IndyLength(const ABuffer: TStream; const ALength: TIdStreamSize = -1): TIdStreamSize; overload;
|
|
|
|
function IndyFormat(const AFormat: string; const Args: array of const): string;
|
|
function IndyIncludeTrailingPathDelimiter(const S: string): string;
|
|
function IndyExcludeTrailingPathDelimiter(const S: string): string;
|
|
|
|
procedure IndyRaiseLastError;
|
|
|
|
// This can only be called inside of an 'except' block! This is so that
|
|
// Exception.RaiseOuterException() (when available) can capture the current
|
|
// exception into the InnerException property of a new Exception that is
|
|
// being raised...
|
|
procedure IndyRaiseOuterException(AOuterException: Exception);
|
|
|
|
//You could possibly use the standard StrInt and StrIntDef but these
|
|
//also remove spaces from the string using the trim functions.
|
|
function IndyStrToInt(const S: string): Integer; overload;
|
|
function IndyStrToInt(const S: string; ADefault: Integer): Integer; overload;
|
|
|
|
function IndyFileAge(const AFileName: string): TDateTime;
|
|
function IndyDirectoryExists(const ADirectory: string): Boolean;
|
|
|
|
//You could possibly use the standard StrToInt and StrToInt64Def
|
|
//functions but these also remove spaces using the trim function
|
|
function IndyStrToInt64(const S: string; const ADefault: Int64): Int64; overload;
|
|
function IndyStrToInt64(const S: string): Int64; overload;
|
|
|
|
//This converts the string to an Integer or Int64 depending on the bit size TStream uses
|
|
function IndyStrToStreamSize(const S: string; const ADefault: TIdStreamSize): TIdStreamSize; overload;
|
|
function IndyStrToStreamSize(const S: string): TIdStreamSize; overload;
|
|
|
|
function AddMSecToTime(const ADateTime: TDateTime; const AMSec: Integer): TDateTime;
|
|
|
|
// To and From Bytes conversion routines
|
|
function ToBytes(const AValue: string; ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): TIdBytes; overload;
|
|
function ToBytes(const AValue: string; const ALength: Integer; const AIndex: Integer = 1;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): TIdBytes; overload;
|
|
function ToBytes(const AValue: Char; ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): TIdBytes; overload;
|
|
function ToBytes(const AValue: Int8): TIdBytes; overload;
|
|
function ToBytes(const AValue: UInt8): TIdBytes; overload;
|
|
function ToBytes(const AValue: Int16): TIdBytes; overload;
|
|
function ToBytes(const AValue: UInt16): TIdBytes; overload;
|
|
function ToBytes(const AValue: Int32): TIdBytes; overload;
|
|
function ToBytes(const AValue: UInt32): TIdBytes; overload;
|
|
function ToBytes(const AValue: Int64): TIdBytes; overload;
|
|
function ToBytes(const AValue: TIdUInt64): TIdBytes; overload;
|
|
function ToBytes(const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0): TIdBytes; overload;
|
|
{$IFNDEF DOTNET}
|
|
// RLebeau - not using the same "ToBytes" naming convention for RawToBytes()
|
|
// in order to prevent ambiquious errors with ToBytes(TIdBytes) above
|
|
function RawToBytes(const AValue; const ASize: Integer): TIdBytes;
|
|
{$ENDIF}
|
|
|
|
// The following functions are faster but except that Bytes[] must have enough
|
|
// space for at least SizeOf(AValue) bytes.
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Char; ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
); overload;
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int8); overload;
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt8); overload;
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int16); overload;
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt16); overload;
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int32); overload;
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt32); overload;
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int64); overload;
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdUInt64); overload;
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0); overload;
|
|
{$IFNDEF DOTNET}
|
|
// RLebeau - not using the same "ToBytesF" naming convention for RawToBytesF()
|
|
// in order to prevent ambiquious errors with ToBytesF(TIdBytes) above
|
|
procedure RawToBytesF(var Bytes: TIdBytes; const AValue; const ASize: Integer);
|
|
{$ENDIF}
|
|
|
|
function ToHex(const AValue: TIdBytes; const ACount: Integer = -1; const AIndex: Integer = 0): string; overload;
|
|
function ToHex(const AValue: array of UInt32): string; overload; // for IdHash
|
|
function BytesToString(const AValue: TIdBytes; AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): string; overload;
|
|
function BytesToString(const AValue: TIdBytes; const AStartIndex: Integer;
|
|
const ALength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): string; overload;
|
|
|
|
// BytesToStringRaw() differs from BytesToString() in that it stores the
|
|
// byte octets as-is, whereas BytesToString() may decode character encodings
|
|
function BytesToStringRaw(const AValue: TIdBytes): string; overload;
|
|
function BytesToStringRaw(const AValue: TIdBytes; const AStartIndex: Integer;
|
|
const ALength: Integer = -1): string; overload;
|
|
|
|
function BytesToChar(const AValue: TIdBytes; const AIndex: Integer = 0;
|
|
AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): Char; overload;
|
|
function BytesToChar(const AValue: TIdBytes; var VChar: Char; const AIndex: Integer = 0;
|
|
AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): Integer; overload;
|
|
function BytesToInt16(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
|
|
function BytesToUInt16(const AValue: TIdBytes; const AIndex : Integer = 0): UInt16;
|
|
function BytesToInt32(const AValue: TIdBytes; const AIndex: Integer = 0): Int32;
|
|
function BytesToUInt32(const AValue: TIdBytes; const AIndex : Integer = 0): UInt32;
|
|
function BytesToInt64(const AValue: TIdBytes; const AIndex: Integer = 0): Int64;
|
|
function BytesToUInt64(const AValue: TIdBytes; const AIndex: Integer = 0): TIdUInt64;
|
|
|
|
function BytesToShort(const AValue: TIdBytes; const AIndex: Integer = 0): Int16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToInt16()'{$ENDIF};{$ENDIF}
|
|
function BytesToWord(const AValue: TIdBytes; const AIndex : Integer = 0): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToUInt16()'{$ENDIF};{$ENDIF}
|
|
function BytesToLongInt(const AValue: TIdBytes; const AIndex: Integer = 0): Int32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToInt32()'{$ENDIF};{$ENDIF}
|
|
function BytesToLongWord(const AValue: TIdBytes; const AIndex : Integer = 0): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToUInt32()'{$ENDIF};{$ENDIF}
|
|
|
|
function BytesToIPv4Str(const AValue: TIdBytes; const AIndex: Integer = 0): String;
|
|
procedure BytesToIPv6(const AValue: TIdBytes; var VAddress: TIdIPv6Address; const AIndex: Integer = 0);
|
|
function BytesToTicks(const AValue: TIdBytes; const AIndex: Integer = 0): TIdTicks;
|
|
{$IFNDEF DOTNET}
|
|
procedure BytesToRaw(const AValue: TIdBytes; var VBuffer; const ASize: Integer);
|
|
{$ENDIF}
|
|
|
|
// TIdBytes utilities
|
|
procedure AppendBytes(var VBytes: TIdBytes; const AToAdd: TIdBytes; const AIndex: Integer = 0; const ALength: Integer = -1);
|
|
procedure AppendByte(var VBytes: TIdBytes; const AByte: Byte);
|
|
procedure AppendString(var VBytes: TIdBytes; const AStr: String; const ALength: Integer = -1;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
);
|
|
procedure ExpandBytes(var VBytes: TIdBytes; const AIndex: Integer; const ACount: Integer; const AFillByte: Byte = 0);
|
|
procedure InsertBytes(var VBytes: TIdBytes; const ADestIndex: Integer; const ASource: TIdBytes; const ASourceIndex: Integer = 0);
|
|
procedure InsertByte(var VBytes: TIdBytes; const AByte: Byte; const AIndex: Integer);
|
|
procedure RemoveBytes(var VBytes: TIdBytes; const ACount: Integer; const AIndex: Integer = 0);
|
|
|
|
// Common Streaming routines
|
|
function ReadLnFromStream(AStream: TStream; var VLine: String; AMaxLineLength: Integer = -1;
|
|
AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): Boolean; overload;
|
|
function ReadLnFromStream(AStream: TStream; AMaxLineLength: Integer = -1;
|
|
AExceptionIfEOF: Boolean = False; AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): string; overload;
|
|
function ReadStringFromStream(AStream: TStream; ASize: Integer = -1; AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): string; overload;
|
|
procedure WriteStringToStream(AStream: TStream; const AStr: string; ADestEncoding: IIdTextEncoding
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
); overload;
|
|
procedure WriteStringToStream(AStream: TStream; const AStr: string; const ALength: Integer = -1;
|
|
const AIndex: Integer = 1; ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
); overload;
|
|
function ReadCharFromStream(AStream: TStream; var VChar: Char; AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): Integer;
|
|
function ReadTIdBytesFromStream(const AStream: TStream; var ABytes: TIdBytes;
|
|
const Count: TIdStreamSize; const AIndex: Integer = 0): TIdStreamSize;
|
|
procedure WriteTIdBytesToStream(const AStream: TStream; const ABytes: TIdBytes;
|
|
const ASize: Integer = -1; const AIndex: Integer = 0);
|
|
|
|
function ByteToHex(const AByte: Byte): string;
|
|
function ByteToOctal(const AByte: Byte): string;
|
|
|
|
function UInt32ToHex(const ALongWord : UInt32) : String;
|
|
function LongWordToHex(const ALongWord : UInt32) : String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt32ToHex()'{$ENDIF};{$ENDIF}
|
|
|
|
procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
|
|
var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
|
|
|
|
procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
|
|
var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
|
|
|
|
procedure CopyTIdChar(const ASource: Char; var VDest: TIdBytes; const ADestIndex: Integer;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
);
|
|
procedure CopyTIdInt16(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
procedure CopyTIdUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
procedure CopyTIdInt32(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
procedure CopyTIdUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
procedure CopyTIdInt64(const ASource: Int64; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
procedure CopyTIdUInt64(const ASource: TIdUInt64; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
|
|
procedure CopyTIdShort(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdInt16()'{$ENDIF};{$ENDIF}
|
|
procedure CopyTIdWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdUInt16()'{$ENDIF};{$ENDIF}
|
|
procedure CopyTIdLongInt(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdInt32()'{$ENDIF};{$ENDIF}
|
|
procedure CopyTIdLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdUInt32()'{$ENDIF};{$ENDIF}
|
|
|
|
procedure CopyTIdIPV6Address(const ASource: TIdIPv6Address; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
procedure CopyTIdTicks(const ASource: TIdTicks; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
procedure CopyTIdString(const ASource: String; var VDest: TIdBytes; const ADestIndex: Integer;
|
|
const ALength: Integer = -1; ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
); overload;
|
|
procedure CopyTIdString(const ASource: String; const ASourceIndex: Integer;
|
|
var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer = -1;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
); overload;
|
|
|
|
// Need to change prob not to use this set
|
|
function CharPosInSet(const AString: string; const ACharPos: Integer; const ASet: String): Integer; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
|
|
function CharIsInSet(const AString: string; const ACharPos: Integer; const ASet: String): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
|
|
function CharIsInEOL(const AString: string; const ACharPos: Integer): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
|
|
function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
|
|
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
function CharPosInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Integer; overload;
|
|
function CharIsInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Boolean; overload;
|
|
function CharIsInEOL(const ASB: TIdStringBuilder; const ACharPos: Integer): Boolean; overload;
|
|
function CharEquals(const ASB: TIdStringBuilder; const ACharPos: Integer; const AValue: Char): Boolean; overload;
|
|
{$ENDIF}
|
|
|
|
function ByteIndex(const AByte: Byte; const ABytes: TIdBytes; const AStartIndex: Integer = 0): Integer;
|
|
function ByteIdxInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Integer;
|
|
function ByteIsInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Boolean;
|
|
function ByteIsInEOL(const ABytes: TIdBytes; const AIndex: Integer): Boolean;
|
|
|
|
function CompareDate(const D1, D2: TDateTime): Integer;
|
|
function CurrentProcessId: TIdPID;
|
|
|
|
// RLebeau: the input of these functions must be in GMT
|
|
function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
|
|
function DateTimeGMTToCookieStr(const GMTValue: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
|
|
function DateTimeGMTToImapStr(const GMTValue: TDateTime) : String;
|
|
|
|
// RLebeau: the input of these functions must be in local time
|
|
function DateTimeToInternetStr(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use LocalDateTimeToGMT()'{$ENDIF};{$ENDIF}
|
|
function DateTimeToGmtOffSetStr(ADateTime: TDateTime; const AUseGMTStr: Boolean = False): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UTCOffsetToStr()'{$ENDIF};{$ENDIF}
|
|
function LocalDateTimeToHttpStr(const Value: TDateTime) : String;
|
|
function LocalDateTimeToCookieStr(const Value: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
|
|
function LocalDateTimeToImapStr(const Value: TDateTime) : String;
|
|
function LocalDateTimeToGMT(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String;
|
|
|
|
procedure DebugOutput(const AText: string);
|
|
function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
|
|
const ADelete: Boolean = IdFetchDeleteDefault;
|
|
const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
|
|
function FetchCaseInsensitive(var AInput: string; const ADelim: string = IdFetchDelimDefault;
|
|
const ADelete: Boolean = IdFetchDeleteDefault): string;
|
|
|
|
// TODO: add an index parameter
|
|
procedure FillBytes(var VBytes : TIdBytes; const ACount : Integer; const AValue : Byte);
|
|
|
|
function CurrentThreadId: TIdThreadID;
|
|
function GetThreadHandle(AThread: TThread): TIdThreadHandle;
|
|
|
|
//GetTickDiff required because GetTickCount will wrap (IdICMP uses this)
|
|
function GetTickDiff(const AOldTickCount, ANewTickCount: UInt32): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use GetTickDiff64()'{$ENDIF};{$ENDIF}
|
|
function GetTickDiff64(const AOldTickCount, ANewTickCount: TIdTicks): TIdTicks;
|
|
|
|
// Most operations that use tick counters will never run anywhere near the
|
|
// 49.7 day limit that UInt32 imposes. If an operation really were to
|
|
// run that long, use GetElapsedTicks64()...
|
|
function GetElapsedTicks(const AOldTickCount: TIdTicks): UInt32;
|
|
function GetElapsedTicks64(const AOldTickCount: TIdTicks): TIdTicks;
|
|
|
|
procedure IdDelete(var s: string; AOffset, ACount: Integer);
|
|
procedure IdInsert(const Source: string; var S: string; Index: Integer);
|
|
|
|
{$IFNDEF DOTNET}
|
|
type
|
|
// TODO: use "array of Integer" instead?
|
|
{$IFDEF HAS_GENERICS_TList}
|
|
TIdPortList = TList<Integer>; // TODO: use TIdPort instead?
|
|
{$ELSE}
|
|
// TODO: flesh out to match TList<Integer> for non-Generics compilers
|
|
TIdPortList = TList;
|
|
{$ENDIF}
|
|
|
|
function IdPorts: TIdPortList;
|
|
{$ENDIF}
|
|
|
|
function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer; overload;
|
|
function iif(ATest: Boolean; const ATrue: string; const AFalse: string = ''): string; overload; { do not localize }
|
|
function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean; overload;
|
|
function iif(const AEncoding, ADefEncoding: IIdTextEncoding; ADefEncodingType: IdTextEncodingType = encASCII): IIdTextEncoding; overload;
|
|
|
|
function InMainThread: Boolean;
|
|
function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
|
|
|
|
//Note that there is NO need for Big Endian byte order functions because
|
|
//that's done through HostToNetwork byte order functions.
|
|
function HostToLittleEndian(const AValue : UInt16) : UInt16; overload;
|
|
function HostToLittleEndian(const AValue : UInt32): UInt32; overload;
|
|
function HostToLittleEndian(const AValue : Int32): Int32; overload;
|
|
|
|
function LittleEndianToHost(const AValue : UInt16) : UInt16; overload;
|
|
function LittleEndianToHost(const AValue : UInt32): UInt32; overload;
|
|
function LittleEndianToHost(const AValue : Int32): Int32; overload;
|
|
|
|
procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: TIdStreamSize);
|
|
{$IFNDEF DOTNET_EXCLUDE}
|
|
function IsCurrentThread(AThread: TThread): boolean;
|
|
{$ENDIF}
|
|
function IPv4ToUInt32(const AIPAddress: string): UInt32; overload;
|
|
function IPv4ToUInt32(const AIPAddress: string; var VErr: Boolean): UInt32; overload;
|
|
function IPv4ToDWord(const AIPAddress: string): UInt32; overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4ToUInt32()'{$ENDIF};{$ENDIF}
|
|
function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): UInt32; overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4ToUInt32()'{$ENDIF};{$ENDIF}
|
|
function IPv4ToHex(const AIPAddress: string; const ADotted: Boolean = False): string;
|
|
function IPv4ToOctal(const AIPAddress: string): string;
|
|
procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address); overload;
|
|
procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address; var VErr : Boolean); overload;
|
|
function IsAlpha(const AChar: Char): Boolean; overload;
|
|
function IsAlpha(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
|
|
function IsAlphaNumeric(const AChar: Char): Boolean; overload;
|
|
function IsAlphaNumeric(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
|
|
function IsASCII(const AByte: Byte): Boolean; overload;
|
|
function IsASCII(const ABytes: TIdBytes): Boolean; overload;
|
|
function IsASCIILDH(const AByte: Byte): Boolean; overload;
|
|
function IsASCIILDH(const ABytes: TIdBytes): Boolean; overload;
|
|
function IsHexidecimal(const AChar: Char): Boolean; overload;
|
|
function IsHexidecimal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
|
|
function IsNumeric(const AChar: Char): Boolean; overload;
|
|
function IsNumeric(const AString: string): Boolean; overload;
|
|
function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean; overload;
|
|
function IsOctal(const AChar: Char): Boolean; overload;
|
|
function IsOctal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
|
|
{$IFNDEF DOTNET}
|
|
function InterlockedExchangeTHandle(var VTarget: THandle; const AValue: THandle): THandle;
|
|
function InterlockedCompareExchangePtr(var VTarget: Pointer; const AValue, Compare: Pointer): Pointer;
|
|
function InterlockedCompareExchangeObj(var VTarget: TObject; const AValue, Compare: TObject): TObject;
|
|
function InterlockedCompareExchangeIntf(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface;
|
|
{$ENDIF}
|
|
function MakeCanonicalIPv4Address(const AAddr: string): string;
|
|
function MakeCanonicalIPv6Address(const AAddr: string): string;
|
|
function MakeUInt32IntoIPv4Address(const ADWord: UInt32): string;
|
|
function MakeDWordIntoIPv4Address(const ADWord: UInt32): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use MakeUInt32IntoIPv4Address()'{$ENDIF};{$ENDIF}
|
|
function IndyMin(const AValueOne, AValueTwo: Int64): Int64; overload;
|
|
function IndyMin(const AValueOne, AValueTwo: Int32): Int32; overload;
|
|
function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16; overload;
|
|
function IndyMax(const AValueOne, AValueTwo: Int64): Int64; overload;
|
|
function IndyMax(const AValueOne, AValueTwo: Int32): Int32; overload;
|
|
function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16; overload;
|
|
function IPv4MakeUInt32InRange(const AInt: Int64; const A256Power: Integer): UInt32;
|
|
function IPv4MakeLongWordInRange(const AInt: Int64; const A256Power: Integer): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4MakeUInt32InRange()'{$ENDIF};{$ENDIF}
|
|
{$IFNDEF DOTNET}
|
|
{$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
|
|
function IndyRegisterExpectedMemoryLeak(AAddress: Pointer): Boolean;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF UNIX}
|
|
function HackLoad(const ALibName : String; const ALibVersions : array of String) : HMODULE;
|
|
{$ENDIF}
|
|
{$IFNDEF DOTNET}
|
|
function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
|
|
{$ENDIF}
|
|
function OffsetFromUTC: TDateTime;
|
|
function UTCOffsetToStr(const AOffset: TDateTime; const AUseGMTStr: Boolean = False): string;
|
|
|
|
function PosIdx(const ASubStr, AStr: string; AStartPos: UInt32 = 0): UInt32; //For "ignoreCase" use AnsiUpperCase
|
|
function PosInSmallIntArray(const ASearchInt: Int16; const AArray: array of Int16): Integer;
|
|
function PosInStrArray(const SearchStr: string; const Contents: array of string; const CaseSensitive: Boolean = True): Integer;
|
|
{$IFNDEF DOTNET}
|
|
function ServicesFilePath: string;
|
|
{$ENDIF}
|
|
procedure IndySetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority; const APolicy: Integer = -MaxInt);
|
|
procedure SetThreadName(const AName: string; {$IFDEF DOTNET}AThread: System.Threading.Thread = nil{$ELSE}AThreadID: UInt32 = $FFFFFFFF{$ENDIF});
|
|
procedure IndySleep(ATime: UInt32);
|
|
|
|
// TODO: create TIdStringPositionList for non-Nextgen compilers...
|
|
{$IFDEF USE_OBJECT_ARC}
|
|
type
|
|
TIdStringPosition = record
|
|
Value: String;
|
|
Position: Integer;
|
|
constructor Create(const AValue: String; const APosition: Integer);
|
|
end;
|
|
TIdStringPositionList = TList<TIdStringPosition>;
|
|
{$ENDIF}
|
|
|
|
//For non-Nextgen compilers: Integer(TStrings.Objects[i]) = column position in AData
|
|
//For Nextgen compilers: use SplitDelimitedString() if column positions are needed
|
|
procedure SplitColumnsNoTrim(const AData: string; AStrings: TStrings; const ADelim: string = ' '); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use SplitDelimitedString()'{$ENDIF};{$ENDIF} {Do not Localize}
|
|
procedure SplitColumns(const AData: string; AStrings: TStrings; const ADelim: string = ' '); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use SplitDelimitedString()'{$ENDIF};{$ENDIF} {Do not Localize}
|
|
|
|
procedure SplitDelimitedString(const AData: string; AStrings: TStrings; ATrim: Boolean; const ADelim: string = ' '{$IFNDEF USE_OBJECT_ARC}; AIncludePositions: Boolean = False{$ENDIF}); {$IFDEF USE_OBJECT_ARC}overload;{$ENDIF} {Do not Localize}
|
|
{$IFDEF USE_OBJECT_ARC}
|
|
procedure SplitDelimitedString(const AData: string; AStrings: TIdStringPositionList; ATrim: Boolean; const ADelim: string = ' '); overload; {Do not Localize}
|
|
{$ENDIF}
|
|
|
|
function StartsWithACE(const ABytes: TIdBytes): Boolean;
|
|
function StringsReplace(const S: String; const OldPattern, NewPattern: array of string): string;
|
|
function ReplaceAll(const S, OldPattern, NewPattern: string): string;
|
|
function ReplaceOnlyFirst(const S, OldPattern, NewPattern: string): string;
|
|
function TextIsSame(const A1, A2: string): Boolean;
|
|
function TextStartsWith(const S, SubS: string): Boolean;
|
|
function TextEndsWith(const S, SubS: string): Boolean;
|
|
function IndyUpperCase(const A1: string): string;
|
|
function IndyLowerCase(const A1: string): string;
|
|
function IndyCompareStr(const A1: string; const A2: string): Integer;
|
|
function Ticks: UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Ticks64()'{$ENDIF};{$ENDIF}
|
|
function Ticks64: TIdTicks;
|
|
procedure ToDo(const AMsg: string);
|
|
|
|
function TwoByteToUInt16(AByte1, AByte2: Byte): UInt16;
|
|
function TwoByteToWord(AByte1, AByte2: Byte): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use TwoByteToUInt16()'{$ENDIF};{$ENDIF}
|
|
|
|
function IndyIndexOf(AStrings: TStrings; const AStr: string; const ACaseSensitive: Boolean = False): Integer;{$IFDEF HAS_TStringList_CaseSensitive} overload;{$ENDIF}
|
|
{$IFDEF HAS_TStringList_CaseSensitive}
|
|
function IndyIndexOf(AStrings: TStringList; const AStr: string; const ACaseSensitive: Boolean = False): Integer; overload;
|
|
{$ENDIF}
|
|
|
|
function IndyIndexOfName(AStrings: TStrings; const AStr: string; const ACaseSensitive: Boolean = False): Integer;{$IFDEF HAS_TStringList_CaseSensitive} overload;{$ENDIF}
|
|
{$IFDEF HAS_TStringList_CaseSensitive}
|
|
function IndyIndexOfName(AStrings: TStringList; const AStr: string; const ACaseSensitive: Boolean = False): Integer; overload;
|
|
{$ENDIF}
|
|
|
|
function IndyValueFromIndex(AStrings: TStrings; const AIndex: Integer): String;
|
|
|
|
{$IFDEF WINDOWS}
|
|
function IndyWindowsMajorVersion: Integer;
|
|
function IndyWindowsMinorVersion: Integer;
|
|
function IndyWindowsBuildNumber: Integer;
|
|
function IndyWindowsPlatform: Integer;
|
|
function IndyCheckWindowsVersion(const AMajor: Integer; const AMinor: Integer = 0): Boolean;
|
|
{$ENDIF}
|
|
|
|
//For non-Nextgen compilers: IdDisposeAndNil is the same as FreeAndNil()
|
|
//For Nextgen compilers: IdDisposeAndNil calls TObject.DisposeOf() to ensure
|
|
// the object is freed immediately even if it has active references to it,
|
|
// for instance when freeing an Owned component
|
|
procedure IdDisposeAndNil(var Obj); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
|
//RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
|
|
{$IFDEF UNIX}
|
|
{$IFDEF DARWIN}
|
|
{$IFDEF FPC}
|
|
type
|
|
TTimebaseInfoData = record
|
|
numer: UInt32;
|
|
denom: UInt32;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
var
|
|
{$IFDEF UNIX}
|
|
|
|
// For linux the user needs to set this variable to be accurate where used (mail, etc)
|
|
GOffsetFromUTC: TDateTime = 0;
|
|
|
|
{$IFDEF DARWIN}
|
|
GMachTimeBaseInfo: TTimebaseInfoData;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
IndyPos: TPosProc = nil;
|
|
|
|
{$IFDEF UNIX}
|
|
const
|
|
{$IFDEF HAS_SharedPrefix}
|
|
LIBEXT = '.' + SharedSuffix; {do not localize}
|
|
{$ELSE}
|
|
{$UNDEF LIBEXT_IS_DYLIB}
|
|
{$IFDEF DARWIN}
|
|
{$DEFINE LIBEXT_IS_DYLIB}
|
|
{$ELSE}
|
|
{$IFDEF IOS}
|
|
{$IFNDEF CPUARM}
|
|
// iOS Simulator
|
|
{$DEFINE LIBEXT_IS_DYLIB}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF LIBEXT_IS_DYLIB}
|
|
LIBEXT = '.dylib'; {do not localize}
|
|
{$ELSE}
|
|
LIBEXT = '.so'; {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
implementation
|
|
|
|
{$IFDEF UNIX}
|
|
{$IFDEF LINUX}
|
|
{$DEFINE USE_clock_gettime}
|
|
{$IFDEF FPC}
|
|
{$linklib rt}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF FREEBSD}
|
|
{$DEFINE USE_clock_gettime}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
{$IFDEF USE_VCL_POSIX}
|
|
Posix.SysSelect,
|
|
Posix.SysSocket,
|
|
Posix.Time,
|
|
Posix.SysTime,
|
|
{$ENDIF}
|
|
{$IFDEF USE_VCL_POSIX}
|
|
{$IFDEF DARWIN}
|
|
Macapi.CoreServices,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
|
|
{$IFDEF USE_FASTMM4}FastMM4,{$ENDIF}
|
|
{$IFDEF USE_MADEXCEPT}madExcept,{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF USE_LIBC}Libc,{$ENDIF}
|
|
{$IFDEF HAS_UNIT_DateUtils}DateUtils,{$ENDIF}
|
|
//do not bring in our IdIconv unit if we are using the libc unit directly.
|
|
{$IFDEF USE_ICONV_UNIT}IdIconv, {$ENDIF}
|
|
IdResourceStrings,
|
|
IdStream,
|
|
{$IFDEF DOTNET}
|
|
IdStreamNET
|
|
{$ELSE}
|
|
IdStreamVCL
|
|
{$ENDIF}
|
|
{$IFDEF HAS_PosEx}
|
|
{$IFDEF HAS_UNIT_StrUtils}
|
|
,StrUtils
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
;
|
|
|
|
{$IFDEF FPC}
|
|
{$IFDEF WINCE}
|
|
//FreePascal for WindowsCE may not define these.
|
|
const
|
|
CP_UTF7 = 65000;
|
|
CP_UTF8 = 65001;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
procedure EnsureEncoding(var VEncoding : IIdTextEncoding; ADefEncoding: IdTextEncodingType = encIndyDefault);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if VEncoding = nil then begin
|
|
VEncoding := IndyTextEncoding(ADefEncoding);
|
|
end;
|
|
end;
|
|
|
|
procedure CheckByteEncoding(var VBytes: TIdBytes; ASrcEncoding, ADestEncoding: IIdTextEncoding);
|
|
begin
|
|
if ASrcEncoding <> ADestEncoding then begin
|
|
VBytes := ADestEncoding.GetBytes(ASrcEncoding.GetChars(VBytes));
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF WINDOWS}
|
|
//FreePascal may not define this for non-Windows systems.
|
|
//#define MAKEWORD(a, b) ((WORD)(((BYTE)(a)) | ((WORD)((BYTE)(b))) << 8))
|
|
function MakeWord(const a, b : Byte) : Word;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := Word(a) or (Word(b) shl 8);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF DOTNET}
|
|
var
|
|
// TODO: use "array of Integer" instead?
|
|
GIdPorts: TIdPortList = nil;
|
|
|
|
GIdOSDefaultEncoding: IIdTextEncoding = nil;
|
|
GId8BitEncoding: IIdTextEncoding = nil;
|
|
GIdASCIIEncoding: IIdTextEncoding = nil;
|
|
GIdUTF16BigEndianEncoding: IIdTextEncoding = nil;
|
|
GIdUTF16LittleEndianEncoding: IIdTextEncoding = nil;
|
|
GIdUTF7Encoding: IIdTextEncoding = nil;
|
|
GIdUTF8Encoding: IIdTextEncoding = nil;
|
|
{$ENDIF}
|
|
|
|
{ IIdTextEncoding implementations }
|
|
|
|
{$IFDEF DOTNET}
|
|
type
|
|
TIdDotNetEncoding = class(TInterfacedObject, IIdTextEncoding)
|
|
protected
|
|
FEncoding: System.Text.Encoding;
|
|
public
|
|
constructor Create(AEncoding: System.Text.Encoding); overload;
|
|
constructor Create(const ACharset: String); overload;
|
|
constructor Create(const ACodepage: UInt16); overload;
|
|
function GetByteCount(const AChars: TIdWideChars): Integer; overload;
|
|
function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
|
|
function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
|
|
function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
|
|
function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
|
|
function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
|
|
function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
|
|
function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
|
|
function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
|
|
function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
|
|
function GetCharCount(const ABytes: TIdBytes): Integer; overload;
|
|
function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
|
|
function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
|
|
function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
|
|
function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
|
|
function GetIsSingleByte: Boolean;
|
|
function GetMaxByteCount(ACharCount: Integer): Integer;
|
|
function GetMaxCharCount(AByteCount: Integer): Integer;
|
|
function GetPreamble: TIdBytes;
|
|
function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
|
|
function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
|
|
end;
|
|
|
|
constructor TIdDotNetEncoding.Create(AEncoding: System.Text.Encoding);
|
|
begin
|
|
inherited Create;
|
|
FEncoding := AEncoding;
|
|
end;
|
|
|
|
constructor TIdDotNetEncoding.Create(const ACharset: String);
|
|
begin
|
|
inherited Create;
|
|
FEncoding := System.Text.Encoding.GetEncoding(ACharset);
|
|
end;
|
|
|
|
constructor TIdDotNetEncoding.Create(const ACodepage: UInt16);
|
|
begin
|
|
inherited Create;
|
|
FEncoding := System.Text.Encoding.GetEncoding(ACodepage);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetByteCount(const AChars: TIdWideChars): Integer;
|
|
begin
|
|
Result := FEncoding.GetByteCount(AChars);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetByteCount(AChars, ACharIndex, ACharCount);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetByteCount(const AStr: TIdUnicodeString): Integer;
|
|
begin
|
|
Result := FEncoding.GetByteCount(AStr);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetByteCount(AStr.Substring(ACharIndex-1, ACharCount));
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars): TIdBytes;
|
|
begin
|
|
Result := FEncoding.GetBytes(AChars);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes;
|
|
begin
|
|
Result := FEncoding.GetBytes(AChars, ACharIndex, ACharCount);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetBytes(AChars, ACharIndex, ACharCount, VBytes, AByteIndex);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString): TIdBytes;
|
|
begin
|
|
Result := FEncoding.GetBytes(AStr);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes;
|
|
begin
|
|
Result := FEncoding.GetByteCount(AStr.Substring(ACharIndex-1, ACharCount));
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetBytes(AStr, ACharIndex-1, ACharCount, VBytes, AByteIndex);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetCharCount(const ABytes: TIdBytes): Integer;
|
|
begin
|
|
Result := FEncoding.GetCharCount(ABytes);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetCharCount(ABytes, AByteIndex, AByteCount);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes): TIdWideChars;
|
|
begin
|
|
Result := FEncoding.GetChars(ABytes);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars;
|
|
begin
|
|
Result := FEncoding.GetChars(ABytes, AByteIndex, AByteCount);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetChars(ABytes, AByteIndex, AByteCount, VChars, ACharIndex);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetIsSingleByte: Boolean;
|
|
begin
|
|
Result := FEncoding.IsSingleByte;
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetMaxByteCount(ACharCount);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetMaxCharCount(AByteCount);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetPreamble: TIdBytes;
|
|
begin
|
|
Result := fEncoding.GetPreamble;
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetString(const ABytes: TIdBytes): TIdUnicodeString;
|
|
begin
|
|
Result := FEncoding.GetString(ABytes);
|
|
end;
|
|
|
|
function TIdDotNetEncoding.GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString;
|
|
begin
|
|
Result := FEncoding.GetString(ABytes, AByteIndex, AByteCount);
|
|
end;
|
|
|
|
{$ELSE}
|
|
|
|
type
|
|
TIdTextEncodingBase = class(TInterfacedObject, IIdTextEncoding)
|
|
protected
|
|
FIsSingleByte: Boolean;
|
|
FMaxCharSize: Integer;
|
|
public
|
|
function GetByteCount(const AChars: TIdWideChars): Integer; overload;
|
|
function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
|
|
function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; virtual; abstract;
|
|
function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
|
|
function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
|
|
function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
|
|
function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
|
|
function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes; overload;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; virtual; abstract;
|
|
function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
|
|
function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
|
|
function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
|
|
function GetCharCount(const ABytes: TIdBytes): Integer; overload;
|
|
function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
|
|
function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; virtual; abstract;
|
|
function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
|
|
function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
|
|
function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars; overload;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; virtual; abstract;
|
|
function GetIsSingleByte: Boolean;
|
|
function GetMaxByteCount(ACharCount: Integer): Integer; virtual; abstract;
|
|
function GetMaxCharCount(AByteCount: Integer): Integer; virtual; abstract;
|
|
function GetPreamble: TIdBytes; virtual;
|
|
function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
|
|
function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
|
|
function GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString; overload;
|
|
end;
|
|
|
|
{$UNDEF SUPPORTS_CODEPAGE_ENCODING}
|
|
{$IFNDEF USE_ICONV}
|
|
{$IFDEF WINDOWS}
|
|
{$DEFINE SUPPORTS_CODEPAGE_ENCODING}
|
|
{$ENDIF}
|
|
{$IFDEF HAS_LocaleCharsFromUnicode}
|
|
{$DEFINE SUPPORTS_CODEPAGE_ENCODING}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
TIdMBCSEncoding = class(TIdTextEncodingBase)
|
|
private
|
|
{$IFDEF USE_ICONV}
|
|
FCharSet: String;
|
|
{$ELSE}
|
|
{$IFDEF SUPPORTS_CODEPAGE_ENCODING}
|
|
FCodePage: UInt32;
|
|
FMBToWCharFlags: UInt32;
|
|
FWCharToMBFlags: UInt32;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
public
|
|
constructor Create; overload; virtual;
|
|
{$IFDEF USE_ICONV}
|
|
constructor Create(const CharSet: String); overload; virtual;
|
|
{$ELSE}
|
|
{$IFDEF SUPPORTS_CODEPAGE_ENCODING}
|
|
constructor Create(CodePage: Integer); overload; virtual;
|
|
constructor Create(CodePage, MBToWCharFlags, WCharToMBFlags: Integer); overload; virtual;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
|
|
function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; override;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
|
|
function GetMaxByteCount(CharCount: Integer): Integer; override;
|
|
function GetMaxCharCount(ByteCount: Integer): Integer; override;
|
|
function GetPreamble: TIdBytes; override;
|
|
end;
|
|
|
|
TIdUTF7Encoding = class(TIdMBCSEncoding)
|
|
public
|
|
constructor Create; override;
|
|
function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
|
|
function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; override;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
|
|
function GetMaxByteCount(CharCount: Integer): Integer; override;
|
|
function GetMaxCharCount(ByteCount: Integer): Integer; override;
|
|
end;
|
|
|
|
TIdUTF8Encoding = class(TIdUTF7Encoding)
|
|
public
|
|
constructor Create; override;
|
|
function GetMaxByteCount(CharCount: Integer): Integer; override;
|
|
function GetMaxCharCount(ByteCount: Integer): Integer; override;
|
|
function GetPreamble: TIdBytes; override;
|
|
end;
|
|
|
|
TIdUTF16LittleEndianEncoding = class(TIdTextEncodingBase)
|
|
public
|
|
constructor Create; virtual;
|
|
function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
|
|
function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; override;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
|
|
function GetMaxByteCount(CharCount: Integer): Integer; override;
|
|
function GetMaxCharCount(ByteCount: Integer): Integer; override;
|
|
function GetPreamble: TIdBytes; override;
|
|
end;
|
|
|
|
TIdUTF16BigEndianEncoding = class(TIdUTF16LittleEndianEncoding)
|
|
public
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
|
|
function GetPreamble: TIdBytes; override;
|
|
end;
|
|
|
|
TIdASCIIEncoding = class(TIdTextEncodingBase)
|
|
public
|
|
constructor Create; virtual;
|
|
function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
|
|
function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
|
|
function GetMaxByteCount(ACharCount: Integer): Integer; override;
|
|
function GetMaxCharCount(AByteCount: Integer): Integer; override;
|
|
end;
|
|
|
|
TId8BitEncoding = class(TIdTextEncodingBase)
|
|
public
|
|
constructor Create; virtual;
|
|
function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
|
|
function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
|
|
function GetMaxByteCount(ACharCount: Integer): Integer; override;
|
|
function GetMaxCharCount(AByteCount: Integer): Integer; override;
|
|
end;
|
|
|
|
{$IFDEF HAS_TEncoding}
|
|
TIdVCLEncoding = class(TIdTextEncodingBase)
|
|
protected
|
|
FEncoding: TEncoding;
|
|
FFreeEncoding: Boolean;
|
|
public
|
|
constructor Create(AEncoding: TEncoding; AFreeEncoding: Boolean); overload;
|
|
{$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
|
|
constructor Create(const ACharset: String); overload;
|
|
{$ENDIF}
|
|
constructor Create(const ACodepage: UInt16); overload;
|
|
destructor Destroy; override;
|
|
function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
|
|
function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
|
|
function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
|
|
function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
|
|
function GetMaxByteCount(ACharCount: Integer): Integer; override;
|
|
function GetMaxCharCount(AByteCount: Integer): Integer; override;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TIdTextEncodingBase }
|
|
|
|
function ValidateChars(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): PIdWideChar;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Len := Length(AChars);
|
|
if (ACharIndex < 0) or (ACharIndex >= Len) then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSCharIndexOutOfBounds), [ACharIndex]);
|
|
end;
|
|
if ACharCount < 0 then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
|
|
end;
|
|
if (Len - ACharIndex) < ACharCount then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
|
|
end;
|
|
if ACharCount > 0 then begin
|
|
Result := @AChars[ACharIndex];
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function ValidateBytes(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): PByte; overload;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Len := Length(ABytes);
|
|
if (AByteIndex < 0) or (AByteIndex >= Len) then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [AByteIndex]);
|
|
end;
|
|
if (Len - AByteIndex) < AByteCount then begin
|
|
raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
|
|
end;
|
|
if AByteCount > 0 then begin
|
|
Result := @ABytes[AByteIndex];
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function ValidateBytes(const ABytes: TIdBytes; AByteIndex, AByteCount, ANeeded: Integer): PByte; overload;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Len := Length(ABytes);
|
|
if (AByteIndex < 0) or (AByteIndex >= Len) then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [AByteIndex]);
|
|
end;
|
|
if (Len - AByteIndex) < ANeeded then begin
|
|
raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
|
|
end;
|
|
if AByteCount > 0 then begin
|
|
Result := @ABytes[AByteIndex];
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function ValidateStr(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): PIdWideChar;
|
|
begin
|
|
if ACharIndex < 1 then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSCharIndexOutOfBounds), [ACharIndex]);
|
|
end;
|
|
if ACharCount < 0 then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
|
|
end;
|
|
if (Length(AStr) - ACharIndex + 1) < ACharCount then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
|
|
end;
|
|
if ACharCount > 0 then begin
|
|
Result := @AStr[ACharIndex];
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetByteCount(const AChars: TIdWideChars): Integer;
|
|
begin
|
|
if AChars <> nil then begin
|
|
Result := GetByteCount(PIdWideChar(AChars), Length(AChars));
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetByteCount(const AChars: TIdWideChars;
|
|
ACharIndex, ACharCount: Integer): Integer;
|
|
var
|
|
LChars: PIdWideChar;
|
|
begin
|
|
LChars := ValidateChars(AChars, ACharIndex, ACharCount);
|
|
if LChars <> nil then begin
|
|
Result := GetByteCount(LChars, ACharCount);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetByteCount(const AStr: TIdUnicodeString): Integer;
|
|
begin
|
|
if AStr <> '' then begin
|
|
Result := GetByteCount(PIdWideChar(AStr), Length(AStr));
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer;
|
|
var
|
|
LChars: PIdWideChar;
|
|
begin
|
|
LChars := ValidateStr(AStr, ACharIndex, ACharCount);
|
|
if LChars <> nil then begin
|
|
Result := GetByteCount(LChars, ACharCount);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars): TIdBytes;
|
|
begin
|
|
if AChars <> nil then begin
|
|
Result := GetBytes(PIdWideChar(AChars), Length(AChars));
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars;
|
|
ACharIndex, ACharCount: Integer): TIdBytes;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Result := nil;
|
|
Len := GetByteCount(AChars, ACharIndex, ACharCount);
|
|
if Len > 0 then begin
|
|
SetLength(Result, Len);
|
|
GetBytes(@AChars[ACharIndex], ACharCount, PByte(Result), Len);
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars;
|
|
ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
|
|
begin
|
|
Result := GetBytes(
|
|
ValidateChars(AChars, ACharIndex, ACharCount),
|
|
ACharCount, VBytes, AByteIndex);
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Result := nil;
|
|
Len := GetByteCount(AChars, ACharCount);
|
|
if Len > 0 then begin
|
|
SetLength(Result, Len);
|
|
GetBytes(AChars, ACharCount, PByte(Result), Len);
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
|
|
var VBytes: TIdBytes; AByteIndex: Integer): Integer;
|
|
var
|
|
Len, LByteCount: Integer;
|
|
LBytes: PByte;
|
|
begin
|
|
if (AChars = nil) and (ACharCount <> 0) then begin
|
|
raise Exception.CreateRes(PResStringRec(@RSInvalidSourceArray));
|
|
end;
|
|
if (VBytes = nil) and (ACharCount <> 0) then begin
|
|
raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
|
|
end;
|
|
if ACharCount < 0 then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
|
|
end;
|
|
Len := Length(VBytes);
|
|
LByteCount := GetByteCount(AChars, ACharCount);
|
|
LBytes := ValidateBytes(VBytes, AByteIndex, Len, LByteCount);
|
|
Dec(Len, AByteIndex);
|
|
if (ACharCount > 0) and (Len > 0) then begin
|
|
Result := GetBytes(AChars, ACharCount, LBytes, LByteCount);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString): TIdBytes;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Result := nil;
|
|
Len := GetByteCount(AStr);
|
|
if Len > 0 then begin
|
|
SetLength(Result, Len);
|
|
GetBytes(PIdWideChar(AStr), Length(AStr), PByte(Result), Len);
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes;
|
|
var
|
|
Len: Integer;
|
|
LChars: PIdWideChar;
|
|
begin
|
|
Result := nil;
|
|
LChars := ValidateStr(AStr, ACharIndex, ACharCount);
|
|
if LChars <> nil then begin
|
|
Len := GetByteCount(LChars, ACharCount);
|
|
if Len > 0 then begin
|
|
SetLength(Result, Len);
|
|
GetBytes(LChars, ACharCount, PByte(Result), Len);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer;
|
|
var VBytes: TIdBytes; AByteIndex: Integer): Integer;
|
|
var
|
|
LChars: PIdWideChar;
|
|
begin
|
|
LChars := ValidateStr(AStr, ACharIndex, ACharCount);
|
|
if LChars <> nil then begin
|
|
Result := GetBytes(LChars, ACharCount, VBytes, AByteIndex);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetCharCount(const ABytes: TIdBytes): Integer;
|
|
begin
|
|
if ABytes <> nil then begin
|
|
Result := GetCharCount(PByte(ABytes), Length(ABytes));
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer;
|
|
var
|
|
LBytes: PByte;
|
|
begin
|
|
LBytes := ValidateBytes(ABytes, AByteIndex, AByteCount);
|
|
if LBytes <> nil then begin
|
|
Result := GetCharCount(LBytes, AByteCount);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes): TIdWideChars;
|
|
begin
|
|
if ABytes <> nil then begin
|
|
Result := GetChars(PByte(ABytes), Length(ABytes));
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Result := nil;
|
|
Len := GetCharCount(ABytes, AByteIndex, AByteCount);
|
|
if Len > 0 then begin
|
|
SetLength(Result, Len);
|
|
GetChars(@ABytes[AByteIndex], AByteCount, PIdWideChar(Result), Len);
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes;
|
|
AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer;
|
|
var
|
|
LBytes: PByte;
|
|
begin
|
|
LBytes := ValidateBytes(ABytes, AByteIndex, AByteCount);
|
|
if LBytes <> nil then begin
|
|
Result := GetChars(LBytes, AByteCount, VChars, ACharIndex);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Len := GetCharCount(ABytes, AByteCount);
|
|
if Len > 0 then begin
|
|
SetLength(Result, Len);
|
|
GetChars(ABytes, AByteCount, PIdWideChar(Result), Len);
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetChars(const ABytes: PByte; AByteCount: Integer;
|
|
var VChars: TIdWideChars; ACharIndex: Integer): Integer;
|
|
var
|
|
LCharCount: Integer;
|
|
begin
|
|
if (ABytes = nil) and (AByteCount <> 0) then begin
|
|
raise Exception.CreateRes(PResStringRec(@RSInvalidSourceArray));
|
|
end;
|
|
if AByteCount < 0 then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [AByteCount]);
|
|
end;
|
|
if (ACharIndex < 0) or (ACharIndex > Length(VChars)) then begin
|
|
raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [ACharIndex]);
|
|
end;
|
|
LCharCount := GetCharCount(ABytes, AByteCount);
|
|
if LCharCount > 0 then begin
|
|
if (ACharIndex + LCharCount) > Length(VChars) then begin
|
|
raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
|
|
end;
|
|
Result := GetChars(ABytes, AByteCount, @VChars[ACharIndex], LCharCount);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetIsSingleByte: Boolean;
|
|
begin
|
|
Result := FIsSingleByte;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetPreamble: TIdBytes;
|
|
begin
|
|
SetLength(Result, 0);
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetString(const ABytes: TIdBytes): TIdUnicodeString;
|
|
begin
|
|
if ABytes <> nil then begin
|
|
Result := GetString(PByte(ABytes), Length(ABytes));
|
|
end else begin
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetString(const ABytes: TIdBytes;
|
|
AByteIndex, AByteCount: Integer): TIdUnicodeString;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Result := '';
|
|
Len := GetCharCount(ABytes, AByteIndex, AByteCount);
|
|
if Len > 0 then begin
|
|
SetLength(Result, Len);
|
|
GetChars(@ABytes[AByteIndex], AByteCount, PIdWideChar(Result), Len);
|
|
end;
|
|
end;
|
|
|
|
function TIdTextEncodingBase.GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Result := '';
|
|
Len := GetCharCount(ABytes, AByteCount);
|
|
if Len > 0 then begin
|
|
SetLength(Result, Len);
|
|
GetChars(ABytes, AByteCount, PIdWideChar(Result), Len);
|
|
end;
|
|
end;
|
|
|
|
{ TIdMBCSEncoding }
|
|
|
|
constructor TIdMBCSEncoding.Create;
|
|
begin
|
|
{$IFDEF USE_ICONV}
|
|
Create(iif(GIdIconvUseLocaleDependantAnsiEncoding, 'char', 'ASCII')); {do not localize}
|
|
{$ELSE}
|
|
{$IFDEF SUPPORTS_CODEPAGE_ENCODING}
|
|
Create(CP_ACP, 0, 0);
|
|
{$ELSE}
|
|
ToDo('Constructor of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF USE_ICONV}
|
|
constructor TIdMBCSEncoding.Create(const CharSet: String);
|
|
const
|
|
// RLebeau: iconv() does not provide a maximum character byte size like
|
|
// Microsoft does, so have to determine the max bytes by manually encoding
|
|
// an actual Unicode codepoint. We'll encode the largest codepoint that
|
|
// UTF-16 supports, U+10FFFF, for now...
|
|
//
|
|
cValue: array[0..3] of Byte = ({$IFDEF ENDIAN_BIG}$DB, $FF, $DF, $FF{$ELSE}$FF, $DB, $FF, $DF{$ENDIF});
|
|
//cValue: array[0..1] of UInt16 = ($DBFF, $DFFF);
|
|
begin
|
|
inherited Create;
|
|
FCharSet := CharSet;
|
|
FMaxCharSize := GetByteCount(PIdWideChar(@cValue[0]), 2);
|
|
|
|
// Not all charsets support all codepoints. For example, ISO-8859-1 does
|
|
// not support U+10FFFF. If GetByteCount() fails above, FMaxCharSize gets
|
|
// set to 0, preventing any character conversions. So force FMaxCharSize
|
|
// to 1 if GetByteCount() fails, until a better solution can be found.
|
|
// Maybe loop through the codepoints until we find the largest one that is
|
|
// supported by this charset..
|
|
if FMaxCharSize = 0 then begin
|
|
FMaxCharSize := 1;
|
|
end;
|
|
|
|
FIsSingleByte := (FMaxCharSize = 1);
|
|
end;
|
|
{$ELSE}
|
|
{$IFDEF SUPPORTS_CODEPAGE_ENCODING}
|
|
constructor TIdMBCSEncoding.Create(CodePage: Integer);
|
|
begin
|
|
Create(CodePage, 0, 0);
|
|
end;
|
|
|
|
constructor TIdMBCSEncoding.Create(CodePage, MBToWCharFlags, WCharToMBFlags: Integer);
|
|
{$IFNDEF WINDOWS}
|
|
const
|
|
// RLebeau: have to determine the max bytes by manually encoding an actual
|
|
// Unicode codepoint. We'll encode the largest codepoint that UTF-16 supports,
|
|
// U+10FFFF, for now...
|
|
//
|
|
cValue: array[0..1] of UInt16 = ($DBFF, $DFFF);
|
|
{$ELSE}
|
|
var
|
|
LCPInfo: TCPInfo;
|
|
LError: Boolean;
|
|
{$ENDIF}
|
|
begin
|
|
inherited Create;
|
|
|
|
FCodePage := CodePage;
|
|
FMBToWCharFlags := MBToWCharFlags;
|
|
FWCharToMBFlags := WCharToMBFlags;
|
|
|
|
{$IFDEF WINDOWS}
|
|
LError := not GetCPInfo(FCodePage, LCPInfo);
|
|
if LError and (FCodePage = 20127) then begin
|
|
// RLebeau: 20127 is the official codepage for ASCII, but not
|
|
// all OS versions support that codepage, so fallback to 1252
|
|
// or even 437...
|
|
FCodePage := 1252;
|
|
LError := not GetCPInfo(FCodePage, LCPInfo);
|
|
// just in case...
|
|
if LError then begin
|
|
FCodePage := 437;
|
|
LError := not GetCPInfo(FCodePage, LCPInfo);
|
|
end;
|
|
end;
|
|
if LError then begin
|
|
raise EIdException.CreateResFmt(PResStringRec(@RSInvalidCodePage), [FCodePage]);
|
|
end;
|
|
FMaxCharSize := LCPInfo.MaxCharSize;
|
|
{$ELSE}
|
|
FMaxCharSize := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, @cValue[0], 2, nil, 0, nil, nil);
|
|
if FMaxCharSize < 1 then begin
|
|
raise EIdException.CreateResFmt(@RSInvalidCodePage, [FCodePage]);
|
|
end;
|
|
// Not all charsets support all codepoints. For example, ISO-8859-1 does
|
|
// not support U+10FFFF. If LocaleCharsFromUnicode() fails above,
|
|
// FMaxCharSize gets set to 0, preventing any character conversions. So
|
|
// force FMaxCharSize to 1 if GetByteCount() fails, until a better solution
|
|
// can be found. Maybe loop through the codepoints until we find the largest
|
|
// one that is supported by this codepage..
|
|
if FMaxCharSize = 0 then begin
|
|
FMaxCharSize := 1;
|
|
end;
|
|
{$ENDIF}
|
|
FIsSingleByte := (FMaxCharSize = 1);
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF USE_ICONV}
|
|
function CreateIconvHandle(const ACharSet: String; AToUTF16: Boolean): iconv_t;
|
|
const
|
|
// RLebeau: iconv() outputs a UTF-16 BOM if data is converted to the generic
|
|
// "UTF-16" charset. We do not want that, so we will use the "UTF-16LE/BE"
|
|
// charset explicitally instead so no BOM is outputted. This also saves us
|
|
// from having to manually detect the presense of a BOM and strip it out.
|
|
//
|
|
// TODO: should we be using UTF-16LE or UTF-16BE on big-endian systems?
|
|
// Delphi uses UTF-16LE, but what does FreePascal use? Let's err on the
|
|
// side of caution until we know otherwise...
|
|
//
|
|
cUTF16CharSet = {$IFDEF ENDIAN_BIG}'UTF-16BE'{$ELSE}'UTF-16LE'{$ENDIF}; {do not localize}
|
|
var
|
|
LToCharSet, LFromCharSet, LFlags: String;
|
|
{$IFDEF USE_MARSHALLED_PTRS}
|
|
M: TMarshaller;
|
|
{$ENDIF}
|
|
begin
|
|
// on some systems, //IGNORE must be specified before //TRANSLIT if they
|
|
// are used together, otherwise //IGNORE gets ignored!
|
|
LFlags := '';
|
|
if GIdIconvIgnoreIllegalChars then begin
|
|
LFlags := LFlags + '//IGNORE'; {do not localize}
|
|
end;
|
|
if GIdIconvUseTransliteration then begin
|
|
LFlags := LFlags + '//TRANSLIT'; {do not localize}
|
|
end;
|
|
|
|
if AToUTF16 then begin
|
|
LToCharSet := cUTF16CharSet + LFlags; // explicit convert to Ansi
|
|
LFromCharSet := ACharSet; // explicit convert to Ansi
|
|
end else begin
|
|
LToCharSet := ACharSet + LFlags; // explicit convert to Ansi
|
|
LFromCharSet := cUTF16CharSet;
|
|
end;
|
|
|
|
Result := iconv_open(
|
|
{$IFDEF USE_MARSHALLED_PTRS}
|
|
M.AsAnsi(LToCharSet).ToPointer,
|
|
M.AsAnsi(LFromCharSet).ToPointer
|
|
{$ELSE}
|
|
PAnsiChar(
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LToCharSet
|
|
{$ELSE}
|
|
AnsiString(LToCharSet) // explicit convert to Ansi
|
|
{$ENDIF}
|
|
),
|
|
PAnsiChar(
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LFromCharSet
|
|
{$ELSE}
|
|
AnsiString(LFromCharSet) // explicit convert to Ansi
|
|
{$ENDIF}
|
|
)
|
|
{$ENDIF}
|
|
);
|
|
if Result = iconv_t(-1) then begin
|
|
if LFlags <> '' then begin
|
|
raise EIdException.CreateResFmt(@RSInvalidCharSetConvWithFlags, [ACharSet, cUTF16CharSet, LFlags]);
|
|
end else begin
|
|
raise EIdException.CreateResFmt(@RSInvalidCharSetConv, [ACharSet, cUTF16CharSet]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CalcUTF16ByteSize(AChars: PWideChar; ACharCount: Integer): Integer;
|
|
var
|
|
C: WideChar;
|
|
LCount: Integer;
|
|
begin
|
|
C := AChars^;
|
|
if (C >= #$D800) and (C <= #$DFFF) then
|
|
begin
|
|
Result := 0;
|
|
if C > #$DBFF then begin
|
|
// invalid high surrogate
|
|
Exit;
|
|
end;
|
|
if ACharCount = 1 then begin
|
|
// missing low surrogate
|
|
Exit;
|
|
end;
|
|
Inc(AChars);
|
|
C := AChars^;
|
|
if (C < #$DC00) or (C > #$DFFF) then begin
|
|
// invalid low surrogate
|
|
Exit;
|
|
end;
|
|
LCount := 2;
|
|
end else begin
|
|
LCount := 1;
|
|
end;
|
|
Result := LCount * SizeOf(WideChar);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF USE_ICONV}
|
|
function DoIconvCharsToBytes(const ACharset: string; AChars: PIdWideChar; ACharCount: Integer;
|
|
ABytes: PByte; AByteCount: Integer; ABytesIsTemp: Boolean): Integer;
|
|
var
|
|
LSrcCharsPtr: PIdWideChar;
|
|
LCharsPtr, LBytesPtr: PAnsiChar;
|
|
LSrcCharSize, LCharSize, LByteSize: size_t;
|
|
LCharsRead, LBytesWritten: Integer;
|
|
LIconv: iconv_t;
|
|
begin
|
|
Result := 0;
|
|
|
|
if (AChars = nil) or (ACharCount = 0) then begin
|
|
Exit;
|
|
end;
|
|
|
|
LIconv := CreateIconvHandle(ACharSet, False);
|
|
try
|
|
// RLebeau: iconv() does not allow for querying a pre-calculated byte size
|
|
// for the input like Microsoft does, so have to determine the max bytes
|
|
// by actually encoding the Unicode data to a real buffer. When ABytesIsTemp
|
|
// is True, we are encoding to a small local buffer so we don't have to use
|
|
// a lot of memory. We also have to encode the input 1 Unicode codepoint at
|
|
// a time to avoid iconv() returning an E2BIG error if multiple UTF-16
|
|
// sequences were decoded to a length that would exceed the size of the
|
|
// local buffer.
|
|
|
|
//Kylix has an odd definition in iconv. In Kylix, __outbytesleft is defined as a var
|
|
//while in FreePascal's libc and our IdIconv units define it as a pSize_t
|
|
|
|
// reset to initial state
|
|
LByteSize := 0;
|
|
if iconv(LIconv, nil, nil, nil, {$IFNDEF KYLIX}@{$ENDIF}LByteSize) = size_t(-1) then begin
|
|
Exit;
|
|
end;
|
|
|
|
// do the conversion
|
|
LSrcCharsPtr := AChars;
|
|
repeat
|
|
if LSrcCharsPtr <> nil then begin
|
|
LSrcCharSize := CalcUTF16ByteSize(LSrcCharsPtr, ACharCount);
|
|
if LSrcCharSize = 0 then begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
end else begin
|
|
LSrcCharSize := 0;
|
|
end;
|
|
|
|
LCharsPtr := PAnsiChar(LSrcCharsPtr);
|
|
LCharSize := LSrcCharSize;
|
|
LBytesPtr := PAnsiChar(ABytes);
|
|
LByteSize := AByteCount;
|
|
if iconv(LIconv, @LCharsPtr, @LCharSize, @LBytesPtr, {$IFNDEF KYLIX}@{$ENDIF}LByteSize) = size_t(-1) then
|
|
begin
|
|
Exit;
|
|
end;
|
|
|
|
// LByteSize was decremented by the number of bytes stored in the output buffer
|
|
LBytesWritten := AByteCount - LByteSize;
|
|
Inc(Result, LBytesWritten);
|
|
if LSrcCharsPtr = nil then begin
|
|
Exit;
|
|
end;
|
|
|
|
if not ABytesIsTemp then begin
|
|
Inc(ABytes, LBytesWritten);
|
|
Dec(AByteCount, LBytesWritten);
|
|
end;
|
|
|
|
// LCharSize was decremented by the number of bytes read from the input buffer
|
|
LCharsRead := (LSrcCharSize-LCharSize) div SizeOf(WideChar);
|
|
Inc(LSrcCharsPtr, LCharsRead);
|
|
Dec(ACharCount, LCharsRead);
|
|
if ACharCount < 1 then
|
|
begin
|
|
// After all characters are handled, the output buffer has to be flushed
|
|
// This is done by running one more iteration, without an input buffer
|
|
LSrcCharsPtr := nil;
|
|
end;
|
|
until False;
|
|
finally
|
|
iconv_close(LIconv);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TIdMBCSEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
{$IFDEF USE_ICONV}
|
|
var
|
|
LBytes: array[0..3] of Byte;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF USE_ICONV}
|
|
Result := DoIconvCharsToBytes(FCharset, AChars, ACharCount, @LBytes[0], Length(LBytes), True);
|
|
{$ELSE}
|
|
{$IFDEF HAS_LocaleCharsFromUnicode}
|
|
Result := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, AChars, ACharCount, nil, 0, nil, nil);
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
Result := WideCharToMultiByte(FCodePage, FWCharToMBFlags, AChars, ACharCount, nil, 0, nil, nil);
|
|
{$ELSE}
|
|
Result := 0;
|
|
ToDo('GetByteCount() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdMBCSEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte;
|
|
AByteCount: Integer): Integer;
|
|
begin
|
|
{$IFDEF USE_ICONV}
|
|
Assert (ABytes <> nil, 'TIdMBCSEncoding.GetBytes Bytes can not be nil');
|
|
Result := DoIconvCharsToBytes(FCharset, AChars, ACharCount, ABytes, AByteCount, False);
|
|
{$ELSE}
|
|
{$IFDEF HAS_LocaleCharsFromUnicode}
|
|
Result := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, AChars, ACharCount, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, nil, nil);
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
Result := WideCharToMultiByte(FCodePage, FWCharToMBFlags, AChars, ACharCount, PAnsiChar(ABytes), AByteCount, nil, nil);
|
|
{$ELSE}
|
|
Result := 0;
|
|
ToDo('GetBytes() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF USE_ICONV}
|
|
function DoIconvBytesToChars(const ACharset: string; const ABytes: PByte; AByteCount: Integer;
|
|
AChars: PWideChar; ACharCount: Integer; AMaxCharSize: Integer; ACharsIsTemp: Boolean): Integer;
|
|
var
|
|
LSrcBytesPtr: PByte;
|
|
LBytesPtr, LCharsPtr: PAnsiChar;
|
|
LByteSize, LCharsSize: size_t;
|
|
I, LDestCharSize, LMaxBytesSize, LBytesRead, LCharsWritten: Integer;
|
|
LConverted: Boolean;
|
|
LIconv: iconv_t;
|
|
begin
|
|
Result := 0;
|
|
|
|
if (ABytes = nil) or (AByteCount = 0) then begin
|
|
Exit;
|
|
end;
|
|
|
|
LIconv := CreateIconvHandle(ACharset, True);
|
|
try
|
|
// RLebeau: iconv() does not allow for querying a pre-calculated character count
|
|
// for the input like Microsoft does, so have to determine the max characters
|
|
// by actually encoding the Ansi data to a real buffer. If ACharsIsTemp is True
|
|
// then we are encoding to a small local buffer so we don't have to use a lot of
|
|
// memory. We also have to encode the input 1 Unicode codepoint at a time to
|
|
// avoid iconv() returning an E2BIG error if multiple MBCS sequences were decoded
|
|
// to a length that would exceed the size of the local buffer.
|
|
|
|
//Kylix has an odd definition in iconv. In Kylix, __outbytesleft is defined as a var
|
|
//while in FreePascal's libc and our IdIconv units define it as a pSize_t
|
|
|
|
// reset to initial state
|
|
LCharsSize := 0;
|
|
if iconv(LIconv, nil, nil, nil, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) = size_t(-1) then
|
|
begin
|
|
Exit;
|
|
end;
|
|
|
|
// do the conversion
|
|
LSrcBytesPtr := ABytes;
|
|
repeat
|
|
LMaxBytesSize := IndyMin(AByteCount, AMaxCharSize);
|
|
LDestCharSize := ACharCount * SizeOf(WideChar);
|
|
|
|
if LSrcBytesPtr = nil then
|
|
begin
|
|
LBytesPtr := nil;
|
|
LByteSize := 0;
|
|
LCharsPtr := PAnsiChar(AChars);
|
|
LCharsSize := LDestCharSize;
|
|
if iconv(LIconv, @LBytesPtr, @LByteSize, @LCharsPtr, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) = size_t(-1) then
|
|
begin
|
|
Result := 0;
|
|
end else
|
|
begin
|
|
// LCharsSize was decremented by the number of bytes stored in the output buffer
|
|
Inc(Result, (LDestCharSize-LCharsSize) div SizeOf(WideChar));
|
|
end;
|
|
Exit;
|
|
end;
|
|
|
|
// TODO: figure out a better way to calculate the number of input bytes
|
|
// needed to generate a single UTF-16 output sequence...
|
|
LMaxBytesSize := IndyMin(AByteCount, AMaxCharSize);
|
|
LConverted := False;
|
|
for I := 1 to LMaxBytesSize do
|
|
begin
|
|
LBytesPtr := PAnsiChar(LSrcBytesPtr);
|
|
LByteSize := I;
|
|
LCharsPtr := PAnsiChar(AChars);
|
|
LCharsSize := LDestCharSize;
|
|
if iconv(LIconv, @LBytesPtr, @LByteSize, @LCharsPtr, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) <> size_t(-1) then
|
|
begin
|
|
LConverted := True;
|
|
|
|
// LCharsSize was decremented by the number of bytes stored in the output buffer
|
|
LCharsWritten := (LDestCharSize-LCharsSize) div SizeOf(WideChar);
|
|
Inc(Result, LCharsWritten);
|
|
if LSrcBytesPtr = nil then begin
|
|
Exit;
|
|
end;
|
|
|
|
if not ACharsIsTemp then begin
|
|
Inc(AChars, LCharsWritten);
|
|
Dec(ACharCount, LCharsWritten);
|
|
end;
|
|
|
|
// LByteSize was decremented by the number of bytes read from the input buffer
|
|
LBytesRead := I - LByteSize;
|
|
Inc(LSrcBytesPtr, LBytesRead);
|
|
Dec(AByteCount, LBytesRead);
|
|
if AByteCount < 1 then begin
|
|
// After all bytes are handled, the output buffer has to be flushed
|
|
// This is done by running one more iteration, without an input buffer
|
|
LSrcBytesPtr := nil;
|
|
end;
|
|
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
if not LConverted then begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
until False;
|
|
finally
|
|
iconv_close(LIconv);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TIdMBCSEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
|
|
{$IFDEF USE_ICONV}
|
|
var
|
|
LChars: array[0..3] of WideChar;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF USE_ICONV}
|
|
Result := DoIconvBytesToChars(FCharSet, ABytes, AByteCount, @LChars[0], Length(LChars), FMaxCharSize, True);
|
|
{$ELSE}
|
|
{$IFDEF HAS_UnicodeFromLocaleChars}
|
|
Result := UnicodeFromLocaleChars(FCodePage, FMBToWCharFlags, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, nil, 0);
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
Result := MultiByteToWideChar(FCodePage, FMBToWCharFlags, PAnsiChar(ABytes), AByteCount, nil, 0);
|
|
{$ELSE}
|
|
Result := 0;
|
|
ToDo('GetCharCount() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdMBCSEncoding.GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PWideChar;
|
|
ACharCount: Integer): Integer;
|
|
begin
|
|
{$IFDEF USE_ICONV}
|
|
Result := DoIconvBytesToChars(FCharSet, ABytes, AByteCount, AChars, ACharCount, FMaxCharSize, False);
|
|
{$ELSE}
|
|
{$IFDEF HAS_UnicodeFromLocaleChars}
|
|
Result := UnicodeFromLocaleChars(FCodePage, FMBToWCharFlags, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, AChars, ACharCount);
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
Result := MultiByteToWideChar(FCodePage, FMBToWCharFlags, PAnsiChar(ABytes), AByteCount, AChars, ACharCount);
|
|
{$ELSE}
|
|
Result := 0;
|
|
ToDo('GetChars() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdMBCSEncoding.GetMaxByteCount(CharCount: Integer): Integer;
|
|
begin
|
|
Result := (CharCount + 1) * FMaxCharSize;
|
|
end;
|
|
|
|
function TIdMBCSEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
|
|
begin
|
|
Result := ByteCount;
|
|
end;
|
|
|
|
function TIdMBCSEncoding.GetPreamble: TIdBytes;
|
|
begin
|
|
{$IFDEF USE_ICONV}
|
|
case PosInStrArray(FCharSet, ['utf-8', 'utf-16', 'utf-16le', 'utf-16be'], False) of {do not localize}
|
|
0: begin
|
|
SetLength(Result, 3);
|
|
Result[0] := $EF;
|
|
Result[1] := $BB;
|
|
Result[2] := $BF;
|
|
end;
|
|
1, 2: begin
|
|
SetLength(Result, 2);
|
|
Result[0] := $FF;
|
|
Result[1] := $FE;
|
|
end;
|
|
3: begin
|
|
SetLength(Result, 2);
|
|
Result[0] := $FE;
|
|
Result[1] := $FF;
|
|
end;
|
|
else
|
|
SetLength(Result, 0);
|
|
end;
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
case FCodePage of
|
|
CP_UTF8: begin
|
|
SetLength(Result, 3);
|
|
Result[0] := $EF;
|
|
Result[1] := $BB;
|
|
Result[2] := $BF;
|
|
end;
|
|
1200: begin
|
|
SetLength(Result, 2);
|
|
Result[0] := $FF;
|
|
Result[1] := $FE;
|
|
end;
|
|
1201: begin
|
|
SetLength(Result, 2);
|
|
Result[0] := $FE;
|
|
Result[1] := $FF;
|
|
end;
|
|
else
|
|
SetLength(Result, 0);
|
|
end;
|
|
{$ELSE}
|
|
SetLength(Result, 0);
|
|
ToDo('GetPreamble() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TIdUTF7Encoding }
|
|
|
|
constructor TIdUTF7Encoding.Create;
|
|
begin
|
|
{$IFDEF USE_ICONV}
|
|
inherited Create('UTF-7'); {do not localize}
|
|
{$ELSE}
|
|
{$IFDEF SUPPORTS_CODEPAGE_ENCODING}
|
|
inherited Create(CP_UTF7);
|
|
{$ELSE}
|
|
ToDo('Construtor of TIdUTF7Encoding class is not implemented for this platform yet'); {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdUTF7Encoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
begin
|
|
Result := inherited GetByteCount(AChars, ACharCount);
|
|
end;
|
|
|
|
function TIdUTF7Encoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
|
|
ABytes: PByte; AByteCount: Integer): Integer;
|
|
begin
|
|
Result := inherited GetBytes(AChars, ACharCount, ABytes, AByteCount);
|
|
end;
|
|
|
|
function TIdUTF7Encoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
|
|
begin
|
|
Result := inherited GetCharCount(ABytes, AByteCount);
|
|
end;
|
|
|
|
function TIdUTF7Encoding.GetChars(const ABytes: PByte; AByteCount: Integer;
|
|
AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
begin
|
|
Result := inherited GetChars(ABytes, AByteCount, AChars, ACharCount);
|
|
end;
|
|
|
|
function TIdUTF7Encoding.GetMaxByteCount(CharCount: Integer): Integer;
|
|
begin
|
|
Result := (CharCount * 3) + 2;
|
|
end;
|
|
|
|
function TIdUTF7Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
|
|
begin
|
|
Result := ByteCount;
|
|
end;
|
|
|
|
{ TIdUTF8Encoding }
|
|
|
|
// TODO: implement UTF-8 manually so we don't have to deal with codepage issues...
|
|
|
|
constructor TIdUTF8Encoding.Create;
|
|
begin
|
|
{$IFDEF USE_ICONV}
|
|
inherited Create('UTF-8'); {do not localize}
|
|
{$ELSE}
|
|
{$IFDEF SUPPORTS_CODEPAGE_ENCODING}
|
|
inherited Create(CP_UTF8, 0, 0);
|
|
{$ELSE}
|
|
ToDo('Constructor of TIdUTF8Encoding class is not implemented for this platform yet'); {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdUTF8Encoding.GetMaxByteCount(CharCount: Integer): Integer;
|
|
begin
|
|
Result := (CharCount + 1) * 3;
|
|
end;
|
|
|
|
function TIdUTF8Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
|
|
begin
|
|
Result := ByteCount + 1;
|
|
end;
|
|
|
|
function TIdUTF8Encoding.GetPreamble: TIdBytes;
|
|
begin
|
|
SetLength(Result, 3);
|
|
Result[0] := $EF;
|
|
Result[1] := $BB;
|
|
Result[2] := $BF;
|
|
end;
|
|
|
|
{ TIdUTF16LittleEndianEncoding }
|
|
|
|
constructor TIdUTF16LittleEndianEncoding.Create;
|
|
begin
|
|
inherited Create;
|
|
FIsSingleByte := False;
|
|
FMaxCharSize := 4;
|
|
end;
|
|
|
|
function TIdUTF16LittleEndianEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
begin
|
|
// TODO: verify UTF-16 sequences
|
|
Result := ACharCount * SizeOf(WideChar);
|
|
end;
|
|
|
|
function TIdUTF16LittleEndianEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
|
|
ABytes: PByte; AByteCount: Integer): Integer;
|
|
{$IFDEF ENDIAN_BIG}
|
|
var
|
|
I: Integer;
|
|
LChars: PIdWideChar;
|
|
{$ENDIF}
|
|
begin
|
|
// TODO: verify UTF-16 sequences
|
|
{$IFDEF ENDIAN_BIG}
|
|
LChars := AChars;
|
|
for I := ACharCount - 1 downto 0 do
|
|
begin
|
|
ABytes^ := Hi(UInt16(LChars^));
|
|
Inc(ABytes);
|
|
ABytes^ := Lo(UInt16(LChars^));
|
|
Inc(ABytes);
|
|
Inc(LChars);
|
|
end;
|
|
Result := ACharCount * SizeOf(WideChar);
|
|
{$ELSE}
|
|
Result := ACharCount * SizeOf(WideChar);
|
|
Move(AChars^, ABytes^, Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdUTF16LittleEndianEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
|
|
begin
|
|
// TODO: verify UTF-16 sequences
|
|
Result := AByteCount div SizeOf(WideChar);
|
|
end;
|
|
|
|
function TIdUTF16LittleEndianEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
|
|
AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
{$IFDEF ENDIAN_BIG}
|
|
var
|
|
LBytes1, LBytes2: PByte;
|
|
I: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
// TODO: verify UTF-16 sequences
|
|
{$IFDEF ENDIAN_BIG}
|
|
LBytes1 := ABytes;
|
|
LBytes2 := ABytes;
|
|
Inc(LBytes2);
|
|
for I := 0 to ACharCount - 1 do
|
|
begin
|
|
AChars^ := WideChar(MakeWord(LBytes2^, LBytes1^));
|
|
Inc(LBytes1, 2);
|
|
Inc(LBytes2, 2);
|
|
Inc(AChars);
|
|
end;
|
|
Result := ACharCount;
|
|
{$ELSE}
|
|
Result := AByteCount div SizeOf(WideChar);
|
|
Move(ABytes^, AChars^, Result * SizeOf(WideChar));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdUTF16LittleEndianEncoding.GetMaxByteCount(CharCount: Integer): Integer;
|
|
begin
|
|
Result := (CharCount + 1) * 2;
|
|
end;
|
|
|
|
function TIdUTF16LittleEndianEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
|
|
begin
|
|
Result := (ByteCount div SizeOf(WideChar)) + (ByteCount and 1) + 1;
|
|
end;
|
|
|
|
function TIdUTF16LittleEndianEncoding.GetPreamble: TIdBytes;
|
|
begin
|
|
SetLength(Result, 2);
|
|
Result[0] := $FF;
|
|
Result[1] := $FE;
|
|
end;
|
|
|
|
{ TIdUTF16BigEndianEncoding }
|
|
|
|
function TIdUTF16BigEndianEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
|
|
ABytes: PByte; AByteCount: Integer): Integer;
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
var
|
|
I: Integer;
|
|
P: PIdWideChar;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
P := AChars;
|
|
for I := ACharCount - 1 downto 0 do
|
|
begin
|
|
ABytes^ := Hi(UInt16(P^));
|
|
Inc(ABytes);
|
|
ABytes^ := Lo(UInt16(P^));
|
|
Inc(ABytes);
|
|
Inc(P);
|
|
end;
|
|
Result := ACharCount * SizeOf(WideChar);
|
|
{$ELSE}
|
|
Result := ACharCount * SizeOf(WideChar);
|
|
Move(AChars^, ABytes^, Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdUTF16BigEndianEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
|
|
AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
var
|
|
P1, P2: PByte;
|
|
I: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
P1 := ABytes;
|
|
P2 := P1;
|
|
Inc(P1);
|
|
for I := 0 to ACharCount - 1 do
|
|
begin
|
|
AChars^ := WideChar(MakeWord(P1^, P2^));
|
|
Inc(P2, 2);
|
|
Inc(P1, 2);
|
|
Inc(AChars);
|
|
end;
|
|
Result := ACharCount;
|
|
{$ELSE}
|
|
Result := AByteCount div SizeOf(WideChar);
|
|
Move(ABytes^, AChars^, Result * SizeOf(WideChar));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdUTF16BigEndianEncoding.GetPreamble: TIdBytes;
|
|
begin
|
|
SetLength(Result, 2);
|
|
Result[0] := $FE;
|
|
Result[1] := $FF;
|
|
end;
|
|
|
|
{ TIdASCIIEncoding }
|
|
|
|
function IsCharsetASCII(const ACharSet: string): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
// TODO: when the IdCharsets unit is moved to the System
|
|
// package, use CharsetToCodePage() here...
|
|
Result := PosInStrArray(ACharSet,
|
|
[
|
|
'US-ASCII', {do not localize}
|
|
'ANSI_X3.4-1968', {do not localize}
|
|
'iso-ir-6', {do not localize}
|
|
'ANSI_X3.4-1986', {do not localize}
|
|
'ISO_646.irv:1991', {do not localize}
|
|
'ASCII', {do not localize}
|
|
'ISO646-US', {do not localize}
|
|
'us', {do not localize}
|
|
'IBM367', {do not localize}
|
|
'cp367', {do not localize}
|
|
'csASCII' {do not localize}
|
|
], False) <> -1;
|
|
end;
|
|
|
|
constructor TIdASCIIEncoding.Create;
|
|
begin
|
|
inherited Create;
|
|
FIsSingleByte := True;
|
|
FMaxCharSize := 1;
|
|
end;
|
|
|
|
function TIdASCIIEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
begin
|
|
Result := ACharCount;
|
|
end;
|
|
|
|
function TIdASCIIEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
|
|
ABytes: PByte; AByteCount: Integer): Integer;
|
|
var
|
|
P: PIdWideChar;
|
|
i : Integer;
|
|
begin
|
|
P := AChars;
|
|
Result := IndyMin(ACharCount, AByteCount);
|
|
for i := 1 to Result do begin
|
|
// replace illegal characters > $7F
|
|
if UInt16(P^) > $007F then begin
|
|
ABytes^ := Byte(Ord('?'));
|
|
end else begin
|
|
ABytes^ := Byte(P^);
|
|
end;
|
|
//advance to next char
|
|
Inc(P);
|
|
Inc(ABytes);
|
|
end;
|
|
end;
|
|
|
|
function TIdASCIIEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
|
|
begin
|
|
Result := AByteCount;
|
|
end;
|
|
|
|
function TIdASCIIEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
|
|
AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
var
|
|
P: PByte;
|
|
i : Integer;
|
|
begin
|
|
P := ABytes;
|
|
Result := IndyMin(ACharCount, AByteCount);
|
|
for i := 1 to Result do begin
|
|
// This is an invalid byte in the ASCII encoding.
|
|
if P^ > $7F then begin
|
|
UInt16(AChars^) := $FFFD;
|
|
end else begin
|
|
UInt16(AChars^) := P^;
|
|
end;
|
|
//advance to next byte
|
|
Inc(AChars);
|
|
Inc(P);
|
|
end;
|
|
end;
|
|
|
|
function TIdASCIIEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
|
|
begin
|
|
Result := ACharCount;
|
|
end;
|
|
|
|
function TIdASCIIEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
|
|
begin
|
|
Result := AByteCount;
|
|
end;
|
|
|
|
{ TId8BitEncoding }
|
|
|
|
constructor TId8BitEncoding.Create;
|
|
begin
|
|
inherited Create;
|
|
FIsSingleByte := True;
|
|
FMaxCharSize := 1;
|
|
end;
|
|
|
|
function TId8BitEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
begin
|
|
Result := ACharCount;
|
|
end;
|
|
|
|
function TId8BitEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
|
|
ABytes: PByte; AByteCount: Integer): Integer;
|
|
var
|
|
P: PIdWideChar;
|
|
i : Integer;
|
|
begin
|
|
P := AChars;
|
|
Result := IndyMin(ACharCount, AByteCount);
|
|
for i := 1 to Result do begin
|
|
// replace illegal characters > $FF
|
|
if UInt16(P^) > $00FF then begin
|
|
ABytes^ := Byte(Ord('?'));
|
|
end else begin
|
|
ABytes^ := Byte(P^);
|
|
end;
|
|
//advance to next char
|
|
Inc(P);
|
|
Inc(ABytes);
|
|
end;
|
|
end;
|
|
|
|
function TId8BitEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
|
|
begin
|
|
Result := AByteCount;
|
|
end;
|
|
|
|
function TId8BitEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
|
|
AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
var
|
|
P: PByte;
|
|
i : Integer;
|
|
begin
|
|
P := ABytes;
|
|
Result := IndyMin(ACharCount, AByteCount);
|
|
for i := 1 to Result do begin
|
|
UInt16(AChars^) := P^;
|
|
//advance to next char
|
|
Inc(AChars);
|
|
Inc(P);
|
|
end;
|
|
end;
|
|
|
|
function TId8BitEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
|
|
begin
|
|
Result := ACharCount;
|
|
end;
|
|
|
|
function TId8BitEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
|
|
begin
|
|
Result := AByteCount;
|
|
end;
|
|
|
|
{ TIdVCLEncoding }
|
|
|
|
{$IFDEF HAS_TEncoding}
|
|
|
|
// RLebeau: this is a hack. The protected members of SysUtils.TEncoding are
|
|
// declared as 'STRICT protected', so a regular accessor will not work here.
|
|
// Only descendants can call them, so we have to expose our own methods that
|
|
// this unit can call, and have them call the inherited methods internally.
|
|
|
|
type
|
|
TEncodingAccess = class(TEncoding)
|
|
public
|
|
function IndyGetByteCount(Chars: PChar; CharCount: Integer): Integer;
|
|
function IndyGetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
|
|
function IndyGetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
|
|
function IndyGetChars(Bytes: PByte; ByteCount: Integer; Chars: PChar; CharCount: Integer): Integer;
|
|
end;
|
|
|
|
function TEncodingAccess.IndyGetByteCount(Chars: PChar; CharCount: Integer): Integer;
|
|
begin
|
|
Result := GetByteCount(Chars, CharCount);
|
|
end;
|
|
|
|
function TEncodingAccess.IndyGetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
|
|
begin
|
|
Result := GetBytes(Chars, CharCount, Bytes, ByteCount);
|
|
end;
|
|
|
|
function TEncodingAccess.IndyGetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
|
|
begin
|
|
Result := GetCharCount(Bytes, ByteCount);
|
|
end;
|
|
|
|
function TEncodingAccess.IndyGetChars(Bytes: PByte; ByteCount: Integer;
|
|
Chars: PChar; CharCount: Integer): Integer;
|
|
begin
|
|
Result := GetChars(Bytes, ByteCount, Chars, CharCount);
|
|
end;
|
|
|
|
constructor TIdVCLEncoding.Create(AEncoding: TEncoding; AFreeEncoding: Boolean);
|
|
begin
|
|
inherited Create;
|
|
FEncoding := AEncoding;
|
|
FFreeEncoding := AFreeEncoding and not TEncoding.IsStandardEncoding(AEncoding);
|
|
FIsSingleByte := FEncoding.IsSingleByte;
|
|
end;
|
|
|
|
{$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
|
|
constructor TIdVCLEncoding.Create(const ACharset: String);
|
|
begin
|
|
Create(TEncoding.GetEncoding(ACharset), True);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
constructor TIdVCLEncoding.Create(const ACodepage: UInt16);
|
|
begin
|
|
Create(TEncoding.GetEncoding(ACodepage), True);
|
|
end;
|
|
|
|
destructor TIdVCLEncoding.Destroy;
|
|
begin
|
|
if FFreeEncoding then begin
|
|
FEncoding.Free;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TIdVCLEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
begin
|
|
Result := TEncodingAccess(FEncoding).IndyGetByteCount(AChars, ACharCount);
|
|
end;
|
|
|
|
function TIdVCLEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
|
|
ABytes: PByte; AByteCount: Integer): Integer;
|
|
begin
|
|
Result := TEncodingAccess(FEncoding).IndyGetBytes(AChars, ACharCount, ABytes, AByteCount);
|
|
end;
|
|
|
|
function TIdVCLEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
|
|
begin
|
|
Result := TEncodingAccess(FEncoding).IndyGetCharCount(ABytes, AByteCount);
|
|
end;
|
|
|
|
function TIdVCLEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
|
|
AChars: PIdWideChar; ACharCount: Integer): Integer;
|
|
begin
|
|
Result := TEncodingAccess(FEncoding).IndyGetChars(ABytes, AByteCount, AChars, ACharCount);
|
|
end;
|
|
|
|
function TIdVCLEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetMaxByteCount(ACharCount);
|
|
end;
|
|
|
|
function TIdVCLEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
|
|
begin
|
|
Result := FEncoding.GetMaxCharCount(AByteCount);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$ENDIF}
|
|
|
|
function IndyTextEncoding(AType: IdTextEncodingType): IIdTextEncoding;
|
|
begin
|
|
case AType of
|
|
encIndyDefault: Result := IndyTextEncoding_Default;
|
|
// encOSDefault handled further below
|
|
enc8Bit: Result := IndyTextEncoding_8Bit;
|
|
encASCII: Result := IndyTextEncoding_ASCII;
|
|
encUTF16BE: Result := IndyTextEncoding_UTF16BE;
|
|
encUTF16LE: Result := IndyTextEncoding_UTF16LE;
|
|
encUTF7: Result := IndyTextEncoding_UTF7;
|
|
encUTF8: Result := IndyTextEncoding_UTF8;
|
|
else
|
|
// encOSDefault
|
|
Result := IndyTextEncoding_OSDefault;
|
|
end;
|
|
end;
|
|
|
|
function IndyTextEncoding(ACodepage: UInt16): IIdTextEncoding;
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := TIdDotNetEncoding.Create(ACodepage);
|
|
{$ELSE}
|
|
case ACodepage of
|
|
20127:
|
|
Result := IndyTextEncoding_ASCII;
|
|
1200:
|
|
Result := IndyTextEncoding_UTF16LE;
|
|
1201:
|
|
Result := IndyTextEncoding_UTF16BE;
|
|
65000:
|
|
Result := IndyTextEncoding_UTF7;
|
|
65001:
|
|
Result := IndyTextEncoding_UTF8;
|
|
else
|
|
{$IFDEF SUPPORTS_CODEPAGE_ENCODING}
|
|
Result := TIdMBCSEncoding.Create(ACodepage);
|
|
{$ELSE}
|
|
{$IFDEF HAS_TEncoding}
|
|
Result := TIdVCLEncoding.Create(ACodepage);
|
|
{$ELSE}
|
|
Result := nil;
|
|
raise EIdException.CreateResFmt(@RSUnsupportedCodePage, [ACodepage]);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyTextEncoding(const ACharSet: String): IIdTextEncoding;
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := TIdDotNetEncoding.Create(ACharSet);
|
|
{$ELSE}
|
|
// TODO: move IdCharsets unit into the System package so the
|
|
// IdGlobalProtocols.CharsetToEncoding() function can be moved
|
|
// into this unit...
|
|
if IsCharsetASCII(ACharSet) then begin
|
|
Result := IndyTextEncoding_ASCII;
|
|
end else begin
|
|
case PosInStrArray(ACharSet, ['utf-16be', 'utf-16le', 'utf-16', 'utf-7', 'utf-8'], False) of {do not localize}
|
|
0: Result := IndyTextEncoding_UTF16BE;
|
|
1, 2: Result := IndyTextEncoding_UTF16LE;
|
|
3: Result := IndyTextEncoding_UTF7;
|
|
4: Result := IndyTextEncoding_UTF8;
|
|
else
|
|
{$IFDEF USE_ICONV}
|
|
Result := TIdMBCSEncoding.Create(ACharSet);
|
|
{$ELSE}
|
|
{$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
|
|
Result := TIdVCLEncoding.Create(ACharSet);
|
|
{$ELSE}
|
|
// TODO: provide a hook that IdGlobalProtocols can assign to so we can call
|
|
// CharsetToCodePage() here, at least until CharsetToEncoding() can be moved
|
|
// to this unit once IdCharsets has been moved to the System package...
|
|
Result := nil;
|
|
raise EIdException.CreateResFmt(PResStringRec(@RSUnsupportedCharSet), [ACharSet]);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF DOTNET}
|
|
function IndyTextEncoding(AEncoding: System.Text.Encoding): IIdTextEncoding;
|
|
begin
|
|
Result := TIdDotNetEncoding.Create(AEncoding);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF HAS_TEncoding}
|
|
function IndyTextEncoding(AEncoding: TEncoding; AFreeEncoding: Boolean = False): IIdTextEncoding;
|
|
begin
|
|
Result := TIdVCLEncoding.Create(AEncoding, AFreeEncoding);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function IndyTextEncoding_Default: IIdTextEncoding;
|
|
var
|
|
LType: IdTextEncodingType;
|
|
begin
|
|
LType := GIdDefaultTextEncoding;
|
|
if LType = encIndyDefault then begin
|
|
LType := encASCII;
|
|
end;
|
|
Result := IndyTextEncoding(LType);
|
|
end;
|
|
|
|
function IndyTextEncoding_OSDefault: IIdTextEncoding;
|
|
{$IFNDEF DOTNET}
|
|
var
|
|
LEncoding: IIdTextEncoding;
|
|
{$ENDIF}
|
|
begin
|
|
if GIdOSDefaultEncoding = nil then begin
|
|
{$IFDEF DOTNET}
|
|
// TODO: use thread-safe assignment
|
|
GIdOSDefaultEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.Default);
|
|
{$ELSE}
|
|
// TODO: SysUtils.TEncoding.Default uses ANSI on Windows
|
|
// but uses UTF-8 on POSIX, so we should do the same...
|
|
//LEncoding := {$IFDEF WINDOWS}TIdMBCSEncoding{$ELSE}TIdUTF8Encoding{$ENDIF}.Create;
|
|
LEncoding := TIdMBCSEncoding.Create;
|
|
if InterlockedCompareExchangeIntf(IInterface(GIdOSDefaultEncoding), LEncoding, nil) <> nil then begin
|
|
LEncoding := nil;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
Result := GIdOSDefaultEncoding;
|
|
end;
|
|
|
|
function IndyTextEncoding_8Bit: IIdTextEncoding;
|
|
{$IFNDEF DOTNET}
|
|
var
|
|
LEncoding: IIdTextEncoding;
|
|
{$ENDIF}
|
|
begin
|
|
if GId8BitEncoding = nil then begin
|
|
{$IFDEF DOTNET}
|
|
// We need a charset that converts UTF-16 codeunits in the $00-$FF range
|
|
// to/from their numeric values as-is. Was previously using "Windows-1252"
|
|
// which does so for most codeunits, however codeunits $80-$9F in
|
|
// Windows-1252 map to different codepoints in Unicode, which we don't want.
|
|
// "ISO-8859-1" aka "ISO_8859-1:1987" (not to be confused with the older
|
|
// "ISO 8859-1" charset), on the other hand, treats codeunits $00-$FF as-is,
|
|
// and seems to be just as widely supported as Windows-1252 on most systems,
|
|
// so we'll use that for now...
|
|
|
|
// TODO: use thread-safe assignment
|
|
GId8BitEncoding := TIdDotNetEncoding.Create('ISO-8859-1');
|
|
{$ELSE}
|
|
LEncoding := TId8BitEncoding.Create;
|
|
if InterlockedCompareExchangeIntf(IInterface(GId8BitEncoding), LEncoding, nil) <> nil then begin
|
|
LEncoding := nil;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
Result := GId8BitEncoding;
|
|
end;
|
|
|
|
function IndyTextEncoding_ASCII: IIdTextEncoding;
|
|
{$IFNDEF DOTNET}
|
|
var
|
|
LEncoding: IIdTextEncoding;
|
|
{$ENDIF}
|
|
begin
|
|
if GIdASCIIEncoding = nil then begin
|
|
{$IFDEF DOTNET}
|
|
// TODO: use thread-safe assignment
|
|
GIdASCIIEncoding := TIdDotNetEncoding.Creeate(System.Text.Encoding.ASCII);
|
|
{$ELSE}
|
|
LEncoding := TIdASCIIEncoding.Create;
|
|
if InterlockedCompareExchangeIntf(IInterface(GIdASCIIEncoding), LEncoding, nil) <> nil then begin
|
|
LEncoding := nil;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
Result := GIdASCIIEncoding;
|
|
end;
|
|
|
|
function IndyTextEncoding_UTF16BE: IIdTextEncoding;
|
|
{$IFNDEF DOTNET}
|
|
var
|
|
LEncoding: IIdTextEncoding;
|
|
{$ENDIF}
|
|
begin
|
|
if GIdUTF16BigEndianEncoding = nil then begin
|
|
{$IFDEF DOTNET}
|
|
// TODO: use thread-safe assignment
|
|
GIdUTF16BigEndianEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.BigEndianUnicode);
|
|
{$ELSE}
|
|
LEncoding := TIdUTF16BigEndianEncoding.Create;
|
|
if InterlockedCompareExchangeIntf(IInterface(GIdUTF16BigEndianEncoding), LEncoding, nil) <> nil then begin
|
|
LEncoding := nil;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
Result := GIdUTF16BigEndianEncoding;
|
|
end;
|
|
|
|
function IndyTextEncoding_UTF16LE: IIdTextEncoding;
|
|
{$IFNDEF DOTNET}
|
|
var
|
|
LEncoding: IIdTextEncoding;
|
|
{$ENDIF}
|
|
begin
|
|
if GIdUTF16LittleEndianEncoding = nil then begin
|
|
{$IFDEF DOTNET}
|
|
// TODO: use thread-safe assignment
|
|
GIdUTF16LittleEndianEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.Unicode);
|
|
{$ELSE}
|
|
LEncoding := TIdUTF16LittleEndianEncoding.Create;
|
|
if InterlockedCompareExchangeIntf(IInterface(GIdUTF16LittleEndianEncoding), LEncoding, nil) <> nil then begin
|
|
LEncoding := nil;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
Result := GIdUTF16LittleEndianEncoding;
|
|
end;
|
|
|
|
function IndyTextEncoding_UTF7: IIdTextEncoding;
|
|
{$IFNDEF DOTNET}
|
|
var
|
|
LEncoding: IIdTextEncoding;
|
|
{$ENDIF}
|
|
begin
|
|
if GIdUTF7Encoding = nil then begin
|
|
{$IFDEF DOTNET}
|
|
// TODO: use thread-safe assignment
|
|
GIdUTF7Encoding := TIdDotNetEncoding.Create(System.Text.Encoding.UTF7);
|
|
{$ELSE}
|
|
LEncoding := TIdUTF7Encoding.Create;
|
|
if InterlockedCompareExchangeIntf(IInterface(GIdUTF7Encoding), LEncoding, nil) <> nil then begin
|
|
LEncoding := nil;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
Result := GIdUTF7Encoding;
|
|
end;
|
|
|
|
function IndyTextEncoding_UTF8: IIdTextEncoding;
|
|
{$IFNDEF DOTNET}
|
|
var
|
|
LEncoding: IIdTextEncoding;
|
|
{$ENDIF}
|
|
begin
|
|
if GIdUTF8Encoding = nil then begin
|
|
{$IFDEF DOTNET}
|
|
// TODO: use thread-safe assignment
|
|
GIdUTF8Encoding := TIdDotNetEncoding.Create(System.Text.Encoding.UTF8);
|
|
{$ELSE}
|
|
LEncoding := TIdUTF8Encoding.Create;
|
|
if InterlockedCompareExchangeIntf(IInterface(GIdUTF8Encoding), LEncoding, nil) <> nil then begin
|
|
LEncoding := nil;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
Result := GIdUTF8Encoding;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function enDefault: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function en7Bit: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := IndyTextEncoding_ASCII;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function en8Bit: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := IndyTextEncoding_8Bit;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function enUTF8: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := IndyTextEncoding_UTF8;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function Indy8BitEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
{$IFNDEF DOTNET}
|
|
if not AOwnedByIndy then begin
|
|
Result := TId8BitEncoding.Create;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
Result := IndyTextEncoding_8Bit;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function IndyASCIIEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
{$IFNDEF DOTNET}
|
|
if not AOwnedByIndy then begin
|
|
Result := TIdASCIIEncoding.Create;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
Result := IndyTextEncoding_ASCII;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function IndyUTF16BigEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
{$IFNDEF DOTNET}
|
|
if not AOwnedByIndy then begin
|
|
Result := TIdUTF16BigEndianEncoding.Create;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
Result := IndyTextEncoding_UTF16BE;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function IndyUTF16LittleEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
{$IFNDEF DOTNET}
|
|
if not AOwnedByIndy then begin
|
|
Result := TIdUTF16LittleEndianEncoding.Create;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
Result := IndyTextEncoding_UTF16LE;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function IndyOSDefaultEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
{$IFNDEF DOTNET}
|
|
if not AOwnedByIndy then begin
|
|
// TODO: SysUtils.TEncoding.Default uses ANSI on Windows
|
|
// but uses UTF-8 on POSIX, so we should do the same...
|
|
//Result := {$IFDEF WINDOWS}TIdMBCSEncoding{$ELSE}TIdUTF8Encoding{$ENDIF}.Create;
|
|
Result := TIdMBCSEncoding.Create;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
Result := IndyTextEncoding_OSDefault;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function IndyUTF7Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
{$IFNDEF DOTNET}
|
|
if not AOwnedByIndy then begin
|
|
Result := TIdUTF7Encoding.Create;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
Result := IndyTextEncoding_UTF7;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function IndyUTF8Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
{$IFNDEF DOTNET}
|
|
if not AOwnedByIndy then begin
|
|
Result := TIdUTF8Encoding.Create;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
Result := IndyTextEncoding_UTF8;
|
|
end;
|
|
|
|
{$IFDEF UNIX}
|
|
function HackLoadFileName(const ALibName, ALibVer : String) : string; {$IFDEF USE_INLINE} inline; {$ENDIF}
|
|
begin
|
|
{$IFDEF DARWIN}
|
|
Result := ALibName+ALibVer+LIBEXT;
|
|
{$ELSE}
|
|
{$IFDEF IOS}
|
|
Result := ALibName+ALibVer+LIBEXT;
|
|
{$ELSE}
|
|
Result := ALibName+LIBEXT+ALibVer;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function HackLoad(const ALibName : String; const ALibVersions : array of String) : HMODULE;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
Result := NilHandle;
|
|
for i := Low(ALibVersions) to High(ALibVersions) do
|
|
begin
|
|
{$IFDEF USE_SAFELOADLIBRARY}
|
|
Result := SafeLoadLibrary(HackLoadFileName(ALibName,ALibVersions[i]));
|
|
{$ELSE}
|
|
{$IFDEF KYLIXCOMPAT}
|
|
// Workaround that is required under Linux (changed RTLD_GLOBAL with RTLD_LAZY Note: also work with LoadLibrary())
|
|
Result := HMODULE(dlopen(PAnsiChar(HackLoadFileName(ALibName,ALibVersions[i])), RTLD_LAZY));
|
|
{$ELSE}
|
|
Result := LoadLibrary(HackLoadFileName(ALibName,ALibVersions[i]));
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF USE_INVALIDATE_MOD_CACHE}
|
|
InvalidateModuleCache;
|
|
{$ENDIF}
|
|
if Result <> NilHandle then begin
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure IndyRaiseLastError;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFNDEF HAS_RaiseLastOSError}
|
|
RaiseLastWin32Error;
|
|
{$ELSE}
|
|
RaiseLastOSError;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF HAS_Exception_RaiseOuterException}
|
|
procedure IndyRaiseOuterException(AOuterException: Exception);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Exception.RaiseOuterException(AOuterException);
|
|
end;
|
|
{$ELSE}
|
|
{$IFDEF DCC}
|
|
// RLebeau: There is no Exception.InnerException property to capture the inner
|
|
// exception into, but we can still raise the outer exception using Delphi's
|
|
// 'raise ... at [address]' syntax, at least. This way, the debugger (and
|
|
// exception loggers) can show the outer exception occuring in the caller
|
|
// rather than inside this function...
|
|
{$IFDEF HAS_System_ReturnAddress}
|
|
procedure IndyRaiseOuterException(AOuterException: Exception);
|
|
begin
|
|
raise AOuterException at ReturnAddress;
|
|
end;
|
|
{$ELSE}
|
|
// RLebeau: Delphi RTL functions like SysUtils.Abort(), Classes.TList.Error(),
|
|
// and Classes.TStrings.Error() raise their respective exceptions at the
|
|
// caller's return address using Delphi's 'raise ... at [address]' syntax,
|
|
// however they do so in different ways depending on Delphi version!
|
|
//
|
|
// ----------------
|
|
// SysUtils.Abort()
|
|
// ----------------
|
|
// Delphi 5-2007: Abort() calls an internal helper function that returns the
|
|
// caller's return address from the call stack - [EBP-4] in Delphi 5, [EBP+4]
|
|
// in Delphi 6+ - and then passes that value to 'raise'. Not sure why [EBP-4]
|
|
// was being used in Delphi 5. Maybe a typo?
|
|
//
|
|
// Delphi 2009-XE: Abort() JMP's into an internal helper procedure that takes
|
|
// a Pointer parameter as input (passed in EAX) and passes it to 'raise'.
|
|
// Delphi 2009-2010 POP's the caller's return address from the call stack
|
|
// into EAX. Delphi XE simply MOV's [ESP] into EAX instead.
|
|
// ----------------
|
|
// TList.Error()
|
|
// TStrings.Error()
|
|
// ----------------
|
|
// Delphi 5-2010: Error() calls an internal helper function that returns the
|
|
// caller's return address from the call stack - always [EBP+4] - and then passes
|
|
// that value to 'raise'.
|
|
//
|
|
// Delphi XE: no helper is used. Error() is wrapped with {$O-} to force a stack
|
|
// frame, and then reads the caller's return address directly from the call stack
|
|
// (using pointer math to find it) and passes it to 'raise'.
|
|
// ----------------
|
|
//
|
|
// To be safe, we will use the MOV [ESP] approach here, as it is the simplest.
|
|
// We only have to worry about this in Delphi's Windows 32bit compiler, as the
|
|
// 64bit and mobile compilers have System.ReturnAddress available...
|
|
|
|
// disable stack frames to reduce instructions
|
|
{$IFOPT W+} // detect stack frames
|
|
{$DEFINE _WPlusWasEnabled}
|
|
{$W-} // turn off stack frames
|
|
{$ENDIF}
|
|
procedure IndyRaiseOuterException(AOuterException: Exception);
|
|
procedure RaiseE(E: Exception; ReturnAddr: Pointer);
|
|
begin
|
|
raise E at ReturnAddr;
|
|
end;
|
|
asm
|
|
// AOuterException is already in EAX...
|
|
// MOV EAX, AOuterException
|
|
MOV EDX, [ESP]
|
|
JMP RaiseE
|
|
end;
|
|
{$IFDEF _WPlusWasEnabled}
|
|
{$UNDEF _WPlusWasEnabled}
|
|
{$W+}
|
|
{$ENDIF}
|
|
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
// Not Delphi, so just raise the exception as-is until we know what else to do with it...
|
|
procedure IndyRaiseOuterException(AOuterException: Exception);
|
|
begin
|
|
raise AOuterException;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF DOTNET}
|
|
function InterlockedExchangeTHandle(var VTarget: THandle; const AValue: THandle): THandle;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF HAS_TInterlocked}
|
|
{$IFDEF THANDLE_32}
|
|
Result := THandle(TInterlocked.Exchange(Integer(VTarget), Integer(AValue)));
|
|
{$ENDIF}
|
|
//Temporary workaround. TInterlocked for Emb really should accept 64 bit unsigned values as set of parameters
|
|
//for TInterlocked.Exchange since 64-bit wide integers are common on 64 bit platforms.
|
|
{$IFDEF THANDLE_64}
|
|
Result := THandle(TInterlocked.Exchange(Int64(VTarget), Int64(AValue)));
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF THANDLE_32}
|
|
Result := THandle(InterlockedExchange(Integer(VTarget), Integer(AValue)));
|
|
{$ENDIF}
|
|
{$IFDEF THANDLE_64}
|
|
Result := THandle(InterlockedExchange64(Int64(VTarget), Int64(AValue)));
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$UNDEF DYNAMICLOAD_InterlockedCompareExchange}
|
|
{$IFNDEF HAS_TInterlocked}
|
|
{$IFNDEF FPC}
|
|
// RLebeau: InterlockedCompareExchange() is not available prior to Win2K,
|
|
// so need to fallback to some other logic on older systems. Not too many
|
|
// people still support those systems anymore, so we will make this optional.
|
|
//
|
|
// InterlockedCompareExchange64(), on the other hand, is not available until
|
|
// Windows Vista (and not defined in any version of Windows.pas up to Delphi
|
|
// XE), so always dynamically load it in order to support WinXP 64-bit...
|
|
|
|
{$IFDEF CPU64}
|
|
{$DEFINE DYNAMICLOAD_InterlockedCompareExchange}
|
|
{$ELSE}
|
|
{.$DEFINE STATICLOAD_InterlockedCompareExchange}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
|
|
// See http://code.google.com/p/delphi-toolbox/source/browse/trunk/RTLEx/RTLEx.BasicOp.Atomic.pas
|
|
// for how to perform interlocked operations in assembler...
|
|
|
|
type
|
|
TInterlockedCompareExchangeFunc = function(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
|
|
|
|
var
|
|
InterlockedCompareExchange: TInterlockedCompareExchangeFunc = nil;
|
|
|
|
function Impl_InterlockedCompareExchange(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF CPU64}
|
|
// TODO: use LOCK CMPXCHG8B directly so this is more atomic...
|
|
{$ELSE}
|
|
// TODO: use LOCK CMPXCHG directly so this is more atomic...
|
|
{$ENDIF}
|
|
Result := Destination;
|
|
if Destination = Comparand then begin
|
|
Destination := Exchange;
|
|
end;
|
|
end;
|
|
|
|
function Stub_InterlockedCompareExchange(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
|
|
|
|
function GetImpl: Pointer;
|
|
const
|
|
cKernel32 = 'KERNEL32'; {do not localize}
|
|
// TODO: what is Embarcadero's 64-bit define going to be?
|
|
cInterlockedCompareExchange = {$IFDEF CPU64}'InterlockedCompareExchange64'{$ELSE}'InterlockedCompareExchange'{$ENDIF}; {do not localize}
|
|
begin
|
|
Result := GetProcAddress(GetModuleHandle(cKernel32), cInterlockedCompareExchange);
|
|
if Result = nil then begin
|
|
Result := @Impl_InterlockedCompareExchange;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
@InterlockedCompareExchange := GetImpl();
|
|
Result := InterlockedCompareExchange(Destination, Exchange, Comparand);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function InterlockedCompareExchangePtr(var VTarget: Pointer; const AValue, Compare: Pointer): Pointer;
|
|
{$IFNDEF DYNAMICLOAD_InterlockedCompareExchange}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
|
|
Result := Pointer(IdGlobal.InterlockedCompareExchange(PtrInt(VTarget), PtrInt(AValue), PtrInt(Compare)));
|
|
{$ELSE}
|
|
{$IFDEF HAS_TInterlocked}
|
|
Result := TInterlocked.CompareExchange(VTarget, AValue, Compare);
|
|
{$ELSE}
|
|
{$IFDEF HAS_InterlockedCompareExchangePointer}
|
|
Result := InterlockedCompareExchangePointer(VTarget, AValue, Compare);
|
|
{$ELSE}
|
|
{$IFDEF HAS_InterlockedCompareExchange_Pointers}
|
|
//work around a conflicting definition for InterlockedCompareExchange
|
|
Result := {$IFDEF FPC}system.{$ENDIF}InterlockedCompareExchange(VTarget, AValue, Compare);
|
|
{$ELSE}
|
|
{$IFDEF FPC}
|
|
Result := Pointer(
|
|
{$IFDEF CPU64}InterlockedCompareExchange64{$ELSE}InterlockedCompareExchange{$ENDIF}
|
|
(PtrInt(VTarget), PtrInt(AValue), PtrInt(Compare))
|
|
);
|
|
{$ELSE}
|
|
// Delphi 64-bit is handled by HAS_InterlockedCompareExchangePointer
|
|
Result := Pointer(InterlockedCompareExchange(Integer(VTarget), Integer(AValue), Integer(Compare)));
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function InterlockedCompareExchangeObj(var VTarget: TObject; const AValue, Compare: TObject): TObject;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF USE_OBJECT_ARC}
|
|
// for ARC, we have to use the TObject overload of TInterlocked to ensure
|
|
// that the reference counts of the objects are managed correctly...
|
|
Result := TInterlocked.CompareExchange(VTarget, AValue, Compare);
|
|
{$ELSE}
|
|
Result := TObject(InterlockedCompareExchangePtr(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function InterlockedCompareExchangeIntf(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
// we have to ensure that the reference counts of the interfaces are managed correctly...
|
|
if AValue <> nil then begin
|
|
AValue._AddRef;
|
|
end;
|
|
Result := IInterface(InterlockedCompareExchangePtr(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
|
|
if (AValue <> nil) and (Pointer(Result) <> Pointer(Compare)) then begin
|
|
AValue._Release;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{Little Endian Byte order functions from:
|
|
|
|
From: http://community.borland.com/article/0,1410,16854,00.html
|
|
|
|
|
|
Big-endian and little-endian formated integers - by Borland Developer Support Staff
|
|
|
|
Note that I will NOT do big Endian functions because the stacks can handle that
|
|
with HostToNetwork and NetworkToHost functions.
|
|
|
|
You should use these functions for writing data that sent and received in Little
|
|
Endian Form. Do NOT assume endianness of what's written. It can work in unpredictable
|
|
ways on other architectures.
|
|
}
|
|
function HostToLittleEndian(const AValue : UInt16) : UInt16;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
//I think that is Little Endian but I'm not completely sure
|
|
Result := AValue;
|
|
{$ELSE}
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
Result := AValue;
|
|
{$ENDIF}
|
|
{$IFDEF ENDIAN_BIG}
|
|
Result := swap(AValue);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function HostToLittleEndian(const AValue : UInt32) : UInt32;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
//I think that is Little Endian but I'm not completely sure
|
|
Result := AValue;
|
|
{$ELSE}
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
Result := AValue;
|
|
{$ENDIF}
|
|
{$IFDEF ENDIAN_BIG}
|
|
Result := swap(AValue shr 16) or (UInt32(swap(AValue and $FFFF)) shl 16);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function HostToLittleEndian(const AValue : Integer) : Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
//I think that is Little Endian but I'm not completely sure
|
|
Result := AValue;
|
|
{$ELSE}
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
Result := AValue;
|
|
{$ENDIF}
|
|
{$IFDEF ENDIAN_BIG}
|
|
Result := swap(AValue);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function LittleEndianToHost(const AValue : UInt16) : UInt16;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
//I think that is Little Endian but I'm not completely sure
|
|
Result := AValue;
|
|
{$ELSE}
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
Result := AValue;
|
|
{$ENDIF}
|
|
{$IFDEF ENDIAN_BIG}
|
|
Result := swap(AValue);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function LittleEndianToHost(const AValue : UInt32): UInt32;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
//I think that is Little Endian but I'm not completely sure
|
|
Result := AValue;
|
|
{$ELSE}
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
Result := AValue;
|
|
{$ENDIF}
|
|
{$IFDEF ENDIAN_BIG}
|
|
Result := swap(AValue shr 16) or (UInt32(swap(AValue and $FFFF)) shl 16);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function LittleEndianToHost(const AValue : Integer): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
//I think that is Little Endian but I'm not completely sure
|
|
Result := AValue;
|
|
{$ELSE}
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
Result := AValue;
|
|
{$ENDIF}
|
|
{$IFDEF ENDIAN_BIG}
|
|
Result := Swap(AValue);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
// TODO: add an AIndex parameter
|
|
procedure FillBytes(var VBytes : TIdBytes; const ACount : Integer; const AValue : Byte);
|
|
{$IFDEF STRING_IS_ANSI}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ELSE}
|
|
var
|
|
I: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
// RLebeau: FillChar() is bad to use on Delphi/C++Builder 2009+ for filling
|
|
// byte buffers as it is actually designed for filling character buffers
|
|
// instead. Now that Char maps to WideChar, this causes problems for FillChar().
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
//System.&Array.Clear(VBytes, 0, ACount);
|
|
// TODO: optimize this
|
|
for I := 0 to ACount-1 do begin
|
|
VBytes[I] := AValue;
|
|
end;
|
|
{$ELSE}
|
|
FillChar(VBytes[0], ACount, AValue);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
// RLebeau 10/22/2013: prior to Delphi 2010, fmCreate was an all-encompassing
|
|
// bitmask, no other flags could be combined with it. The RTL was updated in
|
|
// Delphi 2010 to allow other flags to be specified along with fmCreate. So
|
|
// at best, we will now be able to allow read-only access to other processes
|
|
// in Delphi 2010 and later, and at worst we will continue having exclusive
|
|
// right to the file in Delphi 2009 and earlier, just like we always did...
|
|
|
|
constructor TIdFileCreateStream.Create(const AFile : String);
|
|
begin
|
|
inherited Create(AFile, fmCreate or fmOpenReadWrite or fmShareDenyWrite);
|
|
end;
|
|
|
|
constructor TIdAppendFileStream.Create(const AFile : String);
|
|
var
|
|
LFlags: Word;
|
|
begin
|
|
LFlags := fmOpenReadWrite or fmShareDenyWrite;
|
|
if not FileExists(AFile) then begin
|
|
LFlags := LFLags or fmCreate;
|
|
end;
|
|
inherited Create(AFile, LFlags);
|
|
if (LFlags and fmCreate) = 0 then begin
|
|
TIdStreamHelper.Seek(Self, 0, soEnd);
|
|
end;
|
|
end;
|
|
|
|
constructor TIdReadFileNonExclusiveStream.Create(const AFile : String);
|
|
begin
|
|
inherited Create(AFile, fmOpenRead or fmShareDenyNone);
|
|
end;
|
|
|
|
constructor TIdReadFileExclusiveStream.Create(const AFile : String);
|
|
begin
|
|
inherited Create(AFile, fmOpenRead or fmShareDenyWrite);
|
|
end;
|
|
|
|
function IsASCIILDH(const AByte: Byte): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := True;
|
|
//Verify the absence of non-LDH ASCII code points; that is, the
|
|
//absence of 0..2C, 2E..2F, 3A..40, 5B..60, and 7B..7F.
|
|
//Permissable chars are in this set
|
|
//['-','0'..'9','A'..'Z','a'..'z']
|
|
if AByte <= $2C then begin
|
|
Result := False;
|
|
end
|
|
else if (AByte >= $2E) and (AByte <= $2F) then begin
|
|
Result := False;
|
|
end
|
|
else if (AByte >= $3A) and (AByte <= $40) then begin
|
|
Result := False;
|
|
end
|
|
else if (AByte >= $5B) and (AByte <= $60) then begin
|
|
Result := False;
|
|
end
|
|
else if (AByte >= $7B) and (AByte <= $7F) then begin
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function IsASCIILDH(const ABytes: TIdBytes): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Length(ABytes)-1 do begin
|
|
if not IsASCIILDH(ABytes[i]) then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function IsASCII(const AByte: Byte): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := AByte <= $7F;
|
|
end;
|
|
|
|
function IsASCII(const ABytes: TIdBytes): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Length(ABytes) -1 do begin
|
|
if not IsASCII(ABytes[i]) then begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function StartsWithACE(const ABytes: TIdBytes): Boolean;
|
|
const
|
|
cDash = Ord('-');
|
|
var
|
|
LS: {$IFDEF STRING_IS_IMMUTABLE}TIdStringBuilder{$ELSE}string{$ENDIF};
|
|
begin
|
|
Result := False;
|
|
if Length(ABytes) >= 4 then
|
|
begin
|
|
if (ABytes[2] = cDash) and (ABytes[3] = cDash) then
|
|
begin
|
|
// TODO: just do byte comparisons so String conversions are not needed...
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LS := TIdStringBuilder.Create(2);
|
|
LS.Append(Char(ABytes[0]));
|
|
LS.Append(Char(ABytes[1]));
|
|
{$ELSE}
|
|
SetLength(LS, 2);
|
|
LS[1] := Char(ABytes[0]);
|
|
LS[2] := Char(ABytes[1]);
|
|
{$ENDIF}
|
|
Result := PosInStrArray(LS{$IFDEF STRING_IS_IMMUTABLE}.ToString{$ENDIF},
|
|
['bl','bq','dq','lq','mq','ra','wq','zq'], False) > -1;{do not localize}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function PosInSmallIntArray(const ASearchInt: Int16; const AArray: array of Int16): Integer;
|
|
begin
|
|
for Result := Low(AArray) to High(AArray) do begin
|
|
if ASearchInt = AArray[Result] then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
{This searches an array of string for an occurance of SearchStr}
|
|
function PosInStrArray(const SearchStr: string; const Contents: array of string; const CaseSensitive: Boolean = True): Integer;
|
|
begin
|
|
for Result := Low(Contents) to High(Contents) do begin
|
|
if CaseSensitive then begin
|
|
if SearchStr = Contents[Result] then begin
|
|
Exit;
|
|
end;
|
|
end else begin
|
|
if TextIsSame(SearchStr, Contents[Result]) then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
//IPv4 address conversion
|
|
function ByteToHex(const AByte: Byte): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
var
|
|
LSB: TIdStringBuilder;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LSB := TIdStringBuilder.Create(2);
|
|
LSB.Append(IdHexDigits[(AByte and $F0) shr 4]);
|
|
LSB.Append(IdHexDigits[AByte and $F]);
|
|
Result := LSB.ToString;
|
|
{$ELSE}
|
|
SetLength(Result, 2);
|
|
Result[1] := IdHexDigits[(AByte and $F0) shr 4];
|
|
Result[2] := IdHexDigits[AByte and $F];
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function UInt32ToHex(const ALongWord : UInt32) : String;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := ByteToHex((ALongWord and $FF000000) shr 24)
|
|
+ ByteToHex((ALongWord and $00FF0000) shr 16)
|
|
+ ByteToHex((ALongWord and $0000FF00) shr 8)
|
|
+ ByteToHex(ALongWord and $000000FF);
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function LongWordToHex(const ALongWord : UInt32) : String;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := UInt32ToHex(ALongWord);
|
|
end;
|
|
|
|
function ToHex(const AValue: TIdBytes; const ACount: Integer = -1;
|
|
const AIndex: Integer = 0): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
I, LCount: Integer;
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LSB: TIdStringBuilder;
|
|
{$ENDIF}
|
|
begin
|
|
LCount := IndyLength(AValue, ACount, AIndex);
|
|
if LCount > 0 then begin
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LSB := TIdStringBuilder.Create(LCount*2);
|
|
{$ELSE}
|
|
SetLength(Result, LCount*2);
|
|
{$ENDIF}
|
|
for I := 0 to LCount-1 do begin
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LSB.Append(IdHexDigits[(AValue[AIndex+I] and $F0) shr 4]);
|
|
LSB.Append(IdHexDigits[AValue[AIndex+I] and $F]);
|
|
{$ELSE}
|
|
Result[I*2+1] := IdHexDigits[(AValue[AIndex+I] and $F0) shr 4];
|
|
Result[I*2+2] := IdHexDigits[AValue[AIndex+I] and $F];
|
|
{$ENDIF}
|
|
end;
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
Result := LSB.ToString;
|
|
{$ENDIF}
|
|
end else begin
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
function ToHex(const AValue: array of UInt32): string;
|
|
var
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LSB: TIdStringBuilder;
|
|
{$ENDIF}
|
|
P: {$IFDEF DOTNET}TIdBytes{$ELSE}PByteArray{$ENDIF};
|
|
i, j: Integer;
|
|
begin
|
|
Result := '';
|
|
if Length(AValue) > 0 then
|
|
begin
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LSB := TIdStringBuilder.Create(Length(AValue)*SizeOf(UInt32)*2);
|
|
{$ELSE}
|
|
SetLength(Result, Length(AValue)*SizeOf(UInt32)*2);
|
|
{$ENDIF}
|
|
for i := 0 to High(AValue) do begin
|
|
{$IFDEF DOTNET}
|
|
P := ToBytes(AValue[i]);
|
|
{$ELSE}
|
|
P := PByteArray(@AValue[i]);
|
|
{$ENDIF}
|
|
for j := 0 to SizeOf(UInt32)-1 do begin
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LSB.Append(IdHexDigits[(P[j] and $F0) shr 4]);
|
|
LSB.Append(IdHexDigits[P[j] and $F]);
|
|
{$ELSE}
|
|
Result[(i*SizeOf(UInt32))+(j*2)+1] := IdHexDigits[(P^[j] and $F0) shr 4];
|
|
Result[(i*SizeOf(UInt32))+(j*2)+2] := IdHexDigits[P^[j] and $F];
|
|
{$ENDIF}
|
|
end;
|
|
end;//for
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
Result := LSB.ToString;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function IPv4ToHex(const AIPAddress: string; const ADotted: Boolean): string;
|
|
var
|
|
i: Integer;
|
|
LBuf, LTmp: string;
|
|
begin
|
|
LBuf := Trim(AIPAddress);
|
|
Result := IdHexPrefix;
|
|
for i := 0 to 3 do begin
|
|
LTmp := ByteToHex(IndyStrToInt(Fetch(LBuf, '.', True)));
|
|
if ADotted then begin
|
|
Result := Result + '.' + IdHexPrefix + LTmp;
|
|
end else begin
|
|
Result := Result + LTmp;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
function OctalToInt64(const AValue: string): Int64;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 1 to Length(AValue) do begin
|
|
Result := (Result shl 3) + IndyStrToInt(AValue[i], 0);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function ByteToOctal(const AByte: Byte): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
var
|
|
LSB: TIdStringBuilder;
|
|
C: Char;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
C := IdOctalDigits[(AByte shr 6) and $7];
|
|
if C <> '0' then begin
|
|
LSB := TIdStringBuilder.Create(4);
|
|
LSB.Append(Char('0')); {do not localize}
|
|
end else begin
|
|
LSB := TIdStringBuilder.Create(3);
|
|
end;
|
|
LSB.Append(C);
|
|
LSB.Append(IdOctalDigits[(AByte shr 3) and $7]);
|
|
LSB.Append(IdOctalDigits[AByte and $7]);
|
|
Result := LSB.ToString;
|
|
{$ELSE}
|
|
SetLength(Result, 3);
|
|
Result[1] := IdOctalDigits[(AByte shr 6) and $7];
|
|
Result[2] := IdOctalDigits[(AByte shr 3) and $7];
|
|
Result[3] := IdOctalDigits[AByte and $7];
|
|
if Result[1] <> '0' then begin {do not localize}
|
|
Result := '0' + Result; {do not localize}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IPv4ToOctal(const AIPAddress: string): string;
|
|
var
|
|
i: Integer;
|
|
LBuf: string;
|
|
begin
|
|
LBuf := Trim(AIPAddress);
|
|
Result := ByteToOctal(IndyStrToInt(Fetch(LBuf, '.', True), 0));
|
|
for i := 0 to 2 do begin
|
|
Result := Result + '.' + ByteToOctal(IndyStrToInt(Fetch(LBuf, '.', True), 0));
|
|
end;
|
|
end;
|
|
|
|
procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
|
|
var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
|
|
{$ELSE}
|
|
//if these asserts fail, then it indicates an attempted buffer overrun.
|
|
Assert(ASourceIndex >= 0);
|
|
Assert((ASourceIndex+ALength) <= Length(ASource));
|
|
Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure CopyTIdChar(const ASource: Char; var VDest: TIdBytes; const ADestIndex: Integer;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
);
|
|
var
|
|
LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
|
|
begin
|
|
EnsureEncoding(ADestEncoding);
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
{$IFNDEF DOTNET}
|
|
SetLength(LChars, 1);
|
|
{$ENDIF}
|
|
LChars[0] := ASource;
|
|
ADestEncoding.GetBytes(LChars, 0, 1, VDest, ADestIndex);
|
|
{$ELSE}
|
|
EnsureEncoding(ASrcEncoding, encOSDefault);
|
|
LChars := ASrcEncoding.GetChars(RawToBytes(ASource, 1));
|
|
ADestEncoding.GetBytes(LChars, 0, Length(LChars), VDest, ADestIndex);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure CopyTIdInt16(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$IFDEF DOTNET}
|
|
var
|
|
LShort : TIdBytes;
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
LShort := System.BitConverter.GetBytes(ASource);
|
|
System.array.Copy(LShort, 0, VDest, ADestIndex, SizeOf(Int16));
|
|
{$ELSE}
|
|
PInt16(@VDest[ADestIndex])^ := ASource;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
procedure CopyTIdShort(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
CopyTIdInt16(ASource, VDest, ADestIndex);
|
|
end;
|
|
|
|
procedure CopyTIdUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$IFDEF DOTNET}
|
|
var
|
|
LWord : TIdBytes;
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
LWord := System.BitConverter.GetBytes(ASource);
|
|
System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt16));
|
|
{$ELSE}
|
|
PUInt16(@VDest[ADestIndex])^ := ASource;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
procedure CopyTIdWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
CopyTIdUInt16(ASource, VDest, ADestIndex);
|
|
end;
|
|
|
|
procedure CopyTIdUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$IFDEF DOTNET}
|
|
var
|
|
LWord : TIdBytes;
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
LWord := System.BitConverter.GetBytes(ASource);
|
|
System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt32));
|
|
{$ELSE}
|
|
PUInt32(@VDest[ADestIndex])^ := ASource;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
procedure CopyTIdLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
CopyTIdUInt32(ASource, VDest, ADestIndex);
|
|
end;
|
|
|
|
procedure CopyTIdInt32(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$IFDEF DOTNET}
|
|
var
|
|
LInt : TIdBytes;
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
LInt := System.BitConverter.GetBytes(ASource);
|
|
System.array.Copy(LInt, 0, VDest, ADestIndex, SizeOf(Int32));
|
|
{$ELSE}
|
|
PInt32(@VDest[ADestIndex])^ := ASource;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
procedure CopyTIdLongInt(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
CopyTIdInt32(ASource, VDest, ADestIndex);
|
|
end;
|
|
|
|
procedure CopyTIdInt64(const ASource: Int64; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$IFDEF DOTNET}
|
|
var
|
|
LWord : TIdBytes;
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
LWord := System.BitConverter.GetBytes(ASource);
|
|
System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(Int64));
|
|
{$ELSE}
|
|
PInt64(@VDest[ADestIndex])^ := ASource;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure CopyTIdUInt64(const ASource: TIdUInt64;
|
|
var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$IFDEF DOTNET}
|
|
var
|
|
LWord : TIdBytes;
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
LWord := System.BitConverter.GetBytes(ASource);
|
|
System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt64));
|
|
{$ELSE}
|
|
PUInt64(@VDest[ADestIndex])^ := ASource{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF};
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure CopyTIdTicks(const ASource: TIdTicks; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF UInt64_IS_NATIVE}
|
|
CopyTIdUInt64(ASource, VDest, ADestIndex);
|
|
{$ELSE}
|
|
CopyTIdInt64(ASource, VDest, ADestIndex);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure CopyTIdIPV6Address(const ASource: TIdIPv6Address; var VDest: TIdBytes; const ADestIndex: Integer);
|
|
{$IFDEF DOTNET}
|
|
var
|
|
i : Integer;
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
for i := 0 to 7 do begin
|
|
CopyTIdUInt16(ASource[i], VDest, ADestIndex + (i * 2));
|
|
end;
|
|
{$ELSE}
|
|
Move(ASource, VDest[ADestIndex], 16);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
|
|
var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
|
|
{$ELSE}
|
|
Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure CopyTIdString(const ASource: String; var VDest: TIdBytes;
|
|
const ADestIndex: Integer; const ALength: Integer = -1;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
); overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
CopyTIdString(ASource, 1, VDest, ADestIndex, ALength, ADestEncoding
|
|
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
|
|
);
|
|
end;
|
|
|
|
procedure CopyTIdString(const ASource: String; const ASourceIndex: Integer;
|
|
var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer = -1;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
); overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LLength: Integer;
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LTmp: TIdWideChars;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LTmp := nil; // keep the compiler happy
|
|
{$ENDIF}
|
|
LLength := IndyLength(ASource, ALength, ASourceIndex);
|
|
if LLength > 0 then begin
|
|
EnsureEncoding(ADestEncoding);
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
ADestEncoding.GetBytes(ASource, ASourceIndex, LLength, VDest, ADestIndex);
|
|
{$ELSE}
|
|
EnsureEncoding(ASrcEncoding, encOSDefault);
|
|
LTmp := ASrcEncoding.GetChars(RawToBytes(ASource[ASourceIndex], LLength)); // convert to Unicode
|
|
ADestEncoding.GetBytes(LTmp, 0, Length(LTmp), VDest, ADestIndex);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure DebugOutput(const AText: string);
|
|
{$IFDEF WINDOWS}
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
var
|
|
LTemp: TIdPlatformString;
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF KYLIX}
|
|
__write(stderr, AText, Length(AText));
|
|
__write(stderr, EOL, Length(EOL));
|
|
{$ENDIF}
|
|
|
|
{$IFDEF WINDOWS}
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LTemp := TIdPlatformString(AText); // explicit convert to Ansi/Unicode
|
|
OutputDebugString(PIdPlatformChar(LTemp));
|
|
{$ELSE}
|
|
OutputDebugString(PChar(AText));
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DOTNET}
|
|
System.Diagnostics.Debug.WriteLine(AText);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function CurrentThreadId: TIdThreadID;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
{$IFDEF DOTNET_2_OR_ABOVE}
|
|
{
|
|
[Warning] IdGlobal.pas(1416): W1000 Symbol 'GetCurrentThreadId'
|
|
is deprecated: 'AppDomain.GetCurrentThreadId has been deprecated because
|
|
it does not provide a stable Id when managed threads are running on fibers
|
|
(aka lightweight threads). To get a stable identifier for a managed thread,
|
|
use the ManagedThreadId property on Thread.
|
|
http://go.microsoft.com/fwlink/?linkid=14202'
|
|
}
|
|
Result := System.Threading.Thread.CurrentThread.ManagedThreadId;
|
|
// Thread.ManagedThreadId;
|
|
{$ENDIF}
|
|
{$IFDEF DOTNET_1_1}
|
|
// SG: I'm not sure if this return the handle of the dotnet thread or the handle of the application domain itself (or even if there is a difference)
|
|
Result := AppDomain.GetCurrentThreadId;
|
|
// RLebeau
|
|
// TODO: find if there is something like the following instead:
|
|
// System.Diagnostics.Thread.GetCurrentThread.ID
|
|
// System.Threading.Thread.CurrentThread.ID
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
// TODO: is GetCurrentThreadId() available on Linux?
|
|
Result := GetCurrentThreadID;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function CurrentProcessId: TIdPID;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF KYLIXCOMPAT}
|
|
Result := getpid;
|
|
{$ENDIF}
|
|
{$IFDEF USE_VCL_POSIX}
|
|
Result := getpid;
|
|
{$ENDIF}
|
|
{$IFDEF USE_BASEUNIX}
|
|
Result := fpgetpid;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF WINDOWS}
|
|
Result := GetCurrentProcessID;
|
|
{$ENDIF}
|
|
{$IFDEF DOTNET}
|
|
Result := System.Diagnostics.Process.GetCurrentProcess.ID;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
|
|
const ADelete: Boolean = IdFetchDeleteDefault;
|
|
const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LPos: Integer;
|
|
begin
|
|
if ACaseSensitive then begin
|
|
if ADelim = #0 then begin
|
|
// AnsiPos does not work with #0
|
|
LPos := Pos(ADelim, AInput);
|
|
end else begin
|
|
LPos := IndyPos(ADelim, AInput);
|
|
end;
|
|
if LPos = 0 then begin
|
|
Result := AInput;
|
|
if ADelete then begin
|
|
AInput := ''; {Do not Localize}
|
|
end;
|
|
end
|
|
else begin
|
|
Result := Copy(AInput, 1, LPos - 1);
|
|
if ADelete then begin
|
|
//slower Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
|
|
//remaining part is larger than the deleted
|
|
AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
|
|
end;
|
|
end;
|
|
end else begin
|
|
Result := FetchCaseInsensitive(AInput, ADelim, ADelete);
|
|
end;
|
|
end;
|
|
|
|
function FetchCaseInsensitive(var AInput: string; const ADelim: string;
|
|
const ADelete: Boolean): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LPos: Integer;
|
|
begin
|
|
if ADelim = #0 then begin
|
|
// AnsiPos does not work with #0
|
|
LPos := Pos(ADelim, AInput);
|
|
end else begin
|
|
//? may be AnsiUpperCase?
|
|
LPos := IndyPos(UpperCase(ADelim), UpperCase(AInput));
|
|
end;
|
|
if LPos = 0 then begin
|
|
Result := AInput;
|
|
if ADelete then begin
|
|
AInput := ''; {Do not Localize}
|
|
end;
|
|
end else begin
|
|
Result := Copy(AInput, 1, LPos - 1);
|
|
if ADelete then begin
|
|
//faster than Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
|
|
//remaining part is larger than the deleted
|
|
AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetThreadHandle(AThread: TThread): TIdThreadHandle;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF UNIX}
|
|
Result := AThread.ThreadID; // RLebeau: is it right to return an ID where a thread object handle is expected instead?
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
Result := AThread.Handle;
|
|
{$ENDIF}
|
|
{$IFDEF DOTNET}
|
|
Result := AThread.Handle;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF WINDOWS}
|
|
type
|
|
TGetTickCount64Func = function: UInt64; stdcall;
|
|
|
|
var
|
|
GetTickCount64: TGetTickCount64Func = nil;
|
|
|
|
function Impl_GetTickCount64: UInt64; stdcall;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
// TODO: implement some kind of accumulator so the Result
|
|
// keeps growing even when GetTickCount() wraps back to 0
|
|
Result := UInt64(Windows.GetTickCount);
|
|
end;
|
|
|
|
function Stub_GetTickCount64: UInt64; stdcall;
|
|
|
|
function GetImpl: Pointer;
|
|
begin
|
|
Result := GetProcAddress(GetModuleHandle('KERNEL32'), 'GetTickCount64'); {do not localize}
|
|
if Result = nil then begin
|
|
Result := @Impl_GetTickCount64;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
@GetTickCount64 := GetImpl();
|
|
Result := GetTickCount64();
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function Ticks: UInt32;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
// TODO: maybe throw an exception if Ticks64() exceeds the 49.7 day limit of UInt32?
|
|
Result := UInt32(Ticks64() mod High(UInt32));
|
|
end;
|
|
|
|
//RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
|
|
{$IFDEF UNIX}
|
|
{$IFDEF DARWIN}
|
|
{$IFDEF FPC}
|
|
function mach_timebase_info(var TimebaseInfoData: TTimebaseInfoData): Integer; cdecl; external 'libc';
|
|
function mach_absolute_time: QWORD; cdecl; external 'libc';
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF USE_clock_gettime}
|
|
{$IFDEF LINUX}
|
|
// accordingly Linux's /usr/include/linux/time.h
|
|
const
|
|
CLOCK_MONOTONIC = 1;
|
|
{$ENDIF}
|
|
{$IFDEF FREEBSD}
|
|
// accordingly FreeBSD's /usr/include/time.h
|
|
const
|
|
CLOCK_MONOTONIC = 4;
|
|
{$ENDIF}
|
|
|
|
function clock_gettime(clockid: Integer; var pts: timespec): Integer; cdecl; external 'libc';
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function Ticks64: TIdTicks;
|
|
{$IFDEF DOTNET}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF UNIX}
|
|
{$IFDEF DARWIN}
|
|
{$IFDEF USE_INLINE} inline;{$ENDIF}
|
|
{$ELSE}
|
|
var
|
|
{$IFDEF USE_clock_gettime}
|
|
ts: timespec;
|
|
{$ELSE}
|
|
tv: timeval;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
{$IFDEF USE_HI_PERF_COUNTER_FOR_TICKS}
|
|
var
|
|
nTime, freq: {$IFDEF WINCE}LARGE_INTEGER{$ELSE}Int64{$ENDIF};
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF UNIX}
|
|
{$IFDEF DARWIN}
|
|
// TODO: mach_absolute_time() does NOT count ticks while the system is
|
|
// sleeping! We can use time() to account for that:
|
|
//
|
|
// "time() carries on incrementing while the device is asleep, but of
|
|
// course can be manipulated by the operating system or user. However,
|
|
// the Kernel boottime (a timestamp of when the system last booted)
|
|
// also changes when the system clock is changed, therefore even though
|
|
// both these values are not fixed, the offset between them is."
|
|
//
|
|
// time_t uptime()
|
|
// {
|
|
// struct timeval boottime;
|
|
// int mib[2] = {CTL_KERN, KERN_BOOTTIME};
|
|
// size_t size = sizeof(boottime);
|
|
// time_t now;
|
|
// time_t uptime = -1;
|
|
// time(&now);
|
|
// if ((sysctl(mib, 2, &boottime, &size, NULL, 0) != -1) && (boottime.tv_sec != 0))
|
|
// {
|
|
// uptime = now - boottime.tv_sec;
|
|
// }
|
|
// return uptime;
|
|
// }
|
|
//
|
|
// However, KERN_BOOTTIME only has *seconds* precision (timeval.tv_usecs is always 0).
|
|
|
|
// mach_absolute_time() returns billionth of seconds, so divide by one million to get milliseconds
|
|
Result := (mach_absolute_time() * GMachTimeBaseInfo.numer) div (1000000 * GMachTimeBaseInfo.denom);
|
|
|
|
{$ELSE}
|
|
|
|
{$IFDEF USE_clock_gettime}
|
|
|
|
// TODO: use CLOCK_BOOTTIME on platforms that support it? It takes system
|
|
// suspension into account, whereas CLOCK_MONOTONIC does not...
|
|
clock_gettime(CLOCK_MONOTONIC, ts);
|
|
{$IFOPT R+} // detect range checking
|
|
{$R-}
|
|
{$DEFINE _RPlusWasEnabled}
|
|
{$ENDIF}
|
|
{$IFOPT Q+} // detect overflow checking
|
|
{$Q-}
|
|
{$DEFINE _QPlusWasEnabled}
|
|
{$ENDIF}
|
|
Result := (Int64(ts.tv_sec) * 1000) + (ts.tv_nsec div 1000000);
|
|
{$IFDEF _QPlusWasEnabled}
|
|
{$Q+}
|
|
{$UNDEF _QPlusWasEnabled}
|
|
{$ENDIF}
|
|
{$IFDEF _RPlusWasEnabled}
|
|
{$R+}
|
|
{$UNDEF _RPlusWasEnabled}
|
|
{$ENDIF}
|
|
|
|
{$ELSE}
|
|
|
|
{$IFDEF USE_BASEUNIX}
|
|
fpgettimeofday(@tv,nil);
|
|
{$ENDIF}
|
|
{$IFDEF KYLIXCOMPAT}
|
|
gettimeofday(tv, nil);
|
|
{$ENDIF}
|
|
{$IFOPT R+} // detect range checking
|
|
{$R-}
|
|
{$DEFINE _RPlusWasEnabled}
|
|
{$ENDIF}
|
|
Result := (Int64(tv.tv_sec) * 1000) + (tv.tv_usec div 1000);
|
|
{$IFDEF _RPlusWasEnabled}
|
|
{$R+}
|
|
{$UNDEF _RPlusWasEnabled}
|
|
{$ENDIF}
|
|
{
|
|
I've implemented this correctly for now. I'll argue for using
|
|
an int64 internally, since apparently quite some functionality
|
|
(throttle, etc etc) depends on it, and this value may wrap
|
|
at any point in time.
|
|
For Windows: Uptime > 72 hours isn't really that rare any more,
|
|
For Linux: no control over when this wraps.
|
|
|
|
IdEcho has code to circumvent the wrap, but its not very good
|
|
to have code for that at all spots where it might be relevant.
|
|
}
|
|
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF WINDOWS}
|
|
// S.G. 27/11/2002: Changed to use high-performance counters as per suggested
|
|
// S.G. 27/11/2002: by David B. Ferguson (david.mcs@ns.sympatico.ca)
|
|
|
|
// RLebeau 11/12/2009: removed the high-performance counters again. They
|
|
// are not reliable on multi-core systems, and are now starting to cause
|
|
// problems with TIdIOHandler.ReadLn() timeouts under Windows XP SP3, both
|
|
// 32-bit and 64-bit. Refer to these discussions:
|
|
//
|
|
// http://www.virtualdub.org/blog/pivot/entry.php?id=106
|
|
// http://blogs.msdn.com/oldnewthing/archive/2008/09/08/8931563.aspx
|
|
|
|
{$IFDEF USE_HI_PERF_COUNTER_FOR_TICKS}
|
|
{$IFDEF WINCE}
|
|
if Windows.QueryPerformanceCounter(@nTime) then begin
|
|
if Windows.QueryPerformanceFrequency(@freq) then begin
|
|
Result := Trunc((nTime.QuadPart / Freq.QuadPart) * 1000) and High(TIdTicks);
|
|
Exit;
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
if Windows.QueryPerformanceCounter(nTime) then begin
|
|
if Windows.QueryPerformanceFrequency(freq) then begin
|
|
Result := Trunc((nTime / Freq) * 1000) and High(TIdTicks);
|
|
Exit;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Result := TIdTicks(GetTickCount64());
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DOTNET}
|
|
// Must cast to a cardinal
|
|
//
|
|
// http://lists.ximian.com/archives/public/mono-bugs/2003-November/009293.html
|
|
// Other references in Google.
|
|
// Bug in .NET. It acts like Win32, not as per .NET docs but goes negative after 25 days.
|
|
//
|
|
// There may be a problem in the future if .NET changes this to work as docced with 25 days.
|
|
// Will need to check our routines then and somehow counteract / detect this.
|
|
// One possibility is that we could just wrap it ourselves in this routine.
|
|
|
|
// TODO: use DateTime.Ticks instead?
|
|
//Result := DateTime.Now.Ticks div 10000;
|
|
|
|
Result := TIdTicks(Environment.TickCount);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function GetTickDiff(const AOldTickCount, ANewTickCount: UInt32): UInt32;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{This is just in case the TickCount rolled back to zero}
|
|
if ANewTickCount >= AOldTickCount then begin
|
|
Result := ANewTickCount - AOldTickCount;
|
|
end else begin
|
|
Result := ((High(UInt32) - AOldTickCount) + ANewTickCount) + 1;
|
|
end;
|
|
end;
|
|
|
|
function GetTickDiff64(const AOldTickCount, ANewTickCount: TIdTicks): TIdTicks;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{This is just in case the TickCount rolled back to zero}
|
|
if ANewTickCount >= AOldTickCount then begin
|
|
Result := TIdTicks(ANewTickCount - AOldTickCount);
|
|
end else begin
|
|
Result := TIdTicks(((High(TIdTicks) - AOldTickCount) + ANewTickCount) + 1);
|
|
end;
|
|
end;
|
|
|
|
function GetElapsedTicks(const AOldTickCount: TIdTicks): UInt32;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := UInt32(GetTickDiff64(AOldTickCount, Ticks64));
|
|
end;
|
|
|
|
function GetElapsedTicks64(const AOldTickCount: TIdTicks): TIdTicks;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := GetTickDiff64(AOldTickCount, Ticks64);
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
function ServicesFilePath: string;
|
|
var
|
|
{$IFDEF WINDOWS}
|
|
sLocation: {$IFDEF STRING_UNICODE_MISMATCH}TIdPlatformString{$ELSE}string{$ENDIF};
|
|
{$ELSE}
|
|
sLocation: string;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF UNIX}
|
|
sLocation := '/etc/'; // assume Berkeley standard placement {do not localize}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF WINDOWS}
|
|
{$IFNDEF WINCE}
|
|
SetLength(sLocation, MAX_PATH);
|
|
SetLength(sLocation, GetWindowsDirectory(
|
|
{$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(sLocation){$ELSE}PChar(sLocation){$ENDIF}
|
|
, MAX_PATH));
|
|
sLocation := IndyIncludeTrailingPathDelimiter(sLocation);
|
|
if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
|
|
sLocation := sLocation + 'system32\drivers\etc\'; {do not localize}
|
|
end;
|
|
{$ELSE}
|
|
// GetWindowsDirectory() does not exist in WinCE, and there is no system folder, either
|
|
sLocation := '\Windows\'; {do not localize}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
Result := sLocation + 'services'; {do not localize}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
{$IFNDEF DOTNET}
|
|
// IdPorts returns a list of defined ports in /etc/services
|
|
function IdPorts: TIdPortList;
|
|
var
|
|
s: string;
|
|
idx, iPosSlash: {$IFDEF BYTE_COMPARE_SETS}Byte{$ELSE}Integer{$ENDIF};
|
|
i: {$IFDEF HAS_GENERICS_TList}Integer{$ELSE}PtrInt{$ENDIF};
|
|
iPrev: PtrInt;
|
|
sl: TStringList;
|
|
begin
|
|
if GIdPorts = nil then
|
|
begin
|
|
GIdPorts := TIdPortList.Create;
|
|
sl := TStringList.Create;
|
|
try
|
|
// TODO: use TStreamReader instead, on versions that support it
|
|
sl.LoadFromFile(ServicesFilePath); {do not localize}
|
|
iPrev := 0;
|
|
for idx := 0 to sl.Count - 1 do
|
|
begin
|
|
s := sl[idx];
|
|
iPosSlash := IndyPos('/', s); {do not localize}
|
|
if (iPosSlash > 0) and (not (IndyPos('#', s) in [1..iPosSlash])) then {do not localize}
|
|
begin // presumably found a port number that isn't commented {Do not Localize}
|
|
i := iPosSlash;
|
|
repeat
|
|
Dec(i);
|
|
if i = 0 then begin
|
|
raise EIdCorruptServicesFile.CreateFmt(RSCorruptServicesFile, [ServicesFilePath]); {do not localize}
|
|
end;
|
|
//TODO: Make Whitespace a function to elim warning
|
|
until Ord(s[i]) in IdWhiteSpace;
|
|
i := IndyStrToInt(Copy(s, i+1, iPosSlash-i-1));
|
|
if i <> iPrev then begin
|
|
GIdPorts.Add(
|
|
{$IFDEF HAS_GENERICS_TList}i{$ELSE}Pointer(i){$ENDIF}
|
|
);
|
|
end;
|
|
iPrev := i;
|
|
end;
|
|
end;
|
|
finally
|
|
sl.Free;
|
|
end;
|
|
end;
|
|
Result := GIdPorts;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if ATest then begin
|
|
Result := ATrue;
|
|
end else begin
|
|
Result := AFalse;
|
|
end;
|
|
end;
|
|
|
|
function iif(ATest: Boolean; const ATrue: string; const AFalse: string): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if ATest then begin
|
|
Result := ATrue;
|
|
end else begin
|
|
Result := AFalse;
|
|
end;
|
|
end;
|
|
|
|
function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if ATest then begin
|
|
Result := ATrue;
|
|
end else begin
|
|
Result := AFalse;
|
|
end;
|
|
end;
|
|
|
|
function iif(const AEncoding, ADefEncoding: IIdTextEncoding; ADefEncodingType: IdTextEncodingType = encASCII): IIdTextEncoding;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := AEncoding;
|
|
if Result = nil then
|
|
begin
|
|
Result := ADefEncoding;
|
|
EnsureEncoding(Result, ADefEncodingType);
|
|
end;
|
|
end;
|
|
|
|
function InMainThread: Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.Threading.Thread.CurrentThread = MainThread;
|
|
{$ELSE}
|
|
Result := GetCurrentThreadID = MainThreadID;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: TIdStreamSize);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Dest.Write(Src.Memory, Count);
|
|
{$ELSE}
|
|
Dest.Write(Src.Memory^, Count);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFNDEF DOTNET_EXCLUDE}
|
|
function IsCurrentThread(AThread: TThread): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := AThread.ThreadID = GetCurrentThreadID;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
//convert a dword into an IPv4 address in dotted form
|
|
function MakeUInt32IntoIPv4Address(const ADWord: UInt32): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := IntToStr((ADWord shr 24) and $FF) + '.';
|
|
Result := Result + IntToStr((ADWord shr 16) and $FF) + '.';
|
|
Result := Result + IntToStr((ADWord shr 8) and $FF) + '.';
|
|
Result := Result + IntToStr(ADWord and $FF);
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function MakeDWordIntoIPv4Address(const ADWord: UInt32): string;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := MakeUInt32IntoIPv4Address(ADWord);
|
|
end;
|
|
|
|
function IsAlpha(const AChar: Char): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
// TODO: under XE3.5+, use TCharHelper.IsLetter() instead
|
|
// TODO: under D2009+, use TCharacter.IsLetter() instead
|
|
|
|
// Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
|
|
Result := ((AChar >= 'a') and (AChar <= 'z')) or ((AChar >= 'A') and (AChar <= 'Z')); {Do not Localize}
|
|
end;
|
|
|
|
function IsAlpha(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
i: Integer;
|
|
LLen: Integer;
|
|
begin
|
|
Result := False;
|
|
LLen := IndyLength(AString, ALength, AIndex);
|
|
if LLen > 0 then begin
|
|
for i := 0 to LLen-1 do begin
|
|
if not IsAlpha(AString[AIndex+i]) then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function IsAlphaNumeric(const AChar: Char): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
// Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
|
|
Result := IsAlpha(AChar) or IsNumeric(AChar);
|
|
end;
|
|
|
|
function IsAlphaNumeric(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
i: Integer;
|
|
LLen: Integer;
|
|
begin
|
|
Result := False;
|
|
LLen := IndyLength(AString, ALength, AIndex);
|
|
if LLen > 0 then begin
|
|
for i := 0 to LLen-1 do begin
|
|
if not IsAlphaNumeric(AString[AIndex+i]) then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function IsOctal(const AChar: Char): Boolean; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := (AChar >= '0') and (AChar <= '7') {Do not Localize}
|
|
end;
|
|
|
|
function IsOctal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
i: Integer;
|
|
LLen: Integer;
|
|
begin
|
|
Result := False;
|
|
LLen := IndyLength(AString, ALength, AIndex);
|
|
if LLen > 0 then begin
|
|
for i := 0 to LLen-1 do begin
|
|
if not IsOctal(AString[AIndex+i]) then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function IsHexidecimal(const AChar: Char): Boolean; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := IsNumeric(AChar)
|
|
or ((AChar >= 'A') and (AChar <= 'F')) {Do not Localize}
|
|
or ((AChar >= 'a') and (AChar <= 'f')); {Do not Localize}
|
|
end;
|
|
|
|
function IsHexidecimal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
i: Integer;
|
|
LLen: Integer;
|
|
begin
|
|
Result := False;
|
|
LLen := IndyLength(AString, ALength, AIndex);
|
|
if LLen > 0 then begin
|
|
for i := 0 to LLen-1 do begin
|
|
if not IsHexidecimal(AString[AIndex+i]) then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
{$HINTS OFF}
|
|
function IsNumeric(const AString: string): Boolean;
|
|
var
|
|
LCode: Integer;
|
|
LVoid: Int64;
|
|
begin
|
|
Val(AString, LVoid, LCode);
|
|
Result := LCode = 0;
|
|
end;
|
|
{$HINTS ON}
|
|
|
|
function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean;
|
|
var
|
|
I: Integer;
|
|
LLen: Integer;
|
|
begin
|
|
Result := False;
|
|
LLen := IndyLength(AString, ALength, AIndex);
|
|
if LLen > 0 then begin
|
|
for I := 0 to LLen-1 do begin
|
|
if not IsNumeric(AString[AIndex+i]) then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function IsNumeric(const AChar: Char): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
// TODO: under XE3.5+, use TCharHelper.IsDigit() instead
|
|
// TODO: under D2009+, use TCharacter.IsDigit() instead
|
|
|
|
// Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
|
|
Result := (AChar >= '0') and (AChar <= '9'); {Do not Localize}
|
|
end;
|
|
|
|
{
|
|
This is an adaptation of the StrToInt64 routine in SysUtils.
|
|
We had to adapt it to work with Int64 because the one with Integers
|
|
can not deal with anything greater than MaxInt and IP addresses are
|
|
always $0-$FFFFFFFF (unsigned)
|
|
}
|
|
{$IFNDEF HAS_StrToInt64Def}
|
|
function StrToInt64Def(const S: string; const Default: Integer): Int64;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
E: Integer;
|
|
begin
|
|
Val(S, Result, E);
|
|
if E <> 0 then begin
|
|
Result := Default;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function IPv4MakeUInt32InRange(const AInt: Int64; const A256Power: Integer): UInt32;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
//Note that this function is only for stripping off some extra bits
|
|
//from an address that might appear in some spam E-Mails.
|
|
begin
|
|
case A256Power of
|
|
4: Result := (AInt and POWER_4);
|
|
3: Result := (AInt and POWER_3);
|
|
2: Result := (AInt and POWER_2);
|
|
else
|
|
Result := (AInt and POWER_1);
|
|
end;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function IPv4MakeLongWordInRange(const AInt: Int64; const A256Power: Integer): UInt32;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := IPv4MakeUInt32InRange(AInt, A256Power);
|
|
end;
|
|
|
|
function IPv4ToUInt32(const AIPAddress: string): UInt32;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LErr: Boolean;
|
|
begin
|
|
Result := IPv4ToUInt32(AIPAddress, LErr);
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function IPv4ToDWord(const AIPAddress: string): UInt32; overload;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := IPv4ToUInt32(AIPAddress);
|
|
end;
|
|
|
|
function IPv4ToUInt32(const AIPAddress: string; var VErr: Boolean): UInt32;
|
|
var
|
|
{$IFDEF DOTNET}
|
|
AIPaddr: IPAddress;
|
|
{$ELSE}
|
|
LBuf, LBuf2: string;
|
|
L256Power: Integer;
|
|
LParts: Integer; //how many parts should we process at a time
|
|
{$ENDIF}
|
|
begin
|
|
VErr := True;
|
|
Result := 0;
|
|
{$IFDEF DOTNET}
|
|
AIPaddr := System.Net.IPAddress.Parse(AIPAddress);
|
|
try
|
|
try
|
|
if AIPaddr.AddressFamily = Addressfamily.InterNetwork then begin
|
|
{$IFDEF DOTNET_2_OR_ABOVE}
|
|
//This looks funny but it's just to circvument a warning about
|
|
//a depreciated property in AIPaddr. We can safely assume
|
|
//this is an IPv4 address.
|
|
Result := BytesToUInt32( AIPAddr.GetAddressBytes,0);
|
|
{$ENDIF}
|
|
{$IFDEF DOTNET_1_1}
|
|
Result := AIPaddr.Address;
|
|
{$ENDIF}
|
|
VErr := False;
|
|
end;
|
|
except
|
|
VErr := True;
|
|
end;
|
|
finally
|
|
FreeAndNil(AIPaddr);
|
|
end;
|
|
{$ELSE}
|
|
// S.G. 11/8/2003: Added overflow checking disabling and change multiplys by SHLs.
|
|
// Locally disable overflow checking so we can safely use SHL and SHR
|
|
{$IFOPT Q+} // detect overflow checking
|
|
{$DEFINE _QPlusWasEnabled}
|
|
{$Q-}
|
|
{$ENDIF}
|
|
L256Power := 4;
|
|
LBuf2 := AIPAddress;
|
|
repeat
|
|
LBuf := Fetch(LBuf2, '.');
|
|
if LBuf = '' then begin
|
|
Break;
|
|
end;
|
|
//We do things this way because we have to treat
|
|
//IP address parts differently than a whole number
|
|
//and sometimes, there can be missing periods.
|
|
if (LBuf2 = '') and (L256Power > 1) then begin
|
|
LParts := L256Power;
|
|
Result := Result shl (L256Power SHL 3);
|
|
end else begin
|
|
LParts := 1;
|
|
Result := Result shl 8;
|
|
end;
|
|
if TextStartsWith(LBuf, IdHexPrefix) then begin
|
|
//this is a hexideciaml number
|
|
if not IsHexidecimal(Copy(LBuf, 3, MaxInt)) then begin
|
|
Exit;
|
|
end;
|
|
Result := Result + IPv4MakeUInt32InRange(StrToInt64Def(LBuf, 0), LParts);
|
|
end else begin
|
|
if not IsNumeric(LBuf) then begin
|
|
//There was an error meaning an invalid IP address
|
|
Exit;
|
|
end;
|
|
if TextStartsWith(LBuf, '0') and IsOctal(LBuf) then begin {do not localize}
|
|
//this is octal
|
|
Result := Result + IPv4MakeUInt32InRange(OctalToInt64(LBuf), LParts);
|
|
end else begin
|
|
//this must be a decimal
|
|
Result := Result + IPv4MakeUInt32InRange(StrToInt64Def(LBuf, 0), LParts);
|
|
end;
|
|
end;
|
|
Dec(L256Power);
|
|
until False;
|
|
VErr := False;
|
|
// Restore overflow checking
|
|
{$IFDEF _QPlusWasEnabled} // detect previous setting
|
|
{$UNDEF _QPlusWasEnabled}
|
|
{$Q+}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): UInt32;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := IPv4ToUInt32(AIPAddress, VErr);
|
|
end;
|
|
|
|
function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := IntToHex(AValue[0], 4);
|
|
for i := 1 to 7 do begin
|
|
Result := Result + ':' + IntToHex(AValue[i], 4);
|
|
end;
|
|
end;
|
|
|
|
function MakeCanonicalIPv4Address(const AAddr: string): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LErr: Boolean;
|
|
LIP: UInt32;
|
|
begin
|
|
LIP := IPv4ToUInt32(AAddr, LErr);
|
|
if LErr then begin
|
|
Result := '';
|
|
end else begin
|
|
Result := MakeUInt32IntoIPv4Address(LIP);
|
|
end;
|
|
end;
|
|
|
|
function MakeCanonicalIPv6Address(const AAddr: string): string;
|
|
// return an empty string if the address is invalid,
|
|
// for easy checking if its an address or not.
|
|
var
|
|
p, i: Integer;
|
|
{$IFDEF BYTE_COMPARE_SETS}
|
|
dots, colons: Byte;
|
|
{$ELSE}
|
|
dots, colons: Integer;
|
|
{$ENDIF}
|
|
colonpos: array[1..8] of Integer;
|
|
dotpos: array[1..3] of Integer;
|
|
LAddr: string;
|
|
num: Integer;
|
|
haddoublecolon: boolean;
|
|
fillzeros: Integer;
|
|
begin
|
|
Result := ''; // error
|
|
LAddr := AAddr;
|
|
if Length(LAddr) = 0 then begin
|
|
Exit;
|
|
end;
|
|
if TextStartsWith(LAddr, ':') then begin
|
|
LAddr := '0' + LAddr;
|
|
end;
|
|
if TextEndsWith(LAddr, ':') then begin
|
|
LAddr := LAddr + '0';
|
|
end;
|
|
dots := 0;
|
|
colons := 0;
|
|
for p := 1 to Length(LAddr) do begin
|
|
case LAddr[p] of
|
|
'.': begin
|
|
Inc(dots);
|
|
if dots < 4 then begin
|
|
dotpos[dots] := p;
|
|
end else begin
|
|
Exit; // error in address
|
|
end;
|
|
end;
|
|
':': begin
|
|
Inc(colons);
|
|
if colons < 8 then begin
|
|
colonpos[colons] := p;
|
|
end else begin
|
|
Exit; // error in address
|
|
end;
|
|
end;
|
|
'a'..'f',
|
|
'A'..'F': if dots > 0 then Exit;
|
|
// allow only decimal stuff within dotted portion, ignore otherwise
|
|
'0'..'9': ; // do nothing
|
|
else
|
|
Exit; // error in address
|
|
end; // case
|
|
end; // for
|
|
if not (dots in [0,3]) then begin
|
|
Exit; // you have to write 0 or 3 dots...
|
|
end;
|
|
if dots = 3 then begin
|
|
if not (colons in [2..6]) then begin
|
|
Exit; // must not have 7 colons if we have dots
|
|
end;
|
|
if colonpos[colons] > dotpos[1] then begin
|
|
Exit; // x:x:x.x:x:x is not valid
|
|
end;
|
|
end else begin
|
|
if not (colons in [2..7]) then begin
|
|
Exit; // must at least have two colons
|
|
end;
|
|
end;
|
|
|
|
// now start :-)
|
|
num := IndyStrToInt('$'+Copy(LAddr, 1, colonpos[1]-1), -1);
|
|
if (num < 0) or (num > 65535) then begin
|
|
Exit; // huh? odd number...
|
|
end;
|
|
Result := IntToHex(num, 1) + ':';
|
|
|
|
haddoublecolon := False;
|
|
for p := 2 to colons do begin
|
|
if colonpos[p - 1] = colonpos[p]-1 then begin
|
|
if haddoublecolon then begin
|
|
Result := '';
|
|
Exit; // only a single double-dot allowed!
|
|
end;
|
|
haddoublecolon := True;
|
|
fillzeros := 8 - colons;
|
|
if dots > 0 then begin
|
|
Dec(fillzeros);
|
|
end;
|
|
for i := 1 to fillzeros do begin
|
|
Result := Result + '0:'; {do not localize}
|
|
end;
|
|
end else begin
|
|
num := IndyStrToInt('$' + Copy(LAddr, colonpos[p - 1] + 1, colonpos[p] - colonpos[p - 1] - 1), -1);
|
|
if (num < 0) or (num > 65535) then begin
|
|
Result := '';
|
|
Exit; // huh? odd number...
|
|
end;
|
|
Result := Result + IntToHex(num,1) + ':';
|
|
end;
|
|
end; // end of colon separated part
|
|
|
|
if dots = 0 then begin
|
|
num := IndyStrToInt('$' + Copy(LAddr, colonpos[colons] + 1, MaxInt), -1);
|
|
if (num < 0) or (num > 65535) then begin
|
|
Result := '';
|
|
Exit; // huh? odd number...
|
|
end;
|
|
Result := Result + IntToHex(num,1) + ':';
|
|
end;
|
|
|
|
if dots > 0 then begin
|
|
num := IndyStrToInt(Copy(LAddr, colonpos[colons] + 1, dotpos[1] - colonpos[colons] -1),-1);
|
|
if (num < 0) or (num > 255) then begin
|
|
Result := '';
|
|
Exit;
|
|
end;
|
|
Result := Result + IntToHex(num, 2);
|
|
num := IndyStrToInt(Copy(LAddr, dotpos[1]+1, dotpos[2]-dotpos[1]-1),-1);
|
|
if (num < 0) or (num > 255) then begin
|
|
Result := '';
|
|
Exit;
|
|
end;
|
|
Result := Result + IntToHex(num, 2) + ':';
|
|
|
|
num := IndyStrToInt(Copy(LAddr, dotpos[2] + 1, dotpos[3] - dotpos[2] -1),-1);
|
|
if (num < 0) or (num > 255) then begin
|
|
Result := '';
|
|
Exit;
|
|
end;
|
|
Result := Result + IntToHex(num, 2);
|
|
num := IndyStrToInt(Copy(LAddr, dotpos[3] + 1, 3), -1);
|
|
if (num < 0) or (num > 255) then begin
|
|
Result := '';
|
|
Exit;
|
|
end;
|
|
Result := Result + IntToHex(num, 2) + ':';
|
|
end;
|
|
SetLength(Result, Length(Result) - 1);
|
|
end;
|
|
|
|
procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LErr: Boolean;
|
|
begin
|
|
IPv6ToIdIPv6Address(AIPAddress, VAddress, LErr);
|
|
if LErr then begin
|
|
raise EIdInvalidIPv6Address.CreateFmt(RSInvalidIPv6Address, [AIPAddress]);
|
|
end;
|
|
end;
|
|
|
|
procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address; var VErr: Boolean);
|
|
var
|
|
LAddress: string;
|
|
I: Integer;
|
|
begin
|
|
LAddress := MakeCanonicalIPv6Address(AIPAddress);
|
|
VErr := (LAddress = '');
|
|
if VErr then begin
|
|
Exit;
|
|
end;
|
|
for I := 0 to 7 do begin
|
|
VAddress[I] := IndyStrToInt('$' + Fetch(LAddress,':'), 0);
|
|
end;
|
|
end;
|
|
|
|
function IndyMax(const AValueOne, AValueTwo: Int64): Int64;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if AValueOne < AValueTwo then begin
|
|
Result := AValueTwo;
|
|
end else begin
|
|
Result := AValueOne;
|
|
end;
|
|
end;
|
|
|
|
function IndyMax(const AValueOne, AValueTwo: Int32): Int32;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if AValueOne < AValueTwo then begin
|
|
Result := AValueTwo;
|
|
end else begin
|
|
Result := AValueOne;
|
|
end;
|
|
end;
|
|
|
|
function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if AValueOne < AValueTwo then begin
|
|
Result := AValueTwo;
|
|
end else begin
|
|
Result := AValueOne;
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
// TODO: validate this with Unicode data
|
|
function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
|
|
var
|
|
LSearchLength: Integer;
|
|
LS1: Integer;
|
|
LChar: Char;
|
|
LPS, LPM: PChar;
|
|
begin
|
|
LSearchLength := Length(ASubStr);
|
|
if (LSearchLength = 0) or (LSearchLength > (MemorySize * SizeOf(Char))) then begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
|
|
LChar := PChar(Pointer(ASubStr))^; //first char
|
|
LPS := PChar(Pointer(ASubStr))+1;//tail string
|
|
LPM := MemBuff;
|
|
LS1 := LSearchLength-1;
|
|
LSearchLength := MemorySize-LS1;//MemorySize-LS+1
|
|
if LS1 = 0 then begin //optimization for freq used LF
|
|
while LSearchLength > 0 do begin
|
|
if LPM^ = LChar then begin
|
|
Result := LPM-MemBuff + 1;
|
|
Exit;
|
|
end;
|
|
Inc(LPM);
|
|
Dec(LSearchLength);
|
|
end;//while
|
|
end else begin
|
|
while LSearchLength > 0 do begin
|
|
if LPM^ = LChar then begin
|
|
Inc(LPM);
|
|
if CompareMem(LPM, LPS, LS1 * SizeOf(Char)) then begin
|
|
Result := LPM - MemBuff;
|
|
Exit;
|
|
end;
|
|
end else begin
|
|
Inc(LPM);
|
|
end;
|
|
Dec(LSearchLength);
|
|
end;
|
|
end;
|
|
Result := 0;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function IndyMin(const AValueOne, AValueTwo: Int32): Int32;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if AValueOne > AValueTwo then begin
|
|
Result := AValueTwo;
|
|
end else begin
|
|
Result := AValueOne;
|
|
end;
|
|
end;
|
|
|
|
function IndyMin(const AValueOne, AValueTwo: Int64): Int64;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if AValueOne > AValueTwo then begin
|
|
Result := AValueTwo;
|
|
end else begin
|
|
Result := AValueOne;
|
|
end;
|
|
end;
|
|
|
|
function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if AValueOne > AValueTwo then begin
|
|
Result := AValueTwo;
|
|
end else begin
|
|
Result := AValueOne;
|
|
end;
|
|
end;
|
|
|
|
function PosIdx(const ASubStr, AStr: string; AStartPos: UInt32): UInt32;
|
|
{$IFDEF DOTNET}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ELSE}
|
|
// use best register allocation on Win32
|
|
function FindStr(ALStartPos, EndPos: UInt32; StartChar: Char; const ALStr: string): UInt32;
|
|
begin
|
|
for Result := ALStartPos to EndPos do begin
|
|
if ALStr[Result] = StartChar then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := 0;
|
|
end;
|
|
|
|
// use best register allocation on Win32
|
|
function FindNextStr(ALStartPos, EndPos: UInt32; const ALStr, ALSubStr: string): UInt32;
|
|
begin
|
|
for Result := ALStartPos + 1 to EndPos do begin
|
|
if ALStr[Result] <> ALSubStr[Result - ALStartPos + 1] then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := 0;
|
|
end;
|
|
|
|
var
|
|
StartChar: Char;
|
|
LenSubStr, LenStr: UInt32;
|
|
EndPos: UInt32;
|
|
{$ENDIF}
|
|
begin
|
|
if AStartPos = 0 then begin
|
|
AStartPos := 1;
|
|
end;
|
|
{$IFDEF DOTNET}
|
|
Result := AStr.IndexOf(ASubStr, AStartPos-1) + 1;
|
|
{$ELSE}
|
|
Result := 0;
|
|
LenSubStr := Length(ASubStr);
|
|
LenStr := Length(AStr);
|
|
if (LenSubStr = 0) or (AStr = '') or (LenSubStr > (LenStr - (AStartPos - 1))) then begin
|
|
Exit;
|
|
end;
|
|
StartChar := ASubStr[1];
|
|
EndPos := LenStr - LenSubStr + 1;
|
|
if LenSubStr = 1 then begin
|
|
Result := FindStr(AStartPos, EndPos, StartChar, AStr)
|
|
end else
|
|
begin
|
|
repeat
|
|
Result := FindStr(AStartPos, EndPos, StartChar, AStr);
|
|
if Result = 0 then begin
|
|
Break;
|
|
end;
|
|
AStartPos := Result;
|
|
Result := FindNextStr(Result, AStartPos + LenSubStr - 1, AStr, ASubStr);
|
|
if Result = 0 then
|
|
begin
|
|
Result := AStartPos;
|
|
Exit;
|
|
end;
|
|
Inc(AStartPos);
|
|
until False;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function SBPos(const Substr, S: string): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
// Necessary because of "Compiler magic"
|
|
Result := Pos(Substr, S);
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
function SBStrScan(Str: PChar; Chr: Char): PChar;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := SysUtils.StrScan(Str, Chr);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF DOTNET}
|
|
//Don't rename this back to AnsiPos because that conceals a symbol in Windows
|
|
function InternalAnsiPos(const Substr, S: string): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := SysUtils.AnsiPos(Substr, S);
|
|
end;
|
|
|
|
function InternalAnsiStrScan(Str: PChar; Chr: Char): PChar;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := SysUtils.AnsiStrScan(Str, Chr);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure IndySetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority;
|
|
const APolicy: Integer = -MaxInt);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF UNIX}
|
|
{$IFDEF KYLIXCOMPAT}
|
|
{$IFDEF INT_THREAD_PRIORITY}
|
|
// Linux only allows root to adjust thread priorities, so we just ignore this call in Linux?
|
|
// actually, why not allow it if root
|
|
// and also allow setting *down* threadpriority (anyone can do that)
|
|
// note that priority is called "niceness" and positive is lower priority
|
|
if (getpriority(PRIO_PROCESS, 0) < APriority) or (geteuid = 0) then begin
|
|
setpriority(PRIO_PROCESS, 0, APriority);
|
|
end;
|
|
{$ELSE}
|
|
AThread.Priority := APriority;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF USE_BASEUNIX}
|
|
// Linux only allows root to adjust thread priorities, so we just ingnore this call in Linux?
|
|
// actually, why not allow it if root
|
|
// and also allow setting *down* threadpriority (anyone can do that)
|
|
// note that priority is called "niceness" and positive is lower priority
|
|
if (fpgetpriority(PRIO_PROCESS, 0) < cint(APriority)) or (fpgeteuid = 0) then begin
|
|
fpsetpriority(PRIO_PROCESS, 0, cint(APriority));
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
AThread.Priority := APriority;
|
|
{$ENDIF}
|
|
{$IFDEF DOTNET}
|
|
AThread.Priority := APriority;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure IndySleep(ATime: UInt32);
|
|
{$IFDEF USE_VCL_POSIX}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LTime: TimeVal;
|
|
{$ELSE}
|
|
{$IFNDEF UNIX}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ELSE}
|
|
var
|
|
LTime: TTimeVal;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF UNIX}
|
|
// *nix: Is there are reason for not using nanosleep?
|
|
|
|
// what if the user just calls sleep? without doing anything...
|
|
// cannot use GStack.WSSelectRead(nil, ATime)
|
|
// since no readsocketlist exists to get the fdset
|
|
LTime.tv_sec := ATime div 1000;
|
|
LTime.tv_usec := (ATime mod 1000) * 1000;
|
|
{$IFDEF USE_VCL_POSIX}
|
|
select( 0, nil, nil, nil, @LTime);
|
|
{$ENDIF}
|
|
{$IFDEF KYLIXCOMPAT}
|
|
Libc.Select(0, nil, nil, nil, @LTime);
|
|
{$ENDIF}
|
|
{$IFDEF USE_BASEUNIX}
|
|
fpSelect(0, nil, nil, nil, @LTime);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
Windows.Sleep(ATime);
|
|
{$ENDIF}
|
|
{$IFDEF DOTNET}
|
|
Thread.Sleep(ATime);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
procedure SplitColumnsNoTrim(const AData: string; AStrings: TStrings; const ADelim: string = ' ');
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
SplitDelimitedString(AData, AStrings, False, ADelim{$IFNDEF USE_OBJECT_ARC}, True{$ENDIF});
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
procedure SplitColumns(const AData: string; AStrings: TStrings; const ADelim: string = ' ');
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
SplitDelimitedString(AData, AStrings, True, ADelim{$IFNDEF USE_OBJECT_ARC}, True{$ENDIF});
|
|
end;
|
|
|
|
procedure SplitDelimitedString(const AData: string; AStrings: TStrings; ATrim: Boolean;
|
|
const ADelim: string = ' '{$IFNDEF USE_OBJECT_ARC}; AIncludePositions: Boolean = False{$ENDIF});
|
|
var
|
|
i: Integer;
|
|
LData: string;
|
|
LDelim: Integer; //delim len
|
|
LLeft: string;
|
|
LLastPos, LLeadingSpaceCnt: PtrInt;
|
|
begin
|
|
Assert(Assigned(AStrings));
|
|
AStrings.Clear;
|
|
LDelim := Length(ADelim);
|
|
LLastPos := 1;
|
|
|
|
if ATrim then begin
|
|
LData := Trim(AData);
|
|
if LData = '' then begin //if WhiteStr
|
|
Exit;
|
|
end;
|
|
|
|
LLeadingSpaceCnt := 0;
|
|
while AData[LLeadingSpaceCnt + 1] <= #32 do begin
|
|
Inc(LLeadingSpaceCnt);
|
|
end;
|
|
|
|
i := Pos(ADelim, LData);
|
|
while I > 0 do begin
|
|
LLeft := Copy(LData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
|
|
if LLeft > '' then begin {Do not Localize}
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|
if AIncludePositions then begin
|
|
AStrings.AddObject(Trim(LLeft), TObject(LLastPos + LLeadingSpaceCnt));
|
|
end else
|
|
{$ENDIF}
|
|
begin
|
|
AStrings.Add(Trim(LLeft));
|
|
end;
|
|
end;
|
|
LLastPos := I + LDelim; //first char after Delim
|
|
i := PosIdx(ADelim, LData, LLastPos);
|
|
end;//while found
|
|
if LLastPos <= Length(LData) then begin
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|
if AIncludePositions then begin
|
|
AStrings.AddObject(Trim(Copy(LData, LLastPos, MaxInt)), TObject(LLastPos + LLeadingSpaceCnt));
|
|
end else
|
|
{$ENDIF}
|
|
begin
|
|
AStrings.Add(Trim(Copy(LData, LLastPos, MaxInt)));
|
|
end;
|
|
end;
|
|
end else
|
|
begin
|
|
i := Pos(ADelim, AData);
|
|
while I > 0 do begin
|
|
LLeft := Copy(AData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
|
|
if LLeft <> '' then begin {Do not Localize}
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|
if AIncludePositions then begin
|
|
AStrings.AddObject(LLeft, TObject(LLastPos));
|
|
end else
|
|
{$ENDIF}
|
|
begin
|
|
AStrings.Add(LLeft);
|
|
end;
|
|
end;
|
|
LLastPos := I + LDelim; //first char after Delim
|
|
i := PosIdx(ADelim, AData, LLastPos);
|
|
end;
|
|
if LLastPos <= Length(AData) then begin
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|
if AIncludePositions then begin
|
|
AStrings.AddObject(Copy(AData, LLastPos, MaxInt), TObject(LLastPos));
|
|
end else
|
|
{$ENDIF}
|
|
begin
|
|
AStrings.Add(Copy(AData, LLastPos, MaxInt));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF USE_OBJECT_ARC}
|
|
constructor TIdStringPosition.Create(const AValue: String; const APosition: Integer);
|
|
begin
|
|
Value := AValue;
|
|
Position := APosition;
|
|
end;
|
|
|
|
procedure SplitDelimitedString(const AData: string; AStrings: TIdStringPositionList;
|
|
ATrim: Boolean; const ADelim: string = ' ');
|
|
var
|
|
i: Integer;
|
|
LData: string;
|
|
LDelim: Integer; //delim len
|
|
LLeft: string;
|
|
LLastPos, LLeadingSpaceCnt: Integer;
|
|
begin
|
|
Assert(Assigned(AStrings));
|
|
AStrings.Clear;
|
|
LDelim := Length(ADelim);
|
|
LLastPos := 1;
|
|
|
|
if ATrim then begin
|
|
LData := Trim(AData);
|
|
if LData = '' then begin //if WhiteStr
|
|
Exit;
|
|
end;
|
|
|
|
LLeadingSpaceCnt := 0;
|
|
while AData[LLeadingSpaceCnt + 1] <= #32 do begin
|
|
Inc(LLeadingSpaceCnt);
|
|
end;
|
|
|
|
i := Pos(ADelim, LData);
|
|
while I > 0 do begin
|
|
LLeft := Copy(LData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
|
|
if LLeft > '' then begin {Do not Localize}
|
|
AStrings.Add(TIdStringPosition.Create(Trim(LLeft), LLastPos + LLeadingSpaceCnt));
|
|
end;
|
|
LLastPos := I + LDelim; //first char after Delim
|
|
i := PosIdx(ADelim, LData, LLastPos);
|
|
end;//while found
|
|
if LLastPos <= Length(LData) then begin
|
|
AStrings.Add(TIdStringPosition.Create(Trim(Copy(LData, LLastPos, MaxInt)), LLastPos + LLeadingSpaceCnt));
|
|
end;
|
|
end else
|
|
begin
|
|
i := Pos(ADelim, AData);
|
|
while I > 0 do begin
|
|
LLeft := Copy(AData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
|
|
if LLeft <> '' then begin {Do not Localize}
|
|
AStrings.Add(TIdStringPosition.Create(LLeft, LLastPos));
|
|
end;
|
|
LLastPos := I + LDelim; //first char after Delim
|
|
i := PosIdx(ADelim, AData, LLastPos);
|
|
end;
|
|
if LLastPos <= Length(AData) then begin
|
|
AStrings.Add(TIdStringPosition.Create(Copy(AData, LLastPos, MaxInt), LLastPos));
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DOTNET}
|
|
procedure SetThreadName(const AName: string; AThread: System.Threading.Thread = nil);
|
|
begin
|
|
if AThread = nil then begin
|
|
AThread := System.Threading.Thread.CurrentThread;
|
|
end;
|
|
// cannot rename a previously-named thread
|
|
if AThread.Name = nil then begin
|
|
AThread.Name := AName;
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
procedure SetThreadName(const AName: string; AThreadID: UInt32 = $FFFFFFFF);
|
|
{$IFDEF HAS_NAMED_THREADS}
|
|
{$IFDEF HAS_TThread_NameThreadForDebugging}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
const
|
|
MS_VC_EXCEPTION = $406D1388;
|
|
type
|
|
TThreadNameInfo = record
|
|
RecType: UInt32; // Must be 0x1000
|
|
Name: PAnsiChar; // Pointer to name (in user address space)
|
|
ThreadID: UInt32; // Thread ID (-1 indicates caller thread)
|
|
Flags: UInt32; // Reserved for future use. Must be zero
|
|
end;
|
|
var
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
LName: AnsiString;
|
|
{$ENDIF}
|
|
LThreadNameInfo: TThreadNameInfo;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF HAS_NAMED_THREADS}
|
|
{$IFDEF HAS_TThread_NameThreadForDebugging}
|
|
TThread.NameThreadForDebugging(
|
|
{$IFDEF HAS_AnsiString}
|
|
AnsiString(AName) // explicit convert to Ansi
|
|
{$ELSE}
|
|
AName
|
|
{$ENDIF},
|
|
AThreadID
|
|
);
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
LName := AnsiString(AName); // explicit convert to Ansi
|
|
{$ENDIF}
|
|
LThreadNameInfo.RecType := $1000;
|
|
LThreadNameInfo.Name := PAnsiChar({$IFDEF STRING_IS_UNICODE}LName{$ELSE}AName{$ENDIF});
|
|
LThreadNameInfo.ThreadID := AThreadID;
|
|
LThreadNameInfo.Flags := 0;
|
|
try
|
|
// This is a wierdo Windows way to pass the info in
|
|
RaiseException(MS_VC_EXCEPTION, 0, SizeOf(LThreadNameInfo) div SizeOf(UInt32),
|
|
PDWord(@LThreadNameInfo));
|
|
except
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
// Do nothing. No support in this compiler for it.
|
|
{$ENDIF}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DOTNET}
|
|
{$IFNDEF DOTNET_2_OR_ABOVE}
|
|
|
|
{ TEvent }
|
|
|
|
constructor TEvent.Create(EventAttributes: IntPtr; ManualReset, InitialState: Boolean; const Name: string);
|
|
begin
|
|
inherited Create;
|
|
// Name not used
|
|
if ManualReset then begin
|
|
FEvent := ManualResetEvent.Create(InitialState);
|
|
end else begin
|
|
FEvent := AutoResetEvent.Create(InitialState);
|
|
end;
|
|
end;
|
|
|
|
constructor TEvent.Create;
|
|
begin
|
|
Create(nil, True, False, ''); {Do not Localize}
|
|
end;
|
|
|
|
destructor TEvent.Destroy;
|
|
begin
|
|
if Assigned(FEvent) then begin
|
|
FEvent.Close;
|
|
end;
|
|
FreeAndNil(FEvent);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TEvent.SetEvent;
|
|
begin
|
|
if FEvent is ManualResetEvent then begin
|
|
ManualResetEvent(FEvent).&Set;
|
|
end else begin
|
|
AutoResetEvent(FEvent).&Set;
|
|
end;
|
|
end;
|
|
|
|
procedure TEvent.ResetEvent;
|
|
begin
|
|
if FEvent is ManualResetEvent then begin
|
|
ManualResetEvent(FEvent).Reset;
|
|
end else begin
|
|
AutoResetEvent(FEvent).Reset;
|
|
end;
|
|
end;
|
|
|
|
function TEvent.WaitFor(Timeout: UInt32): TWaitResult;
|
|
var
|
|
Passed: Boolean;
|
|
begin
|
|
try
|
|
if Timeout = INFINITE then begin
|
|
Passed := FEvent.WaitOne;
|
|
end else begin
|
|
Passed := FEvent.WaitOne(Timeout, True);
|
|
end;
|
|
if Passed then begin
|
|
Result := wrSignaled;
|
|
end else begin
|
|
Result := wrTimeout;
|
|
end;
|
|
except
|
|
Result := wrError;
|
|
end;
|
|
end;
|
|
|
|
{ TCriticalSection }
|
|
|
|
procedure TCriticalSection.Acquire;
|
|
begin
|
|
Enter;
|
|
end;
|
|
|
|
procedure TCriticalSection.Release;
|
|
begin
|
|
Leave;
|
|
end;
|
|
|
|
function TCriticalSection.TryEnter: Boolean;
|
|
begin
|
|
Result := System.Threading.Monitor.TryEnter(Self);
|
|
end;
|
|
|
|
procedure TCriticalSection.Enter;
|
|
begin
|
|
System.Threading.Monitor.Enter(Self);
|
|
end;
|
|
|
|
procedure TCriticalSection.Leave;
|
|
begin
|
|
System.Threading.Monitor.Exit(Self);
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{ TIdLocalEvent }
|
|
|
|
constructor TIdLocalEvent.Create(const AInitialState: Boolean = False; const AManualReset: Boolean = False);
|
|
begin
|
|
inherited Create(nil, AManualReset, AInitialState, ''); {Do not Localize}
|
|
end;
|
|
|
|
function TIdLocalEvent.WaitForEver: TWaitResult;
|
|
begin
|
|
Result := WaitFor(Infinite);
|
|
end;
|
|
|
|
procedure ToDo(const AMsg: string);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
raise EIdException.Create(AMsg);
|
|
end;
|
|
|
|
// RLebeau: the following three functions are utility functions
|
|
// that determine the usable amount of data in various buffer types.
|
|
// There are many operations in Indy that allow the user to specify
|
|
// data sizes, or to have Indy calculate it. So these functions
|
|
// help reduce code duplication.
|
|
|
|
function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LAvailable: Integer;
|
|
begin
|
|
Assert(AIndex >= 1);
|
|
LAvailable := IndyMax(Length(ABuffer)-AIndex+1, 0);
|
|
if ALength < 0 then begin
|
|
Result := LAvailable;
|
|
end else begin
|
|
Result := IndyMin(LAvailable, ALength);
|
|
end;
|
|
end;
|
|
|
|
function IndyLength(const ABuffer: TIdBytes; const ALength: Integer = -1; const AIndex: Integer = 0): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LAvailable: Integer;
|
|
begin
|
|
Assert(AIndex >= 0);
|
|
LAvailable := IndyMax(Length(ABuffer)-AIndex, 0);
|
|
if ALength < 0 then begin
|
|
Result := LAvailable;
|
|
end else begin
|
|
Result := IndyMin(LAvailable, ALength);
|
|
end;
|
|
end;
|
|
|
|
function IndyLength(const ABuffer: TStream; const ALength: TIdStreamSize = -1): TIdStreamSize; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LAvailable: TIdStreamSize;
|
|
begin
|
|
LAvailable := IndyMax(ABuffer.Size - ABuffer.Position, 0);
|
|
if ALength < 0 then begin
|
|
Result := LAvailable;
|
|
end else begin
|
|
Result := IndyMin(LAvailable, ALength);
|
|
end;
|
|
end;
|
|
|
|
const
|
|
wdays: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); {do not localize}
|
|
monthnames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', {do not localize}
|
|
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); {do not localize}
|
|
|
|
{$IFDEF HAS_TFormatSettings}
|
|
//Delphi5 does not have TFormatSettings
|
|
//this should be changed to a singleton?
|
|
function GetEnglishSetting: TFormatSettings;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result.CurrencyFormat := $00; // 0 = '$1'
|
|
Result.NegCurrFormat := $00; //0 = '($1)'
|
|
Result.CurrencyString := '$'; {do not localize}
|
|
Result.CurrencyDecimals := 2;
|
|
|
|
Result.ThousandSeparator := ','; {do not localize}
|
|
Result.DecimalSeparator := '.'; {do not localize}
|
|
|
|
Result.DateSeparator := '/'; {do not localize}
|
|
Result.ShortDateFormat := 'M/d/yyyy'; {do not localize}
|
|
Result.LongDateFormat := 'dddd, MMMM dd, yyyy'; {do not localize}
|
|
|
|
Result.TimeSeparator := ':'; {do not localize}
|
|
Result.TimeAMString := 'AM'; {do not localize}
|
|
Result.TimePMString := 'PM'; {do not localize}
|
|
Result.LongTimeFormat := 'h:mm:ss AMPM'; {do not localize}
|
|
Result.ShortTimeFormat := 'h:mm AMPM'; {do not localize}
|
|
|
|
Result.ShortMonthNames[1] := monthnames[1]; //'Jan';
|
|
Result.ShortMonthNames[2] := monthnames[2]; //'Feb';
|
|
Result.ShortMonthNames[3] := monthnames[3]; //'Mar';
|
|
Result.ShortMonthNames[4] := monthnames[4]; //'Apr';
|
|
Result.ShortMonthNames[5] := monthnames[5]; //'May';
|
|
Result.ShortMonthNames[6] := monthnames[6]; //'Jun';
|
|
Result.ShortMonthNames[7] := monthnames[7]; //'Jul';
|
|
Result.ShortMonthNames[8] := monthnames[8]; //'Aug';
|
|
Result.ShortMonthNames[9] := monthnames[9]; //'Sep';
|
|
Result.ShortMonthNames[10] := monthnames[10];// 'Oct';
|
|
Result.ShortMonthNames[11] := monthnames[11]; //'Nov';
|
|
Result.ShortMonthNames[12] := monthnames[12]; //'Dec';
|
|
|
|
Result.LongMonthNames[1] := 'January'; {do not localize}
|
|
Result.LongMonthNames[2] := 'February'; {do not localize}
|
|
Result.LongMonthNames[3] := 'March'; {do not localize}
|
|
Result.LongMonthNames[4] := 'April'; {do not localize}
|
|
Result.LongMonthNames[5] := 'May'; {do not localize}
|
|
Result.LongMonthNames[6] := 'June'; {do not localize}
|
|
Result.LongMonthNames[7] := 'July'; {do not localize}
|
|
Result.LongMonthNames[8] := 'August'; {do not localize}
|
|
Result.LongMonthNames[9] := 'September'; {do not localize}
|
|
Result.LongMonthNames[10] := 'October'; {do not localize}
|
|
Result.LongMonthNames[11] := 'November'; {do not localize}
|
|
Result.LongMonthNames[12] := 'December'; {do not localize}
|
|
|
|
Result.ShortDayNames[1] := wdays[1]; //'Sun';
|
|
Result.ShortDayNames[2] := wdays[2]; //'Mon';
|
|
Result.ShortDayNames[3] := wdays[3]; //'Tue';
|
|
Result.ShortDayNames[4] := wdays[4]; //'Wed';
|
|
Result.ShortDayNames[5] := wdays[5]; //'Thu';
|
|
Result.ShortDayNames[6] := wdays[6]; //'Fri';
|
|
Result.ShortDayNames[7] := wdays[7]; //'Sat';
|
|
|
|
Result.LongDayNames[1] := 'Sunday'; {do not localize}
|
|
Result.LongDayNames[2] := 'Monday'; {do not localize}
|
|
Result.LongDayNames[3] := 'Tuesday'; {do not localize}
|
|
Result.LongDayNames[4] := 'Wednesday'; {do not localize}
|
|
Result.LongDayNames[5] := 'Thursday'; {do not localize}
|
|
Result.LongDayNames[6] := 'Friday'; {do not localize}
|
|
Result.LongDayNames[7] := 'Saturday'; {do not localize}
|
|
|
|
Result.ListSeparator := ','; {do not localize}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
// RLebeau 10/24/2008: In the RTM release of Delphi/C++Builder 2009, the
|
|
// overloaded version of SysUtils.Format() that has a TFormatSettings parameter
|
|
// has an internal bug that causes an EConvertError exception when UnicodeString
|
|
// parameters greater than 4094 characters are passed to it. Refer to QC #67934
|
|
// for details. The bug is fixed in 2009 Update 1. For RTM, call FormatBuf()
|
|
// directly to work around the problem...
|
|
function IndyFormat(const AFormat: string; const Args: array of const): string;
|
|
{$IFNDEF DOTNET}
|
|
{$IFDEF HAS_TFormatSettings}
|
|
var
|
|
EnglishFmt: TFormatSettings;
|
|
{$IFDEF BROKEN_FmtStr}
|
|
Len, BufLen: Integer;
|
|
Buffer: array[0..4095] of Char;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
// RLebeau 10/29/09: temporary workaround until we figure out how to use
|
|
// SysUtils.FormatBuf() correctly under .NET in D2009 RTM...
|
|
Result := SysUtils.Format(AFormat, Args);
|
|
{$ELSE}
|
|
{$IFDEF HAS_TFormatSettings}
|
|
EnglishFmt := GetEnglishSetting;
|
|
{$IFDEF BROKEN_FmtStr}
|
|
BufLen := Length(Buffer);
|
|
if Length(AFormat) < (Length(Buffer) - (Length(Buffer) div 4)) then
|
|
begin
|
|
Len := SysUtils.FormatBuf(Buffer, Length(Buffer) - 1, Pointer(AFormat)^,
|
|
Length(AFormat), Args, EnglishFmt);
|
|
end else
|
|
begin
|
|
BufLen := Length(AFormat);
|
|
Len := BufLen;
|
|
end;
|
|
if Len >= BufLen - 1 then
|
|
begin
|
|
while Len >= BufLen - 1 do
|
|
begin
|
|
Inc(BufLen, BufLen);
|
|
Result := ''; // prevent copying of existing data, for speed
|
|
SetLength(Result, BufLen);
|
|
Len := SysUtils.FormatBuf(PChar(Result), BufLen - 1, Pointer(AFormat)^,
|
|
Length(AFormat), Args, EnglishFmt);
|
|
end;
|
|
SetLength(Result, Len);
|
|
end else
|
|
begin
|
|
SetString(Result, Buffer, Len);
|
|
end;
|
|
{$ELSE}
|
|
Result := SysUtils.Format(AFormat, Args, EnglishFmt);
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
//Is there a way to get delphi5 to use locale in format? something like:
|
|
// SetThreadLocale(TheNewLocaleId);
|
|
// GetFormatSettings;
|
|
// Application.UpdateFormatSettings := False; //needed?
|
|
// format()
|
|
// set locale back to prior
|
|
Result := SysUtils.Format(AFormat, Args);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
|
|
// should adhere to RFC 2616
|
|
var
|
|
wDay, wMonth, wYear: Word;
|
|
begin
|
|
DecodeDate(GMTValue, wYear, wMonth, wDay);
|
|
Result := IndyFormat('%s, %.2d %s %.4d %s %s', {do not localize}
|
|
[wdays[DayOfWeek(GMTValue)], wDay, monthnames[wMonth],
|
|
wYear, FormatDateTime('HH":"nn":"ss',GMTValue), 'GMT']); {do not localize}
|
|
end;
|
|
|
|
function DateTimeGMTToCookieStr(const GMTValue: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
|
|
var
|
|
wDay, wMonth, wYear: Word;
|
|
LDelim: Char;
|
|
begin
|
|
DecodeDate(GMTValue, wYear, wMonth, wDay);
|
|
// RLebeau: cookie draft-23 requires HTTP servers to format an Expires value as follows:
|
|
//
|
|
// Wdy, DD Mon YYYY HH:MM:SS GMT
|
|
//
|
|
// However, Netscape style formatting, which RFCs 2109 and 2965 allow
|
|
// (but draft-23 obsoletes), are more common:
|
|
//
|
|
// Wdy, DD-Mon-YY HH:MM:SS GMT (original)
|
|
// Wdy, DD-Mon-YYYY HH:MM:SS GMT (RFC 1123)
|
|
//
|
|
if AUseNetscapeFmt then begin
|
|
LDelim := '-'; {do not localize}
|
|
end else begin
|
|
LDelim := ' '; {do not localize}
|
|
end;
|
|
Result := IndyFormat('%s, %.2d%s%s%s%.4d %s %s', {do not localize}
|
|
[wdays[DayOfWeek(GMTValue)], wDay, LDelim, monthnames[wMonth], LDelim, wYear,
|
|
FormatDateTime('HH":"nn":"ss',GMTValue), 'GMT']); {do not localize}
|
|
end;
|
|
|
|
function DateTimeGMTToImapStr(const GMTValue: TDateTime) : String;
|
|
var
|
|
wDay, wMonth, wYear: Word;
|
|
LDay: String;
|
|
begin
|
|
DecodeDate(GMTValue, wYear, wMonth, wDay);
|
|
LDay := IntToStr(wDay);
|
|
if Length(LDay) < 2 then begin
|
|
LDay := ' ' + LDay; // NOTE: space NOT zero!
|
|
end;
|
|
Result := IndyFormat('%s-%s-%d %s %s', {do not localize}
|
|
[LDay, monthnames[wMonth], wYear, FormatDateTime('HH":"nn":"ss',GMTValue), {do not localize}
|
|
'+0000']); {do not localize}
|
|
end;
|
|
|
|
function LocalDateTimeToHttpStr(const Value: TDateTime) : String;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := DateTimeGMTToHttpStr(Value - OffsetFromUTC);
|
|
end;
|
|
|
|
function LocalDateTimeToCookieStr(const Value: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := DateTimeGMTToCookieStr(Value - OffsetFromUTC, AUseNetscapeFmt);
|
|
end;
|
|
|
|
function LocalDateTimeToImapStr(const Value: TDateTime) : String;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := DateTimeGMTToImapStr(Value - OffsetFromUTC);
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function DateTimeToInternetStr(const Value: TDateTime; const AUseGMTStr : Boolean = False) : String;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
Result := LocalDateTimeToGMT(Value, AUseGMTStr);
|
|
end;
|
|
|
|
{This should never be localized}
|
|
function LocalDateTimeToGMT(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String;
|
|
var
|
|
wDay, wMonth, wYear: Word;
|
|
begin
|
|
DecodeDate(Value, wYear, wMonth, wDay);
|
|
Result := IndyFormat('%s, %d %s %d %s %s', {do not localize}
|
|
[wdays[DayOfWeek(Value)], wDay, monthnames[wMonth],
|
|
wYear, FormatDateTime('HH":"nn":"ss', Value), {do not localize}
|
|
UTCOffsetToStr(OffsetFromUTC, AUseGMTStr)]);
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function DateTimeToGmtOffSetStr(ADateTime: TDateTime; const AUseGMTStr: Boolean = False): string;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := UTCOffsetToStr(ADateTime, AUseGMTStr);
|
|
end;
|
|
|
|
function OffsetFromUTC: TDateTime;
|
|
{$IFDEF DOTNET}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
var
|
|
iBias: Integer;
|
|
tmez: TTimeZoneInformation;
|
|
{$ENDIF}
|
|
{$IFDEF UNIX}
|
|
{$IFDEF USE_VCL_POSIX}
|
|
var
|
|
T : Time_t;
|
|
TV : TimeVal;
|
|
UT : tm;
|
|
{$ENDIF}
|
|
{$IFDEF USE_BASEUNIX}
|
|
var
|
|
timeval: TTimeVal;
|
|
timezone: TTimeZone;
|
|
{$ENDIF}
|
|
{$IFDEF KYLIXCOMPAT}
|
|
var
|
|
T: Time_T;
|
|
TV: TTimeVal;
|
|
UT: TUnixTime;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF UNIX}
|
|
|
|
{$IFDEF USE_VCL_POSIX}
|
|
{from http://edn.embarcadero.com/article/27890 but without multiplying the Result by -1}
|
|
|
|
gettimeofday(TV, nil);
|
|
T := TV.tv_sec;
|
|
localtime_r(T, UT);
|
|
Result := UT.tm_gmtoff / 60 / 60 / 24;
|
|
{$ENDIF}
|
|
{$IFDEF USE_BASEUNIX}
|
|
fpGetTimeOfDay (@TimeVal, @TimeZone);
|
|
Result := -1 * (timezone.tz_minuteswest / 60 / 24)
|
|
{$ENDIF}
|
|
{$IFDEF KYLIXCOMPAT}
|
|
{from http://edn.embarcadero.com/article/27890 but without multiplying the Result by -1}
|
|
|
|
gettimeofday(TV, nil);
|
|
T := TV.tv_sec;
|
|
localtime_r(@T, UT);
|
|
Result := UT.__tm_gmtoff / 60 / 60 / 24;
|
|
{$ENDIF}
|
|
|
|
{$ENDIF}
|
|
{$IFDEF DOTNET}
|
|
Result := System.Timezone.CurrentTimezone.GetUTCOffset(DateTime.FromOADate(Now)).TotalDays;
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
case GetTimeZoneInformation({$IFDEF WINCE}@{$ENDIF}tmez) of
|
|
TIME_ZONE_ID_INVALID :
|
|
raise EIdFailedToRetreiveTimeZoneInfo.Create(RSFailedTimeZoneInfo);
|
|
TIME_ZONE_ID_UNKNOWN :
|
|
iBias := tmez.Bias;
|
|
TIME_ZONE_ID_DAYLIGHT : begin
|
|
iBias := tmez.Bias;
|
|
if tmez.DaylightDate.wMonth <> 0 then begin
|
|
iBias := iBias + tmez.DaylightBias;
|
|
end;
|
|
end;
|
|
TIME_ZONE_ID_STANDARD : begin
|
|
iBias := tmez.Bias;
|
|
if tmez.StandardDate.wMonth <> 0 then begin
|
|
iBias := iBias + tmez.StandardBias;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
raise EIdFailedToRetreiveTimeZoneInfo.Create(RSFailedTimeZoneInfo);
|
|
end;
|
|
end;
|
|
{We use ABS because EncodeTime will only accept positive values}
|
|
Result := EncodeTime(Abs(iBias) div 60, Abs(iBias) mod 60, 0, 0);
|
|
{The GetTimeZone function returns values oriented towards converting
|
|
a GMT time into a local time. We wish to do the opposite by returning
|
|
the difference between the local time and GMT. So I just make a positive
|
|
value negative and leave a negative value as positive}
|
|
if iBias > 0 then begin
|
|
Result := 0.0 - Result;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function UTCOffsetToStr(const AOffset: TDateTime; const AUseGMTStr: Boolean = False): string;
|
|
var
|
|
AHour, AMin, ASec, AMSec: Word;
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LSB: TIdStringBuilder;
|
|
{$ENDIF}
|
|
begin
|
|
if (AOffset = 0.0) and AUseGMTStr then
|
|
begin
|
|
Result := 'GMT'; {do not localize}
|
|
end else
|
|
begin
|
|
DecodeTime(AOffset, AHour, AMin, ASec, AMSec);
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
LSB := TIdStringBuilder.Create(5);
|
|
LSB.Append(IndyFormat(' %0.2d%0.2d', [AHour, AMin])); {do not localize}
|
|
if AOffset < 0.0 then begin
|
|
LSB[0] := '-'; {do not localize}
|
|
end else begin
|
|
LSB[0] := '+'; {do not localize}
|
|
end;
|
|
Result := LSB.ToString;
|
|
{$ELSE}
|
|
Result := IndyFormat(' %0.2d%0.2d', [AHour, AMin]); {do not localize}
|
|
if AOffset < 0.0 then begin
|
|
Result[1] := '-'; {do not localize}
|
|
end else begin
|
|
Result[1] := '+'; {do not localize}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function IndyIncludeTrailingPathDelimiter(const S: string): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF HAS_SysUtils_IncludeExcludeTrailingPathDelimiter}
|
|
Result := SysUtils.IncludeTrailingPathDelimiter(S);
|
|
{$ELSE}
|
|
Result := SysUtils.IncludeTrailingBackslash(S);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyExcludeTrailingPathDelimiter(const S: string): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF HAS_SysUtils_IncludeExcludeTrailingPathDelimiter}
|
|
Result := SysUtils.ExcludeTrailingPathDelimiter(S);
|
|
{$ELSE}
|
|
Result := SysUtils.ExcludeTrailingBackslash(S);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function StringsReplace(const S: String; const OldPattern, NewPattern: array of string): string;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
// TODO: re-write this to not use ReplaceAll() in a loop anymore. If
|
|
// OldPattern contains multiple strings, a string appearing later in the
|
|
// list may be replaced multiple times by accident if it appears in the
|
|
// Result of an earlier string replacement.
|
|
Result := s;
|
|
for i := Low(OldPattern) to High(OldPattern) do begin
|
|
Result := ReplaceAll(Result, OldPattern[i], NewPattern[i]);
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
{$IFNDEF HAS_PosEx}
|
|
function PosEx(const SubStr, S: string; Offset: Integer): Integer;
|
|
var
|
|
I, LIterCnt, L, J: Integer;
|
|
PSubStr, PS: PChar;
|
|
begin
|
|
Result := 0;
|
|
if SubStr = '' then begin
|
|
Exit;
|
|
end;
|
|
|
|
{ Calculate the number of possible iterations. Not valid if Offset < 1. }
|
|
LIterCnt := Length(S) - Offset - Length(SubStr) + 1;
|
|
|
|
{ Only continue if the number of iterations is positive or zero (there is space to check) }
|
|
if (Offset > 0) and (LIterCnt >= 0) then
|
|
begin
|
|
L := Length(SubStr);
|
|
PSubStr := PChar(SubStr);
|
|
PS := PChar(S);
|
|
Inc(PS, Offset - 1);
|
|
|
|
for I := 0 to LIterCnt do
|
|
begin
|
|
J := 0;
|
|
while (J >= 0) and (J < L) do
|
|
begin
|
|
if PS[I + J] = PSubStr[J] then begin
|
|
Inc(J);
|
|
end else begin
|
|
J := -1;
|
|
end;
|
|
end;
|
|
if J >= L then begin
|
|
Result := I + Offset;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function ReplaceAll(const S: String; const OldPattern, NewPattern: String): String;
|
|
var
|
|
I, PatLen: Integer;
|
|
{$IFDEF DOTNET}
|
|
J: Integer;
|
|
{$ELSE}
|
|
NumBytes: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
PatLen := Length(OldPattern);
|
|
if Length(NewPattern) = PatLen then begin
|
|
Result := S;
|
|
I := Pos(OldPattern, Result);
|
|
if I > 0 then begin
|
|
UniqueString(Result);
|
|
{$IFNDEF DOTNET}
|
|
NumBytes := PatLen * SizeOf(Char);
|
|
{$ENDIF}
|
|
repeat
|
|
{$IFDEF DOTNET}
|
|
for J := 1 to PatLen do begin
|
|
Result[I+J-1] := NewPattern[J];
|
|
end;
|
|
{$ELSE}
|
|
Move(PChar(NewPattern)^, Result[I], NumBytes);
|
|
{$ENDIF}
|
|
I := PosEx(OldPattern, Result, I + PatLen);
|
|
until I = 0;
|
|
end;
|
|
end else begin
|
|
Result := SysUtils.StringReplace(S, OldPattern, NewPattern, [rfReplaceAll]);
|
|
end;
|
|
end;
|
|
|
|
function ReplaceOnlyFirst(const S, OldPattern, NewPattern: string): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := SysUtils.StringReplace(s, OldPattern, NewPattern, []);
|
|
end;
|
|
|
|
function IndyStrToInt(const S: string): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := StrToInt(Trim(S));
|
|
end;
|
|
|
|
function IndyStrToInt(const S: string; ADefault: Integer): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := StrToIntDef(Trim(S), ADefault);
|
|
end;
|
|
|
|
function CompareDate(const D1, D2: TDateTime): Integer;
|
|
var
|
|
LTM1, LTM2 : TTimeStamp;
|
|
begin
|
|
LTM1 := DateTimeToTimeStamp(D1);
|
|
LTM2 := DateTimeToTimeStamp(D2);
|
|
if LTM1.Date = LTM2.Date then begin
|
|
if LTM1.Time < LTM2.Time then begin
|
|
Result := -1;
|
|
end
|
|
else if LTM1.Time > LTM2.Time then begin
|
|
Result := 1;
|
|
end
|
|
else begin
|
|
Result := 0;
|
|
end;
|
|
end
|
|
else if LTM1.Date > LTM2.Date then begin
|
|
Result := 1;
|
|
end
|
|
else begin
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function AddMSecToTime(const ADateTime: TDateTime; const AMSec: Integer): TDateTime;
|
|
{$IFDEF HAS_UNIT_DateUtils}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ELSE}
|
|
var
|
|
LTM : TTimeStamp;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF HAS_UNIT_DateUtils}
|
|
Result := DateUtils.IncMilliSecond(ADateTime, AMSec);
|
|
{$ELSE}
|
|
LTM := DateTimeToTimeStamp(ADateTime);
|
|
LTM.Time := LTM.Time + AMSec;
|
|
Result := TimeStampToDateTime(LTM);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyFileAge(const AFileName: string): TDateTime;
|
|
{$IFDEF HAS_2PARAM_FileAge}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ELSE}
|
|
var
|
|
LAge: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF HAS_2PARAM_FileAge}
|
|
//single-parameter fileage is deprecated in d2006 and above
|
|
if not FileAge(AFileName, Result) then begin
|
|
Result := 0;
|
|
end;
|
|
{$ELSE}
|
|
LAge := SysUtils.FileAge(AFileName);
|
|
if LAge <> -1 then begin
|
|
Result := FileDateToDateTime(LAge);
|
|
end else begin
|
|
Result := 0.0;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyDirectoryExists(const ADirectory: string): Boolean;
|
|
{$IFDEF HAS_SysUtils_DirectoryExists}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ELSE}
|
|
var
|
|
Code: Integer;
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LStr: TIdPlatformString;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF HAS_SysUtils_DirectoryExists}
|
|
Result := SysUtils.DirectoryExists(ADirectory);
|
|
{$ELSE}
|
|
// RLebeau 2/16/2006: Removed dependency on the FileCtrl unit
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
:= TIdPlatformString(ADirectory); // explicit convert to Ansi/Unicode
|
|
Code := GetFileAttributes(PIdPlatformChar(LStr));
|
|
{$ELSE}
|
|
Code := GetFileAttributes(PChar(ADirectory));
|
|
{$ENDIF}
|
|
Result := (Code <> -1) and ((Code and FILE_ATTRIBUTE_DIRECTORY) <> 0);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyStrToInt64(const S: string; const ADefault: Int64): Int64;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := SysUtils.StrToInt64Def(Trim(S), ADefault);
|
|
end;
|
|
|
|
function IndyStrToInt64(const S: string): Int64;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := SysUtils.StrToInt64(Trim(S));
|
|
end;
|
|
|
|
function IndyStrToStreamSize(const S: string; const ADefault: TIdStreamSize): TIdStreamSize;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF STREAM_SIZE_64}
|
|
Result := IndyStrToInt64(S, ADefault);
|
|
{$ELSE}
|
|
Result := IndyStrToInt(S, ADefault);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyStrToStreamSize(const S: string): TIdStreamSize;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF STREAM_SIZE_64}
|
|
Result := IndyStrToInt64(S);
|
|
{$ELSE}
|
|
Result := IndyStrToInt(S);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ToBytes(const AValue: string; ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := ToBytes(AValue, -1, 1, ADestEncoding
|
|
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
|
|
);
|
|
end;
|
|
|
|
function ToBytes(const AValue: string; const ALength: Integer; const AIndex: Integer = 1;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): TIdBytes; overload;
|
|
var
|
|
LLength: Integer;
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LBytes: TIdBytes;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LBytes := nil; // keep the compiler happy
|
|
{$ENDIF}
|
|
LLength := IndyLength(AValue, ALength, AIndex);
|
|
if LLength > 0 then
|
|
begin
|
|
EnsureEncoding(ADestEncoding);
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
SetLength(Result, ADestEncoding.GetByteCount(AValue, AIndex, LLength));
|
|
if Length(Result) > 0 then begin
|
|
ADestEncoding.GetBytes(AValue, AIndex, LLength, Result, 0);
|
|
end;
|
|
{$ELSE}
|
|
EnsureEncoding(ASrcEncoding, encOSDefault);
|
|
LBytes := RawToBytes(AValue[AIndex], LLength);
|
|
CheckByteEncoding(LBytes, ASrcEncoding, ADestEncoding);
|
|
Result := LBytes;
|
|
{$ENDIF}
|
|
end else begin
|
|
SetLength(Result, 0);
|
|
end;
|
|
end;
|
|
|
|
function ToBytes(const AValue: Char; ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): TIdBytes; overload;
|
|
var
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
|
|
{$ELSE}
|
|
LBytes: TIdBytes;
|
|
{$ENDIF}
|
|
begin
|
|
EnsureEncoding(ADestEncoding);
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
{$IFNDEF DOTNET}
|
|
SetLength(LChars, 1);
|
|
{$ENDIF}
|
|
LChars[0] := AValue;
|
|
Result := ADestEncoding.GetBytes(LChars);
|
|
{$ELSE}
|
|
EnsureEncoding(ASrcEncoding, encOSDefault);
|
|
LBytes := RawToBytes(AValue, 1);
|
|
CheckByteEncoding(LBytes, ASrcEncoding, ADestEncoding);
|
|
Result := LBytes;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ToBytes(const AValue: Int64): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.GetBytes(AValue);
|
|
{$ELSE}
|
|
SetLength(Result, SizeOf(Int64));
|
|
PInt64(@Result[0])^ := AValue;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ToBytes(const AValue: TIdUInt64): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.GetBytes(AValue);
|
|
{$ELSE}
|
|
SetLength(Result, SizeOf(UInt64));
|
|
PUInt64(@Result[0])^ := AValue{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF};
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ToBytes(const AValue: Int32): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.GetBytes(AValue);
|
|
{$ELSE}
|
|
SetLength(Result, SizeOf(Int32));
|
|
PInt32(@Result[0])^ := AValue;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ToBytes(const AValue: UInt32): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.GetBytes(AValue);
|
|
{$ELSE}
|
|
SetLength(Result, SizeOf(UInt32));
|
|
PUInt32(@Result[0])^ := AValue;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ToBytes(const AValue: Int16): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.GetBytes(AValue);
|
|
{$ELSE}
|
|
SetLength(Result, SizeOf(Int16));
|
|
PInt16(@Result[0])^ := AValue;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ToBytes(const AValue: UInt16): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.GetBytes(AValue);
|
|
{$ELSE}
|
|
SetLength(Result, SizeOf(UInt16));
|
|
PUInt16(@Result[0])^ := AValue;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ToBytes(const AValue: Int8): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
SetLength(Result, SizeOf(Int8));
|
|
Result[0] := Byte(AValue);
|
|
end;
|
|
|
|
function ToBytes(const AValue: UInt8): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
SetLength(Result, SizeOf(UInt8));
|
|
Result[0] := AValue;
|
|
end;
|
|
|
|
function ToBytes(const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0): TIdBytes; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LSize: Integer;
|
|
begin
|
|
LSize := IndyLength(AValue, ASize, AIndex);
|
|
SetLength(Result, LSize);
|
|
if LSize > 0 then begin
|
|
CopyTIdBytes(AValue, AIndex, Result, 0, LSize);
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
function RawToBytes(const AValue; const ASize: Integer): TIdBytes;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
SetLength(Result, ASize);
|
|
if ASize > 0 then begin
|
|
Move(AValue, Result[0], ASize);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Char; ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
|
|
begin
|
|
EnsureEncoding(ADestEncoding);
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
{$IFNDEF DOTNET}
|
|
SetLength(LChars, 1);
|
|
{$ENDIF}
|
|
LChars[0] := AValue;
|
|
{$ELSE}
|
|
EnsureEncoding(ASrcEncoding, encOSDefault);
|
|
LChars := ASrcEncoding.GetChars(RawToBytes(AValue, 1)); // convert to Unicode
|
|
{$ENDIF}
|
|
Assert(Length(Bytes) >= ADestEncoding.GetByteCount(LChars));
|
|
ADestEncoding.GetBytes(LChars, 0, Length(LChars), Bytes, 0);
|
|
end;
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int32);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= SizeOf(AValue));
|
|
CopyTIdInt32(AValue, Bytes, 0);
|
|
end;
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int16);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= SizeOf(AValue));
|
|
CopyTIdInt16(AValue, Bytes, 0);
|
|
end;
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt16);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= SizeOf(AValue));
|
|
CopyTIdUInt16(AValue, Bytes, 0);
|
|
end;
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int8);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= SizeOf(AValue));
|
|
Bytes[0] := Byte(AValue);
|
|
end;
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt8);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= SizeOf(AValue));
|
|
Bytes[0] := AValue;
|
|
end;
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt32);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= SizeOf(AValue));
|
|
CopyTIdUInt32(AValue, Bytes, 0);
|
|
end;
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int64);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= SizeOf(AValue));
|
|
CopyTIdInt64(AValue, Bytes, 0);
|
|
end;
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdUInt64);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= SizeOf(AValue));
|
|
CopyTIdUInt64(AValue, Bytes, 0);
|
|
end;
|
|
|
|
procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= ASize);
|
|
CopyTIdBytes(AValue, AIndex, Bytes, 0, ASize);
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
procedure RawToBytesF(var Bytes: TIdBytes; const AValue; const ASize: Integer);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(Bytes) >= ASize);
|
|
if ASize > 0 then begin
|
|
Move(AValue, Bytes[0], ASize);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function BytesToChar(const AValue: TIdBytes; const AIndex: Integer = 0;
|
|
AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): Char; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
BytesToChar(AValue, Result, AIndex, AByteEncoding{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|
end;
|
|
|
|
function BytesToChar(const AValue: TIdBytes; var VChar: Char; const AIndex: Integer = 0;
|
|
AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): Integer; overload;
|
|
var
|
|
I, J, NumChars, NumBytes: Integer;
|
|
{$IFDEF DOTNET}
|
|
LChars: array[0..1] of Char;
|
|
{$ELSE}
|
|
LChars: TIdWideChars;
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LWTmp: WideString;
|
|
LATmp: TIdBytes;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
Result := 0;
|
|
EnsureEncoding(AByteEncoding);
|
|
// 2 Chars to handle UTF-16 surrogates
|
|
NumBytes := IndyMin(IndyLength(AValue, -1, AIndex), AByteEncoding.GetMaxByteCount(2));
|
|
{$IFNDEF DOTNET}
|
|
SetLength(LChars, 2);
|
|
{$ENDIF}
|
|
NumChars := 0;
|
|
if NumBytes > 0 then
|
|
begin
|
|
for I := 1 to NumBytes do
|
|
begin
|
|
NumChars := AByteEncoding.GetChars(AValue, AIndex, I, LChars, 0);
|
|
Inc(Result);
|
|
if NumChars > 0 then begin
|
|
// RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
|
|
// to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
|
|
// this loop! Since this is not commonly used, this was not noticed until
|
|
// now. On Windows at least, GetChars() now returns >0 for an invalid
|
|
// sequence, so we have to check if any of the returned characters are the
|
|
// Unicode U+FFFD character, indicating bad data...
|
|
for J := 0 to NumChars-1 do begin
|
|
if LChars[J] = TIdWideChar($FFFD) then begin
|
|
// keep reading...
|
|
NumChars := 0;
|
|
Break;
|
|
end;
|
|
end;
|
|
if NumChars > 0 then begin
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
// RLebeau: if the bytes were decoded into surrogates, the second
|
|
// surrogate is lost here, as it can't be returned unless we cache
|
|
// it somewhere for the the next BytesToChar() call to retreive. Just
|
|
// raise an error for now. Users will have to update their code to
|
|
// read surrogates differently...
|
|
Assert(NumChars = 1);
|
|
VChar := LChars[0];
|
|
{$ELSE}
|
|
// RLebeau: since we can only return an AnsiChar here, let's convert
|
|
// the decoded characters, surrogates and all, into their Ansi
|
|
// representation. This will have the same problem as above if the
|
|
// conversion results in a multibyte character sequence...
|
|
EnsureEncoding(ADestEncoding, encOSDefault);
|
|
SetString(LWTmp, PWideChar(LChars), NumChars);
|
|
LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
|
|
Assert(Length(LATmp) = 1);
|
|
VChar := Char(LATmp[0]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function BytesToInt32(const AValue: TIdBytes; const AIndex: Integer = 0): Int32;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(AValue) >= (AIndex+SizeOf(Int32)));
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.ToInt32(AValue, AIndex);
|
|
{$ELSE}
|
|
Result := PInt32(@AValue[AIndex])^;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function BytesToLongInt(const AValue: TIdBytes; const AIndex: Integer = 0): Integer;
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := BytesToInt32(AValue, AIndex);
|
|
end;
|
|
|
|
function BytesToInt64(const AValue: TIdBytes; const AIndex: Integer = 0): Int64;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(AValue) >= (AIndex+SizeOf(Int64)));
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.ToInt64(AValue, AIndex);
|
|
{$ELSE}
|
|
Result := PInt64(@AValue[AIndex])^;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function BytesToUInt64(const AValue: TIdBytes; const AIndex: Integer = 0): TIdUInt64;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(AValue) >= (AIndex+SizeOf(TIdUInt64)));
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.ToUInt64(AValue, AIndex);
|
|
{$ELSE}
|
|
Result{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF} := PUInt64(@AValue[AIndex])^;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function BytesToTicks(const AValue: TIdBytes; const AIndex: Integer = 0): TIdTicks;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF UInt64_IS_NATIVE}
|
|
Result := BytesToUInt64(AValue, AIndex);
|
|
{$ELSE}
|
|
Result := BytesToInt64(AValue, AIndex);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function BytesToUInt16(const AValue: TIdBytes; const AIndex: Integer = 0): UInt16;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(AValue) >= (AIndex+SizeOf(UInt16)));
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.ToUInt16(AValue, AIndex);
|
|
{$ELSE}
|
|
Result := PUInt16(@AValue[AIndex])^;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function BytesToWord(const AValue: TIdBytes; const AIndex: Integer = 0): UInt16;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := BytesToUInt16(AValue, AIndex);
|
|
end;
|
|
|
|
function BytesToInt16(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(AValue) >= (AIndex+SizeOf(Int16)));
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.ToInt16(AValue, AIndex);
|
|
{$ELSE}
|
|
Result := PInt16(@AValue[AIndex])^;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function BytesToShort(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := BytesToInt16(AValue, AIndex);
|
|
end;
|
|
|
|
function BytesToIPv4Str(const AValue: TIdBytes; const AIndex: Integer = 0): String;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(AValue) >= (AIndex+4));
|
|
Result := IntToStr(Ord(AValue[AIndex])) + '.' +
|
|
IntToStr(Ord(AValue[AIndex+1])) + '.' +
|
|
IntToStr(Ord(AValue[AIndex+2])) + '.' +
|
|
IntToStr(Ord(AValue[AIndex+3]));
|
|
end;
|
|
|
|
procedure BytesToIPv6(const AValue: TIdBytes; var VAddress: TIdIPv6Address; const AIndex: Integer = 0);
|
|
{$IFDEF DOTNET}
|
|
var
|
|
I: Integer;
|
|
{$ELSE}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
Assert(Length(AValue) >= (AIndex+16));
|
|
{$IFDEF DOTNET}
|
|
for i := 0 to 7 do begin
|
|
VAddress[i] := TwoByteToUInt16(AValue[(i*2)+AIndex], AValue[(i*2)+1+AIndex]);
|
|
end;
|
|
{$ELSE}
|
|
Move(AValue[AIndex], VAddress[0], 16);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function BytesToUInt32(const AValue: TIdBytes; const AIndex: Integer = 0): UInt32;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(AValue) >= (AIndex+SizeOf(UInt32)));
|
|
{$IFDEF DOTNET}
|
|
Result := System.BitConverter.ToUInt32(AValue, AIndex);
|
|
{$ELSE}
|
|
Result := PUInt32(@AValue[AIndex])^;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function BytesToLongWord(const AValue: TIdBytes; const AIndex: Integer = 0): UInt32;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := BytesToUInt32(AValue, AIndex);
|
|
end;
|
|
|
|
function BytesToString(const AValue: TIdBytes; AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): string; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := BytesToString(AValue, 0, -1, AByteEncoding
|
|
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
|
|
);
|
|
end;
|
|
|
|
function BytesToString(const AValue: TIdBytes; const AStartIndex: Integer;
|
|
const ALength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): string; overload;
|
|
var
|
|
LLength: Integer;
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LBytes: TIdBytes;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LBytes := nil; // keep the compiler happy
|
|
{$ENDIF}
|
|
LLength := IndyLength(AValue, ALength, AStartIndex);
|
|
if LLength > 0 then begin
|
|
EnsureEncoding(AByteEncoding);
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
Result := AByteEncoding.GetString(AValue, AStartIndex, LLength);
|
|
{$ELSE}
|
|
EnsureEncoding(ADestEncoding);
|
|
if (AStartIndex = 0) and (LLength = Length(AValue)) then begin
|
|
LBytes := AValue;
|
|
end else begin
|
|
LBytes := Copy(AValue, AStartIndex, LLength);
|
|
end;
|
|
CheckByteEncoding(LBytes, AByteEncoding, ADestEncoding);
|
|
SetString(Result, PAnsiChar(LBytes), Length(LBytes));
|
|
{$ENDIF}
|
|
end else begin
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
function BytesToStringRaw(const AValue: TIdBytes): string; overload;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := BytesToStringRaw(AValue, 0, -1);
|
|
end;
|
|
|
|
function BytesToStringRaw(const AValue: TIdBytes; const AStartIndex: Integer;
|
|
const ALength: Integer = -1): string;
|
|
var
|
|
LLength: Integer;
|
|
begin
|
|
LLength := IndyLength(AValue, ALength, AStartIndex);
|
|
if LLength > 0 then begin
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
Result := IndyTextEncoding_8Bit.GetString(AValue, AStartIndex, LLength);
|
|
{$ELSE}
|
|
SetString(Result, PAnsiChar(@AValue[AStartIndex]), LLength);
|
|
{$ENDIF}
|
|
end else begin
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
procedure BytesToRaw(const AValue: TIdBytes; var VBuffer; const ASize: Integer);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Assert(Length(AValue) >= ASize);
|
|
Move(AValue[0], VBuffer, ASize);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TwoByteToUInt16(AByte1, AByte2: Byte): UInt16;
|
|
//Since Replys are returned as Strings, we need a routine 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] := AByte1;
|
|
LWord[1] := AByte2;
|
|
Result := BytesToUInt16(LWord);
|
|
// Result := UInt16((AByte1 shl 8) and $FF00) or UInt16(AByte2 and $00FF);
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function TwoByteToWord(AByte1, AByte2: Byte): UInt16;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := TwoByteToUInt16(AByte1, AByte2);
|
|
end;
|
|
|
|
function ReadStringFromStream(AStream: TStream; ASize: Integer = -1;
|
|
AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): string;
|
|
var
|
|
LBytes: TIdBytes;
|
|
begin
|
|
ASize := TIdStreamHelper.ReadBytes(AStream, LBytes, ASize);
|
|
Result := BytesToString(LBytes, 0, ASize, AByteEncoding
|
|
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
|
|
);
|
|
end;
|
|
|
|
function ReadTIdBytesFromStream(const AStream: TStream; var ABytes: TIdBytes;
|
|
const Count: TIdStreamSize; const AIndex: Integer = 0): TIdStreamSize;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := TIdStreamHelper.ReadBytes(AStream, ABytes, Count, AIndex);
|
|
end;
|
|
|
|
function ReadCharFromStream(AStream: TStream; var VChar: Char;
|
|
AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): Integer;
|
|
var
|
|
StartPos: TIdStreamSize;
|
|
Lb: Byte;
|
|
I, NumChars, NumBytes: Integer;
|
|
LBytes: TIdBytes;
|
|
{$IFDEF DOTNET}
|
|
LChars: array[0..1] of Char;
|
|
{$ELSE}
|
|
LChars: TIdWideChars;
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LWTmp: WideString;
|
|
LATmp: TIdBytes;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function ReadByte: Byte;
|
|
begin
|
|
if AStream.Read(Result{$IFNDEF DOTNET}, 1{$ENDIF}) <> 1 then begin
|
|
raise EIdException.Create('Unable to read byte'); {do not localize}
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := 0;
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LATmp := nil; // keep the compiler happy
|
|
{$ENDIF}
|
|
|
|
EnsureEncoding(AByteEncoding);
|
|
StartPos := AStream.Position;
|
|
|
|
// don't raise an exception here, backwards compatibility for now
|
|
if AStream.Read(Lb{$IFNDEF DOTNET}, 1{$ENDIF}) <> 1 then begin
|
|
Exit;
|
|
end;
|
|
Result := 1;
|
|
|
|
// 2 Chars to handle UTF-16 surrogates
|
|
NumBytes := AByteEncoding.GetMaxByteCount(2);
|
|
SetLength(LBytes, NumBytes);
|
|
{$IFNDEF DOTNET}
|
|
SetLength(LChars, 2);
|
|
{$ENDIF}
|
|
|
|
try
|
|
repeat
|
|
LBytes[Result-1] := Lb;
|
|
NumChars := AByteEncoding.GetChars(LBytes, 0, Result, LChars, 0);
|
|
if NumChars > 0 then begin
|
|
// RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
|
|
// to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
|
|
// this loop! Since this is not commonly used, this was not noticed until
|
|
// now. On Windows at least, GetChars() now returns >0 for an invalid
|
|
// sequence, so we have to check if any of the returned characters are the
|
|
// Unicode U+FFFD character, indicating bad data...
|
|
for I := 0 to NumChars-1 do begin
|
|
if LChars[I] = TIdWideChar($FFFD) then begin
|
|
// keep reading...
|
|
NumChars := 0;
|
|
Break;
|
|
end;
|
|
end;
|
|
if NumChars > 0 then begin
|
|
Break;
|
|
end;
|
|
end;
|
|
if Result = NumBytes then begin
|
|
Break;
|
|
end;
|
|
Lb := ReadByte;
|
|
Inc(Result);
|
|
until False;
|
|
except
|
|
AStream.Position := StartPos;
|
|
raise;
|
|
end;
|
|
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
// RLebeau: if the bytes were decoded into surrogates, the second
|
|
// surrogate is lost here, as it can't be returned unless we cache
|
|
// it somewhere for the the next ReadTIdBytesFromStream() call to
|
|
// retreive. Just raise an error for now. Users will have to
|
|
// update their code to read surrogates differently...
|
|
Assert(NumChars = 1);
|
|
VChar := LChars[0];
|
|
{$ELSE}
|
|
// RLebeau: since we can only return an AnsiChar here, let's convert
|
|
// the decoded characters, surrogates and all, into their Ansi
|
|
// representation. This will have the same problem as above if the
|
|
// conversion results in a multibyte character sequence...
|
|
EnsureEncoding(ADestEncoding, encOSDefault);
|
|
SetString(LWTmp, PWideChar(LChars), NumChars);
|
|
LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
|
|
Assert(Length(LATmp) = 1);
|
|
VChar := Char(LATmp[0]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure WriteTIdBytesToStream(const AStream: TStream; const ABytes: TIdBytes;
|
|
const ASize: Integer = -1; const AIndex: Integer = 0);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
TIdStreamHelper.Write(AStream, ABytes, ASize, AIndex);
|
|
end;
|
|
|
|
procedure WriteStringToStream(AStream: TStream; const AStr: string;
|
|
ADestEncoding: IIdTextEncoding
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
WriteStringToStream(AStream, AStr, -1, 1, ADestEncoding
|
|
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
|
|
);
|
|
end;
|
|
|
|
procedure WriteStringToStream(AStream: TStream; const AStr: string;
|
|
const ALength: Integer = -1; const AIndex: Integer = 1;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
LLength: Integer;
|
|
LBytes: TIdBytes;
|
|
begin
|
|
LBytes := nil;
|
|
LLength := IndyLength(AStr, ALength, AIndex);
|
|
if LLength > 0 then
|
|
begin
|
|
LBytes := ToBytes(AStr, LLength, AIndex, ADestEncoding
|
|
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
|
|
);
|
|
TIdStreamHelper.Write(AStream, LBytes);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF DOTNET}
|
|
function TIdBaseStream.Read(var VBuffer: array of Byte; AOffset, ACount: Longint): Longint;
|
|
var
|
|
LBytes: TIdBytes;
|
|
begin
|
|
// this is a silly work around really, but array of Byte and TIdByte aren't
|
|
// interchangable in a var parameter, though really they *should be*
|
|
SetLength(LBytes, ACount - AOffset);
|
|
Result := IdRead(LBytes, 0, ACount - AOffset);
|
|
CopyTIdByteArray(LBytes, 0, VBuffer, AOffset, Result);
|
|
end;
|
|
|
|
function TIdBaseStream.Write(const ABuffer: array of Byte; AOffset, ACount: Longint): Longint;
|
|
begin
|
|
Result := IdWrite(ABuffer, AOffset, ACount);
|
|
end;
|
|
|
|
function TIdBaseStream.Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
|
|
begin
|
|
Result := IdSeek(AOffset, AOrigin);
|
|
end;
|
|
|
|
procedure TIdBaseStream.SetSize(ASize: Int64);
|
|
begin
|
|
IdSetSize(ASize);
|
|
end;
|
|
|
|
{$ELSE}
|
|
|
|
{$IFDEF STREAM_SIZE_64}
|
|
procedure TIdBaseStream.SetSize(const NewSize: Int64);
|
|
begin
|
|
IdSetSize(NewSize);
|
|
end;
|
|
{$ELSE}
|
|
procedure TIdBaseStream.SetSize(ASize: Integer);
|
|
begin
|
|
IdSetSize(ASize);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TIdBaseStream.Read(var Buffer; Count: Longint): Longint;
|
|
var
|
|
LBytes: TIdBytes;
|
|
begin
|
|
SetLength(LBytes, Count);
|
|
Result := IdRead(LBytes, 0, Count);
|
|
if Result > 0 then begin
|
|
Move(LBytes[0], Buffer, Result);
|
|
end;
|
|
end;
|
|
|
|
function TIdBaseStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
if Count > 0 then begin
|
|
Result := IdWrite(RawToBytes(Buffer, Count), 0, Count);
|
|
end else begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF STREAM_SIZE_64}
|
|
function TIdBaseStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
begin
|
|
Result := IdSeek(Offset, Origin);
|
|
end;
|
|
{$ELSE}
|
|
function TIdBaseStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
var
|
|
LSeek : TSeekOrigin;
|
|
begin
|
|
case Origin of
|
|
soFromBeginning : LSeek := soBeginning;
|
|
soFromCurrent : LSeek := soCurrent;
|
|
soFromEnd : LSeek := soEnd;
|
|
else
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
Result := IdSeek(Offset, LSeek) and $FFFFFFFF;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$ENDIF}
|
|
|
|
function TIdCalculateSizeStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TIdCalculateSizeStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := IndyLength(ABuffer, ACount, AOffset);
|
|
if I > 0 then begin
|
|
Inc(FPosition, I);
|
|
if FPosition > FSize then begin
|
|
FSize := FPosition;
|
|
end;
|
|
end;
|
|
Result := I;
|
|
end;
|
|
|
|
function TIdCalculateSizeStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
|
|
begin
|
|
case AOrigin of
|
|
soBeginning: begin
|
|
FPosition := AOffset;
|
|
end;
|
|
soCurrent: begin
|
|
FPosition := FPosition + AOffset;
|
|
end;
|
|
soEnd: begin
|
|
FPosition := FSize + AOffset;
|
|
end;
|
|
end;
|
|
if FPosition < 0 then begin
|
|
FPosition := 0;
|
|
end;
|
|
Result := FPosition;
|
|
end;
|
|
|
|
procedure TIdCalculateSizeStream.IdSetSize(ASize: Int64);
|
|
begin
|
|
if ASize < 0 then begin
|
|
ASize := 0;
|
|
end;
|
|
if FSize <> ASize then begin
|
|
FSize := ASize;
|
|
if FSize < FPosition then begin
|
|
FPosition := FSize;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TIdEventStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
|
|
begin
|
|
Result := 0;
|
|
if Assigned(FOnRead) then begin
|
|
FOnRead(VBuffer, AOffset, ACount, Result);
|
|
end;
|
|
end;
|
|
|
|
function TIdEventStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
|
|
begin
|
|
if Assigned(FOnWrite) then begin
|
|
Result := 0;
|
|
FOnWrite(ABuffer, AOffset, ACount, Result);
|
|
end else begin
|
|
Result := ACount;
|
|
end;
|
|
end;
|
|
|
|
function TIdEventStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
|
|
begin
|
|
Result := 0;
|
|
if Assigned(FOnSeek) then begin
|
|
FOnSeek(AOffset, AOrigin, Result);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdEventStream.IdSetSize(ASize: Int64);
|
|
begin
|
|
if Assigned(FOnSetSize) then begin
|
|
FOnSetSize(ASize);
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
constructor TIdMemoryBufferStream.Create(APtr: Pointer; ASize: TIdNativeInt);
|
|
begin
|
|
inherited Create;
|
|
SetPointer(APtr, ASize);
|
|
end;
|
|
|
|
function TIdMemoryBufferStream.Write(const Buffer; Count: Longint): Longint;
|
|
var
|
|
LNumToCopy: Longint;
|
|
begin
|
|
Result := 0;
|
|
if (Position >= 0) and (Size > 0) and (Count > 0) then
|
|
begin
|
|
LNumToCopy := IndyMin(Size - Position, Count);
|
|
if LNumToCopy > 0 then
|
|
begin
|
|
System.Move(Buffer, Pointer(PtrUInt(Memory) + Position)^, LNumToCopy);
|
|
TIdStreamHelper.Seek(Self, LNumToCopy, soCurrent);
|
|
Result := LNumToCopy;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure AppendBytes(var VBytes: TIdBytes; const AToAdd: TIdBytes; const AIndex: Integer = 0; const ALength: Integer = -1);
|
|
var
|
|
LOldLen, LAddLen: Integer;
|
|
begin
|
|
LAddLen := IndyLength(AToAdd, ALength, AIndex);
|
|
if LAddLen > 0 then begin
|
|
LOldLen := Length(VBytes);
|
|
SetLength(VBytes, LOldLen + LAddLen);
|
|
CopyTIdBytes(AToAdd, AIndex, VBytes, LOldLen, LAddLen);
|
|
end;
|
|
end;
|
|
|
|
procedure AppendByte(var VBytes: TIdBytes; const AByte: Byte);
|
|
var
|
|
LOldLen: Integer;
|
|
begin
|
|
LOldLen := Length(VBytes);
|
|
SetLength(VBytes, LOldLen + 1);
|
|
VBytes[LOldLen] := AByte;
|
|
end;
|
|
|
|
procedure AppendString(var VBytes: TIdBytes; const AStr: String; const ALength: Integer = -1;
|
|
ADestEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
);
|
|
var
|
|
LBytes: TIdBytes;
|
|
LLength, LOldLen: Integer;
|
|
begin
|
|
LBytes := nil; // keep the compiler happy
|
|
LLength := IndyLength(AStr, ALength);
|
|
if LLength > 0 then begin
|
|
LBytes := ToBytes(AStr, LLength, 1, ADestEncoding
|
|
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
|
|
);
|
|
LOldLen := Length(VBytes);
|
|
LLength := Length(LBytes);
|
|
SetLength(VBytes, LOldLen + LLength);
|
|
CopyTIdBytes(LBytes, 0, VBytes, LOldLen, LLength);
|
|
end;
|
|
end;
|
|
|
|
procedure ExpandBytes(var VBytes: TIdBytes; const AIndex: Integer; const ACount: Integer; const AFillByte: Byte = 0);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if ACount > 0 then begin
|
|
// if AIndex is at the end of the buffer then the operation is appending bytes
|
|
if AIndex <> Length(VBytes) then begin
|
|
//if these asserts fail, then it indicates an attempted buffer overrun.
|
|
Assert(AIndex >= 0);
|
|
Assert(AIndex < Length(VBytes));
|
|
end;
|
|
SetLength(VBytes, Length(VBytes) + ACount);
|
|
// move any existing bytes at the index to the end of the buffer
|
|
for I := Length(VBytes)-1 downto AIndex+ACount do begin
|
|
VBytes[I] := VBytes[I-ACount];
|
|
end;
|
|
// fill in the new space with the fill byte
|
|
for I := AIndex to AIndex+ACount-1 do begin
|
|
VBytes[I] := AFillByte;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure InsertBytes(var VBytes: TIdBytes; const ADestIndex: Integer;
|
|
const ASource: TIdBytes; const ASourceIndex: Integer = 0);
|
|
var
|
|
LAddLen: Integer;
|
|
begin
|
|
LAddLen := IndyLength(ASource, -1, ASourceIndex);
|
|
if LAddLen > 0 then begin
|
|
ExpandBytes(VBytes, ADestIndex, LAddLen);
|
|
CopyTIdBytes(ASource, ASourceIndex, VBytes, ADestIndex, LAddLen);
|
|
end;
|
|
end;
|
|
|
|
procedure InsertByte(var VBytes: TIdBytes; const AByte: Byte; const AIndex: Integer);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
ExpandBytes(VBytes, AIndex, 1, AByte);
|
|
end;
|
|
|
|
procedure RemoveBytes(var VBytes: TIdBytes; const ACount: Integer; const AIndex: Integer = 0);
|
|
var
|
|
I: Integer;
|
|
LActual: Integer;
|
|
begin
|
|
Assert(AIndex >= 0);
|
|
LActual := IndyMin(Length(VBytes)-AIndex, ACount);
|
|
if LActual > 0 then begin
|
|
if (AIndex + LActual) < Length(VBytes) then begin
|
|
// RLebeau: TODO - use Move() here instead?
|
|
for I := AIndex to Length(VBytes)-LActual-1 do begin
|
|
VBytes[I] := VBytes[I+LActual];
|
|
end;
|
|
end;
|
|
SetLength(VBytes, Length(VBytes)-LActual);
|
|
end;
|
|
end;
|
|
|
|
procedure IdDelete(var s: string; AOffset, ACount: Integer);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Delete(s, AOffset, ACount);
|
|
end;
|
|
|
|
procedure IdInsert(const Source: string; var S: string; Index: Integer);
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Insert(Source, S, Index);
|
|
end;
|
|
|
|
function TextIsSame(const A1, A2: string): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.String.Compare(A1, A2, True) = 0;
|
|
{$ELSE}
|
|
Result := AnsiCompareText(A1, A2) = 0;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TextStartsWith(const S, SubS: string): Boolean;
|
|
var
|
|
LLen: Integer;
|
|
{$IFDEF WINDOWS}
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LS, LSub: TIdPlatformString;
|
|
P1, P2: PIdPlatformChar;
|
|
{$ELSE}
|
|
P1, P2: PChar;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
LLen := Length(SubS);
|
|
Result := LLen <= Length(S);
|
|
if Result then
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.String.Compare(S, 0, SubS, 0, LLen, True) = 0;
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
// explicit convert to Ansi/Unicode
|
|
LS := TIdPlatformString(S);
|
|
LSub := TIdPlatformString(SubS);
|
|
P1 := PIdPlatformChar(LS);
|
|
P2 := PIdPlatformChar(LSub);
|
|
{$ELSE}
|
|
P1 := PChar(S);
|
|
P2 := PChar(SubS);
|
|
{$ENDIF}
|
|
Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
|
|
{$ELSE}
|
|
Result := AnsiCompareText(Copy(S, 1, LLen), SubS) = 0;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TextEndsWith(const S, SubS: string): Boolean;
|
|
var
|
|
LLen: Integer;
|
|
{$IFDEF WINDOWS}
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LS, LSubS: TIdPlatformString;
|
|
P1, P2: PIdPlatformChar;
|
|
{$ELSE}
|
|
P1, P2: PChar;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
LLen := Length(SubS);
|
|
Result := LLen <= Length(S);
|
|
if Result then
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := System.String.Compare(S, Length(S)-LLen, SubS, 0, LLen, True) = 0;
|
|
{$ELSE}
|
|
{$IFDEF WINDOWS}
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
// explicit convert to Ansi/Unicode
|
|
LS := TIdPlatformString(S);
|
|
LSubS := TIdPlatformString(SubS);
|
|
P1 := PIdPlatformChar(LS);
|
|
P2 := PIdPlatformChar(LSubS);
|
|
{$ELSE}
|
|
P1 := PChar(S);
|
|
P2 := PChar(SubS);
|
|
{$ENDIF}
|
|
Inc(P1, Length(S)-LLen);
|
|
Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
|
|
{$ELSE}
|
|
Result := AnsiCompareText(Copy(S, Length(S)-LLen+1, LLen), SubS) = 0;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function IndyLowerCase(const A1: string): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := A1.ToLower;
|
|
{$ELSE}
|
|
Result := AnsiLowerCase(A1);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyUpperCase(const A1: string): string;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := A1.ToUpper;
|
|
{$ELSE}
|
|
Result := AnsiUpperCase(A1);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyCompareStr(const A1, A2: string): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
Result := CompareStr(A1, A2);
|
|
{$ELSE}
|
|
Result := AnsiCompareStr(A1, A2);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function CharPosInSet(const AString: string; const ACharPos: Integer; const ASet: String): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFNDEF DOTNET}
|
|
var
|
|
LChar: Char;
|
|
I: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
Result := 0;
|
|
if ACharPos < 1 then begin
|
|
raise EIdException.Create('Invalid ACharPos');{ do not localize }
|
|
end;
|
|
if ACharPos <= Length(AString) then begin
|
|
{$IFDEF DOTNET}
|
|
Result := ASet.IndexOf(AString[ACharPos]) + 1;
|
|
{$ELSE}
|
|
// RLebeau 5/8/08: Calling Pos() with a Char as input creates a temporary
|
|
// String. Normally this is fine, but profiling reveils this to be a big
|
|
// bottleneck for code that makes a lot of calls to CharIsInSet(), so need
|
|
// to scan through ASet looking for the character without a conversion...
|
|
//
|
|
// Result := IndyPos(AString[ACharPos], ASet);
|
|
//
|
|
LChar := AString[ACharPos];
|
|
for I := 1 to Length(ASet) do begin
|
|
if ASet[I] = LChar then begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function CharIsInSet(const AString: string; const ACharPos: Integer; const ASet: String): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := CharPosInSet(AString, ACharPos, ASet) > 0;
|
|
end;
|
|
|
|
function CharIsInEOL(const AString: string; const ACharPos: Integer): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := CharPosInSet(AString, ACharPos, EOL) > 0;
|
|
end;
|
|
|
|
function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if ACharPos < 1 then begin
|
|
raise EIdException.Create('Invalid ACharPos');{ do not localize }
|
|
end;
|
|
Result := ACharPos <= Length(AString);
|
|
if Result then begin
|
|
Result := AString[ACharPos] = AValue;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|
|
|
{$IFDEF DOTNET}
|
|
{$DEFINE HAS_String_IndexOf}
|
|
{$ENDIF}
|
|
{$IFDEF HAS_SysUtils_TStringHelper}
|
|
{$DEFINE HAS_String_IndexOf}
|
|
{$ENDIF}
|
|
|
|
function CharPosInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
{$IFNDEF HAS_String_IndexOf}
|
|
var
|
|
LChar: Char;
|
|
I: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
Result := 0;
|
|
if ACharPos < 1 then begin
|
|
raise EIdException.Create('Invalid ACharPos');{ do not localize }
|
|
end;
|
|
if ACharPos <= ASB.Length then begin
|
|
{$IFDEF HAS_String_IndexOf}
|
|
Result := ASet.IndexOf(ASB[ACharPos-1]) + 1;
|
|
{$ELSE}
|
|
// RLebeau 5/8/08: Calling Pos() with a Char as input creates a temporary
|
|
// String. Normally this is fine, but profiling reveils this to be a big
|
|
// bottleneck for code that makes a lot of calls to CharIsInSet(), so need
|
|
// to scan through ASet looking for the character without a conversion...
|
|
//
|
|
// Result := IndyPos(ASB[ACharPos-1], ASet);
|
|
//
|
|
LChar := ASB[ACharPos-1];
|
|
for I := 1 to Length(ASet) do begin
|
|
if ASet[I] = LChar then begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function CharIsInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := CharPosInSet(ASB, ACharPos, ASet) > 0;
|
|
end;
|
|
|
|
function CharIsInEOL(const ASB: TIdStringBuilder; const ACharPos: Integer): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := CharPosInSet(ASB, ACharPos, EOL) > 0;
|
|
end;
|
|
|
|
function CharEquals(const ASB: TIdStringBuilder; const ACharPos: Integer; const AValue: Char): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if ACharPos < 1 then begin
|
|
raise EIdException.Create('Invalid ACharPos');{ do not localize }
|
|
end;
|
|
Result := ACharPos <= ASB.Length;
|
|
if Result then begin
|
|
Result := ASB[ACharPos-1] = AValue;
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
function ByteIndex(const AByte: Byte; const ABytes: TIdBytes; const AStartIndex: Integer = 0): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := -1;
|
|
for I := AStartIndex to Length(ABytes)-1 do begin
|
|
if ABytes[I] = AByte then begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ByteIdxInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
if AIndex < 0 then begin
|
|
raise EIdException.Create('Invalid AIndex'); {do not localize}
|
|
end;
|
|
if AIndex < Length(ABytes) then begin
|
|
Result := ByteIndex(ABytes[AIndex], ASet);
|
|
end else begin
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function ByteIsInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := ByteIdxInSet(ABytes, AIndex, ASet) > -1;
|
|
end;
|
|
|
|
function ByteIsInEOL(const ABytes: TIdBytes; const AIndex: Integer): Boolean;
|
|
var
|
|
LSet: TIdBytes;
|
|
begin
|
|
SetLength(LSet, 2);
|
|
LSet[0] := 13;
|
|
LSet[1] := 10;
|
|
Result := ByteIsInSet(ABytes, AIndex, LSet);
|
|
end;
|
|
|
|
function ReadLnFromStream(AStream: TStream; AMaxLineLength: Integer = -1;
|
|
AExceptionIfEOF: Boolean = False; AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): string; overload;
|
|
begin
|
|
if (not ReadLnFromStream(AStream, Result, AMaxLineLength, AByteEncoding
|
|
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
|
|
)) and AExceptionIfEOF then
|
|
begin
|
|
raise EIdEndOfStream.CreateFmt(RSEndOfStream, ['ReadLnFromStream', AStream.Position]);
|
|
end;
|
|
end;
|
|
|
|
//TODO: Continue to optimize this function. Its performance severely impacts the coders
|
|
function ReadLnFromStream(AStream: TStream; var VLine: String; AMaxLineLength: Integer = -1;
|
|
AByteEncoding: IIdTextEncoding = nil
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|
): Boolean; overload;
|
|
const
|
|
LBUFMAXSIZE = 2048;
|
|
var
|
|
LStringLen, LResultLen, LBufSize: Integer;
|
|
LBuf: TIdBytes;
|
|
LLine: TIdBytes;
|
|
// LBuf: packed array [0..LBUFMAXSIZE] of Char;
|
|
LStrmPos, LStrmSize: TIdStreamSize; //LBytesToRead = stream size - Position
|
|
LCrEncountered: Boolean;
|
|
|
|
function FindEOL(const ABuf: TIdBytes; var VLineBufSize: Integer; var VCrEncountered: Boolean): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := VLineBufSize; //EOL not found => use all
|
|
i := 0;
|
|
while i < VLineBufSize do begin
|
|
case ABuf[i] of
|
|
Ord(LF): begin
|
|
Result := i; {string size}
|
|
VCrEncountered := True;
|
|
VLineBufSize := i+1;
|
|
Break;
|
|
end;
|
|
Ord(CR): begin
|
|
Result := i; {string size}
|
|
VCrEncountered := True;
|
|
Inc(i); //crLF?
|
|
if (i < VLineBufSize) and (ABuf[i] = Ord(LF)) then begin
|
|
VLineBufSize := i+1;
|
|
end else begin
|
|
VLineBufSize := i;
|
|
end;
|
|
Break;
|
|
end;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Assert(AStream<>nil);
|
|
VLine := '';
|
|
SetLength(LLine, 0);
|
|
|
|
if AMaxLineLength < 0 then begin
|
|
AMaxLineLength := MaxInt;
|
|
end;
|
|
|
|
{ we store the stream size for the whole routine to prevent
|
|
so do not incur a performance penalty with TStream.Size. It has
|
|
to use something such as Seek each time the size is obtained}
|
|
{4 seek vs 3 seek}
|
|
LStrmPos := AStream.Position;
|
|
LStrmSize := AStream.Size;
|
|
|
|
if LStrmPos >= LStrmSize then begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
SetLength(LBuf, LBUFMAXSIZE);
|
|
LCrEncountered := False;
|
|
|
|
repeat
|
|
LBufSize := ReadTIdBytesFromStream(AStream, LBuf, IndyMin(LStrmSize - LStrmPos, LBUFMAXSIZE));
|
|
if LBufSize < 1 then begin
|
|
Break; // TODO: throw a stream read exception instead?
|
|
end;
|
|
|
|
LStringLen := FindEOL(LBuf, LBufSize, LCrEncountered);
|
|
Inc(LStrmPos, LBufSize);
|
|
|
|
LResultLen := Length(VLine);
|
|
if (LResultLen + LStringLen) > AMaxLineLength then begin
|
|
LStringLen := AMaxLineLength - LResultLen;
|
|
LCrEncountered := True;
|
|
Dec(LStrmPos, LBufSize);
|
|
Inc(LStrmPos, LStringLen);
|
|
end;
|
|
if LStringLen > 0 then begin
|
|
LBufSize := Length(LLine);
|
|
SetLength(LLine, LBufSize+LStringLen);
|
|
CopyTIdBytes(LBuf, 0, LLine, LBufSize, LStringLen);
|
|
end;
|
|
until (LStrmPos >= LStrmSize) or LCrEncountered;
|
|
|
|
// RLebeau: why is the original Position being restored here, instead
|
|
// of leaving the Position at the end of the line?
|
|
AStream.Position := LStrmPos;
|
|
VLine := BytesToString(LLine, 0, -1, AByteEncoding
|
|
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
|
|
);
|
|
Result := True;
|
|
end;
|
|
|
|
{$IFNDEF DOTNET}
|
|
{$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
|
|
function IndyRegisterExpectedMemoryLeak(AAddress: Pointer): Boolean;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
// TODO: use only System.RegisterExpectedMemoryLeak() on systems that support
|
|
// it. We should use whatever the RTL's active memory manager is. Fallback
|
|
// to specific memory managers only if System.RegisterExpectedMemoryLeak()
|
|
// is not available.
|
|
|
|
{$IFDEF USE_FASTMM4}
|
|
// RLebeau 4/9/2009: the user can override the RTL's version of FastMM
|
|
// (2006+ only) with the full version of FastMM in order to enable
|
|
// advanced debugging features, so check for that first...
|
|
Result := FastMM4.RegisterExpectedMemoryLeak(AAddress);
|
|
{$ELSE}
|
|
{$IFDEF USE_MADEXCEPT}
|
|
// RLebeau 10/5/2014: the user can override the RTL's version of FastMM
|
|
// (2006+ only) with any memory manager, such as MadExcept, so check for
|
|
// that next...
|
|
Result := madExcept.HideLeak(AAddress);
|
|
{$ELSE}
|
|
{$IFDEF HAS_System_RegisterExpectedMemoryLeak}
|
|
// RLebeau 4/21/08: not quite sure what the difference is between the
|
|
// SysRegisterExpectedMemoryLeak() and RegisterExpectedMemoryLeak()
|
|
// functions in the System unit, but calling RegisterExpectedMemoryLeak()
|
|
// is causing stack overflows when FastMM is not active, so call
|
|
// SysRegisterExpectedMemoryLeak() instead...
|
|
|
|
// RLebeau 7/4/09: According to Pierre Le Riche, developer of FastMM:
|
|
//
|
|
// "SysRegisterExpectedMemoryLeak() is the leak registration routine for
|
|
// the built-in memory manager. FastMM.RegisterExpectedMemoryLeak is the
|
|
// leak registration code for FastMM. Both of these are thus hardwired to
|
|
// a specific memory manager. In order to register a leak for the
|
|
// *currently installed* memory manager, which is what you typically want
|
|
// to do, you have to call System.RegisterExpectedMemoryLeak().
|
|
// System.RegisterExpectedMemoryLeak() redirects to the leak registration
|
|
// code of the installed memory manager."
|
|
|
|
//Result := System.SysRegisterExpectedMemoryLeak(AAddress);
|
|
Result := System.RegisterExpectedMemoryLeak(AAddress);
|
|
{$ELSE}
|
|
Result := False;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function InternalIndyIndexOf(AStrings: TStrings; const AStr: string;
|
|
const ACaseSensitive: Boolean = False): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := -1;
|
|
for I := 0 to AStrings.Count - 1 do begin
|
|
if ACaseSensitive then begin
|
|
if AStrings[I] = AStr then begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end else begin
|
|
if TextIsSame(AStrings[I], AStr) then begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function IndyIndexOf(AStrings: TStrings; const AStr: string;
|
|
const ACaseSensitive: Boolean = False): Integer;
|
|
begin
|
|
{$IFDEF HAS_TStringList_CaseSensitive}
|
|
if AStrings is TStringList then begin
|
|
Result := IndyIndexOf(TStringList(AStrings), AStr, ACaseSensitive);
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
Result := InternalIndyIndexOf(AStrings, AStr, ACaseSensitive);
|
|
end;
|
|
|
|
{$IFDEF HAS_TStringList_CaseSensitive}
|
|
function IndyIndexOf(AStrings: TStringList; const AStr: string;
|
|
const ACaseSensitive: Boolean = False): Integer;
|
|
begin
|
|
if AStrings.CaseSensitive = ACaseSensitive then begin
|
|
Result := AStrings.IndexOf(AStr);
|
|
end else begin
|
|
Result := InternalIndyIndexOf(AStrings, AStr, ACaseSensitive);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function InternalIndyIndexOfName(AStrings: TStrings; const AStr: string;
|
|
const ACaseSensitive: Boolean = False): Integer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := -1;
|
|
for I := 0 to AStrings.Count - 1 do begin
|
|
if ACaseSensitive then begin
|
|
if AStrings.Names[I] = AStr then begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end else begin
|
|
if TextIsSame(AStrings.Names[I], AStr) then begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function IndyIndexOfName(AStrings: TStrings; const AStr: string;
|
|
const ACaseSensitive: Boolean = False): Integer;
|
|
begin
|
|
{$IFDEF HAS_TStringList_CaseSensitive}
|
|
if AStrings is TStringList then begin
|
|
Result := IndyIndexOfName(TStringList(AStrings), AStr, ACaseSensitive);
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
Result := InternalIndyIndexOfName(AStrings, AStr, ACaseSensitive);
|
|
end;
|
|
|
|
{$IFDEF HAS_TStringList_CaseSensitive}
|
|
function IndyIndexOfName(AStrings: TStringList; const AStr: string;
|
|
const ACaseSensitive: Boolean = False): Integer;
|
|
begin
|
|
if AStrings.CaseSensitive = ACaseSensitive then begin
|
|
Result := AStrings.IndexOfName(AStr);
|
|
end else begin
|
|
Result := InternalIndyIndexOfName(AStrings, AStr, ACaseSensitive);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function IndyValueFromIndex(AStrings: TStrings; const AIndex: Integer): String;
|
|
{$IFNDEF HAS_TStrings_ValueFromIndex}
|
|
var
|
|
LTmp: string;
|
|
LPos: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF HAS_TStrings_ValueFromIndex}
|
|
Result := AStrings.ValueFromIndex[AIndex];
|
|
{$ELSE}
|
|
Result := '';
|
|
if AIndex >= 0 then
|
|
begin
|
|
LTmp := AStrings.Strings[AIndex];
|
|
// TODO: use AStrings.NameValueSeparator on platforms that support it
|
|
LPos := Pos('=', LTmp); {do not localize}
|
|
if LPos > 0 then begin
|
|
Result := Copy(LTmp, LPos+1, MaxInt);
|
|
Exit;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF WINDOWS}
|
|
function IndyWindowsMajorVersion: Integer;
|
|
begin
|
|
{$IFDEF WINCE}
|
|
Result := SysUtils.WinCEMajorVersion;
|
|
{$ELSE}
|
|
Result := SysUtils.Win32MajorVersion;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyWindowsMinorVersion: Integer;
|
|
begin
|
|
{$IFDEF WINCE}
|
|
Result := SysUtils.WinCEMinorVersion;
|
|
{$ELSE}
|
|
Result := SysUtils.Win32MinorVersion;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyWindowsBuildNumber: Integer;
|
|
begin
|
|
// for this, you need to strip off some junk to do comparisons
|
|
{$IFDEF WINCE}
|
|
Result := SysUtils.WinCEBuildNumber and $FFFF;
|
|
{$ELSE}
|
|
Result := SysUtils.Win32BuildNumber and $FFFF;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyWindowsPlatform: Integer;
|
|
begin
|
|
{$IFDEF WINCE}
|
|
Result := SysUtils.WinCEPlatform;
|
|
{$ELSE}
|
|
Result := SysUtils.Win32Platform;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function IndyCheckWindowsVersion(const AMajor: Integer; const AMinor: Integer = 0): Boolean;
|
|
var
|
|
LMajor, LMinor: Integer;
|
|
begin
|
|
LMajor := IndyWindowsMajorVersion;
|
|
LMinor := IndyWindowsMinorVersion;
|
|
Result := (LMajor > AMajor) or ((LMajor = AMajor) and (LMinor >= AMinor));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure IdDisposeAndNil(var Obj);
|
|
{$IFDEF USE_OBJECT_ARC}
|
|
var
|
|
Temp: {Pointer}TObject;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF USE_OBJECT_ARC}
|
|
// RLebeau: was originally calling DisposeOf() on Obj directly, but nil'ing
|
|
// Obj first prevented the calling code from invoking __ObjRelease() on Obj.
|
|
// Don't do that in ARC. __ObjRelease() needs to be called, even if disposed,
|
|
// to allow the compiler/RTL to finalize Obj so any managed members it has
|
|
// can be cleaned up properly...
|
|
{
|
|
Temp := Pointer(Obj);
|
|
Pointer(Obj) := nil;
|
|
TObject(Temp).DisposeOf;
|
|
}
|
|
Pointer(Temp) := Pointer(Obj);
|
|
Pointer(Obj) := nil;
|
|
Temp.DisposeOf;
|
|
// __ObjRelease() is called when Temp goes out of scope
|
|
{$ELSE}
|
|
FreeAndNil(Obj);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
initialization
|
|
// AnsiPos does not handle strings with #0 and is also very slow compared to Pos
|
|
{$IFDEF DOTNET}
|
|
IndyPos := SBPos;
|
|
{$ELSE}
|
|
if LeadBytes = [] then begin
|
|
IndyPos := SBPos;
|
|
end else begin
|
|
IndyPos := InternalAnsiPos;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
|
|
InterlockedCompareExchange := Stub_InterlockedCompareExchange;
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
GetTickCount64 := Stub_GetTickCount64;
|
|
{$ENDIF}
|
|
{$IFDEF UNIX}
|
|
{$IFDEF DARWIN}
|
|
mach_timebase_info(GMachTimeBaseInfo);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF DOTNET}
|
|
finalization
|
|
FreeAndNil(GIdPorts);
|
|
{$ENDIF}
|
|
|
|
end.
|
|
|