{$I uRODXFree.def}

unit uRODXString;

interface

///////////////////////////////////////////////////////////////////////////////
//         Unit: DXString
//       Author: G.E. Ozz Nixon Jr. (onixon@dxsock.com)
//     Assembly: Pete Morris and Ozz Nixon {all asm by Ozz is denoted!}
// ========================================================================
// Source Owner: DX, Inc. 1995-2002
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2002
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
//               Example is Internet Explorer - Help->About screen
//               shows the licensed code contained in the application.
// Code Version: (3rd Generation Code)
// ========================================================================
//  Description:
// ========================================================================
///////////////////////////////////////////////////////////////////////////////

Uses
{$IFNDEF LINUX}
   Windows,
{$ENDIF}
   Classes,
   SyncObjs,
   SysUtils;


// DO NOT CHANGE THIS ONE
// BRAIN PATCHWORK DX ONLY CHANGES THIS
// IT IS USED FOR TECHNICAL SUPPORT (VERSION CONTROLS)
CONST BPDX_RELEASE_DATE='2002-09-01'; {YYYY-MM-DD}


///////////////////////////////////////////////////////////////////////////////
// Brain Patchwork - Just so you can verify which release you have at run-time.
///////////////////////////////////////////////////////////////////////////////
Type
   TDXCritical = Class(TObject)
   private
{$IFDEF VER100}
      Synchronizer:TCriticalSection;
{$ELSE}
// Borland has screwed the pooch on TMultiReadExclusiveWriteSynchronizer
// so bad that we will not support it!
      Synchronizer:TCriticalSection;// TMultiReadExclusiveWriteSynchronizer;
{$ENDIF}
   public
      constructor Create;
      destructor Destroy; override;
      procedure StartingRead;
      procedure FinishedRead;
      procedure StartingWrite;
      procedure FinishedWrite;
   End;
{$IFDEF OBJECTS_ONLY}
   TDXComponent = Class(TObject)
{$ELSE}
   TDXComponent = Class(TComponent)
{$ENDIF}
   private
         procedure SetReleaseDate(value: string);
         Function GetReleaseDate:String;
   public
         MyCriticalSection:TDXCritical;
         constructor Create(AOwner: TComponent); {$IFNDEF OBJECTS_ONLY} override; {$ENDIF}
         destructor Destroy; override;
   published
         property ReleaseDate:String Read GetReleaseDate write SetReleaseDate;
   End;

///////////////////////////////////////////////////////////////////////////////
// Routines to centralize "Windows" calls
///////////////////////////////////////////////////////////////////////////////
{$IFDEF LINUX}
Type
   DWord=LongWord;
   TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest, pTimeCritical);
{$ELSE}
Type
   PInteger = Windows.PInteger;
   DWORD = Windows.DWord;
{$ENDIF}

// LINUX:
Function LocalTimeZoneBias:Integer;
// WINDOWS:
Procedure ProcessWindowsMessageQueue;
function  HiByteOfWord(Const W:Word):Byte;
function  MakeBytesToWord(Const A,B:Byte):Word;
function  WindowsWriteFile(hFile:THandle;
   const Buffer;nNumberOfBytesToWrite:DWORD;
   var lpNumberOfBytesWritten:DWORD):Boolean;
Procedure ShowMessageWindow(Const Caption,Message:String);
Procedure DoSleepEX(Const Interval:DWord);
{$IFNDEF LINUX}
Function GetRegistryString(Const Key:HKey;Const SubKey:string):string;
Function SetRegistryString(Const Key:HKey;SubKey,Value:string):Boolean;
function RegistryStringGet(Const Key:HKey;SubKey:string):String;
function RegistryStringSet(Const Key:HKey;SubKey,Value:string):Boolean; //2.0.12
Function LaunchWebBrowser(Const URL:string;Const WindowState:Integer):Boolean;
{$ENDIF}
{$IFNDEF VER90} // Nothing like this in D2???
Function MakeUUID:String;
Function RawUUID:String;
Function MakeUUIDPacked:String;
{$ENDIF}

///////////////////////////////////////////////////////////////////////////////
// Numeric Routines
///////////////////////////////////////////////////////////////////////////////
Function IsCharAlphaNumeric(Const c:char):Boolean; // 2.3 const and asm
Function IsCharAlpha(Const c:Char):Boolean; // 2.3 const and asm
Function IsNumeric(Const c:char):Boolean; // 2.3 asm
Function isNumericString(Const S:string):Boolean;
Function Min(Const I1,I2:Integer):Integer; // 2.3 asm
Function Max(Const I1,I2:Integer):Integer; // 2.3 asm
Function StringToInteger(Const S:String):Integer;
Procedure SwapMove(Source:Word;Var Dest);
Function IntToCommaStr(Const Number:Integer):String; // 2.3 const
Function BinaryToString(Const Number:Byte):String; // 2.3 const
Function StringToBinary(S:String):Byte;
function LRot16(X:Word;c:longint):Word;
function RRot16(X:Word;c:longint):Word;
function LRot32(X:DWord;c:longint):DWord;
function RRot32(X:DWord;c:longint):DWord;
function SwapDWord(X:DWord):DWord; 

///////////////////////////////////////////////////////////////////////////////
// String Routines
///////////////////////////////////////////////////////////////////////////////
Function QuickPos(const aFindString,aSourceString:String):integer;
Function CharPos(const C: Char; const aSource : String) : Integer;
Function Fetch(var S:String;Const Sub:String;Const IgnoreCase:Boolean):String;
Function FetchByChar(var S:String;Const Sub:Char;Const IgnoreCase:Boolean):String;
Function Uppercase(Const S:String):String;
Function Lowercase(Const S:String):String; // 2.3 asm
Function ProperCase(Const S:String):String;
Function Trim(const S:string):string;
Function NoCRLF(Const S:String):String;
Function NoAngleBrackets(Const S:string):string;
Function InStrArray(const SearchStr:string;Const KnownCommands:Array of String):Integer; // 2.3 String instead of MySmallString
Procedure InverseString(Var S:String;Count:Integer);
Function HexDump(Const S:String):String; // 2.3 Const and rewrote to optimize for BIG strings!!
function ReplaceChar(const Source:string;Const OldChar,NewChar:Char):string;
function ExtractLeft(const aSourceString:String;Const Size:Integer):String; // 2.3 const
function ExtractRight(const aSourceString:String;Const Size:Integer):String; // 2.3 const
Function ExtractWordAt(const Text:String;Position:Integer):String; // 2.3 const
Function LeftJustify(Const S:String;Const MaxLength:Integer):String;
Function RightJustify(Const S:String;Const MaxLength:Integer):String;
Function CleanChar(Const InChar:Char):Char; // 2.3 const
Function CleanStr(Const InStr:String):String; // 2.3 const
Function PosLastChar(Const Ch:Char;Const S:String):Integer; // 2.3 const
Function AsciiToOem(Const ax:String):String; // 2.3 const & fixed
Function OemToAscii(Const ax:String):String; // 2.3 const & fixed
Function WordCount(const S:string):Integer; // 2.3 const
Function CRC32ByChar(const Ch:Char;const starting_crc:LONGINT):LONGINT; // 2.3 const
Function CRC32ByString(const S:String;const starting_crc:LONGINT):LONGINT; // 2.3 const
Function CRC16ByChar(const Ch:Char;const starting_crc:word):word;
Function CRC16ByString(const S:String;const starting_crc:word):word;
Function CRCARCByChar(const Ch:Char;const starting_crc:word):word;
Function CRCARCByString(const S:String;const starting_crc:word):word;
Procedure SetLongBit(Var L:LongInt;const Bit:Byte;const Setting:Boolean); // 2.3 const
Function GetLongBit(const L:LongInt;const Bit:Byte):Boolean; // 2.3 const
Procedure SetWordBit(Var L:Word;const Bit:Byte;const Setting:Boolean); // 2.3 const
Function GetWordBit(const L:Word;const Bit:Byte):Boolean; // 2.3 const
Procedure SetByteBit(Var L:Byte;const Bit:Byte;const Setting:Boolean); // 2.3 const
Function GetByteBit(const L:Byte;const Bit:Byte):Boolean; // 2.3 const
Function Replicate(const Source:String;NumberOfTimes:Integer):String; // const and fixed
Function IsWildCard(const Source:String):Boolean;
function PCharLen(Str:PChar):integer; // 2.3 *NEW* (3.8times faster than strlen!)
// new 8-20-2002
function WildCompare(LookingFor,SourceStr:String):Boolean;
///////////////////////////////////////////////////////////////////////////////
// Internet Routines
///////////////////////////////////////////////////////////////////////////////
Function GetIndex(Const c:char):Integer;
Function Base64ToString(Const S:String):String;
Function StringToBase64(Const S1:String):String;
function FixDottedIP(Const S:string):string;
Function IPStringFormated(S:String):String;
Function IPAddressFormatted(Const I1,I2,I3,I4:Integer):String;
Function EscapeDecode(Const S:String):String;
Function EscapeEncode(Const S:String):String;
Function EncodeDomain(S:String):String;
Function EncodeAddress(S:String):String;
Function DecodeDomain(S:String):String;
Function GetActualEmailAddress(Parm,Command:String):String;

///////////////////////////////////////////////////////////////////////////////
// Date and/or Time Routines
///////////////////////////////////////////////////////////////////////////////
Function TimeZone:String;
Function TimeZoneBias:String;
Function ShortTimeZone:String;
Function DateTimeToGMTRFC822(Const DT:TDateTime):String;
Function DateTimeToGMTRFC850(Const DT:TDateTime):String;
Function DateTimeToRFC850(Const DT:TDateTime):String;
Function DateTimeToRFC850Bias(Const DT:TDateTime):String;
Function RFCToDateTime(S:String):TDateTime;
Procedure Unpacktime(Const P:Longint;Var DT:TDatetime);
Procedure Packtime(Var DT:TDatetime;VAR P:Longint);
Function GetDosDate:LongInt;
Function GetDOW:Word;
Function TimeOut(Const MyTime:DWord):Boolean;
Function TimeCounter:DWord;
Function IsLeapYear(Const Year:Word):Boolean;
Function DateTimeToGMT(const DT:TDateTime):TDateTime;
Function DateTimeToLocal(const DT:TDateTime):TDateTime;
Function IsTimeAM(const DT:TDateTime):Boolean;
Function IsTimePM(const DT:TDateTime):Boolean;
Function IsTimeNoon(const DT:TDateTime):Boolean;
Function IsTimeMidnight(const DT:TDateTime):Boolean;
Function DaysThisMonth(const DT:TDateTime):Integer;
Function DaysLeftThisMonth(const DT:TDateTime):Integer;
Function DayOfTheYear(const DT:TDateTime):Integer;
Function DaysLeftThisYear(const DT:TDateTime):Integer;

///////////////////////////////////////////////////////////////////////////////
// File/Disk Routines
///////////////////////////////////////////////////////////////////////////////
Function AddBackSlash(Const S:String):String;
Function NoBackSlash(Const S:String):String;
Function ToOSSlashes(Const S:String):String; // 2.3
Function ToUnixSlashes(Const S:String):String;
Function ToDOSSlashes(Const S:String):String;
Function ChangeDir(Const S,RP:String):String;

{$IFDEF VER100}
type
  TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);

Function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
procedure FreeAndNil(var Obj);
{$ELSE}
{$ENDIF}
{$IFDEF LINUX}
Function CoCreateGuid(var GUID:TGUID):HResult;
{$ELSE}
{$IFDEF VER90} // DELPHI2 does not have a TGuid
Function CoCreateGuid(var guid:Pointer): HResult; stdcall;
{$ELSE}
Function CoCreateGuid(var guid: TGUID): HResult; stdcall;
{$ENDIF}
{$ENDIF}

///////////////////////////////////////////////////////////////////////////////
// DXSock 3.0 Additions
///////////////////////////////////////////////////////////////////////////////
Type
   CharSet=set of Char;

Function Center(S:String;MaxWidth:Integer):String;
Function LeftJustifyCh(Const S:String;Const Ch:Char;Const MaxLength:Integer):String;
Function RightJustifyCh(Const S:String;Const Ch:Char;Const MaxLength:Integer):String;
Function EncodeTabs(S:string;TabSize:Byte):string;
Function DecodeTabs(S:string;TabSize:Byte):string;
Function Filter(S:String;CS:CharSet):String;
Function SoundEx(S:String):String;

//procedure register;

implementation

{$IFDEF LINUX}
Uses
   Libc,
   {$IFDEF FPC} Forms, Dialogs
   {$ELSE}     QForms,QDialogs
   {$ENDIF}
   ;
{$ELSE}
Uses
   Registry; {to avoid Win2K security issue!}
{$ENDIF}

Const
   Alphabet='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
   AlphabetLength = 64; //Needed in GetIndex
{$IFDEF VER100} // D3 Windows.PAS is missing these:
   TIME_ZONE_ID_STANDARD = 1;
   TIME_ZONE_ID_DAYLIGHT = 2;
{$ENDIF}
{$IFNDEF VER90}
   ole32='ole32.dll';
{$ENDIF}
{$WARNINGS OFF}
   crc_32_tab: ARRAY[0..255] OF LONGINT = (
      $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
      $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
      $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
      $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
      $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
      $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
      $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
      $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
      $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
      $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
      $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
      $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
      $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
      $4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
      $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
      $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
      $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
      $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
      $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
      $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
      $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
      $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
      $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
      $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
      $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
      $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
      $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
      $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
      $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
      $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
      $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
      $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d);
 crc_arc_tab: Array[0..$FF] of Word =
    ($00000, $0C0C1, $0C181, $00140, $0C301, $003C0, $00280, $0C241,
     $0C601, $006C0, $00780, $0C741, $00500, $0C5C1, $0C481, $00440,
     $0CC01, $00CC0, $00D80, $0CD41, $00F00, $0CFC1, $0CE81, $00E40,
     $00A00, $0CAC1, $0CB81, $00B40, $0C901, $009C0, $00880, $0C841,
     $0D801, $018C0, $01980, $0D941, $01B00, $0DBC1, $0DA81, $01A40,
     $01E00, $0DEC1, $0DF81, $01F40, $0DD01, $01DC0, $01C80, $0DC41,
     $01400, $0D4C1, $0D581, $01540, $0D701, $017C0, $01680, $0D641,
     $0D201, $012C0, $01380, $0D341, $01100, $0D1C1, $0D081, $01040,
     $0F001, $030C0, $03180, $0F141, $03300, $0F3C1, $0F281, $03240,
     $03600, $0F6C1, $0F781, $03740, $0F501, $035C0, $03480, $0F441,
     $03C00, $0FCC1, $0FD81, $03D40, $0FF01, $03FC0, $03E80, $0FE41,
     $0FA01, $03AC0, $03B80, $0FB41, $03900, $0F9C1, $0F881, $03840,
     $02800, $0E8C1, $0E981, $02940, $0EB01, $02BC0, $02A80, $0EA41,
     $0EE01, $02EC0, $02F80, $0EF41, $02D00, $0EDC1, $0EC81, $02C40,
     $0E401, $024C0, $02580, $0E541, $02700, $0E7C1, $0E681, $02640,
     $02200, $0E2C1, $0E381, $02340, $0E101, $021C0, $02080, $0E041,
     $0A001, $060C0, $06180, $0A141, $06300, $0A3C1, $0A281, $06240,
     $06600, $0A6C1, $0A781, $06740, $0A501, $065C0, $06480, $0A441,
     $06C00, $0ACC1, $0AD81, $06D40, $0AF01, $06FC0, $06E80, $0AE41,
     $0AA01, $06AC0, $06B80, $0AB41, $06900, $0A9C1, $0A881, $06840,
     $07800, $0B8C1, $0B981, $07940, $0BB01, $07BC0, $07A80, $0BA41,
     $0BE01, $07EC0, $07F80, $0BF41, $07D00, $0BDC1, $0BC81, $07C40,
     $0B401, $074C0, $07580, $0B541, $07700, $0B7C1, $0B681, $07640,
     $07200, $0B2C1, $0B381, $07340, $0B101, $071C0, $07080, $0B041,
     $05000, $090C1, $09181, $05140, $09301, $053C0, $05280, $09241,
     $09601, $056C0, $05780, $09741, $05500, $095C1, $09481, $05440,
     $09C01, $05CC0, $05D80, $09D41, $05F00, $09FC1, $09E81, $05E40,
     $05A00, $09AC1, $09B81, $05B40, $09901, $059C0, $05880, $09841,
     $08801, $048C0, $04980, $08941, $04B00, $08BC1, $08A81, $04A40,
     $04E00, $08EC1, $08F81, $04F40, $08D01, $04DC0, $04C80, $08C41,
     $04400, $084C1, $08581, $04540, $08701, $047C0, $04680, $08641,
     $08201, $042C0, $04380, $08341, $04100, $081C1, $08081, $04040);
 crc_16_tab: Array[0..$FF] of Word =
    ($00000, $01021, $02042, $03063, $04084, $050a5, $060c6, $070e7,
     $08108, $09129, $0a14a, $0b16b, $0c18c, $0d1ad, $0e1ce, $0f1ef,
     $01231, $00210, $03273, $02252, $052b5, $04294, $072f7, $062d6,
     $09339, $08318, $0b37b, $0a35a, $0d3bd, $0c39c, $0f3ff, $0e3de,
     $02462, $03443, $00420, $01401, $064e6, $074c7, $044a4, $05485,
     $0a56a, $0b54b, $08528, $09509, $0e5ee, $0f5cf, $0c5ac, $0d58d,
     $03653, $02672, $01611, $00630, $076d7, $066f6, $05695, $046b4,
     $0b75b, $0a77a, $09719, $08738, $0f7df, $0e7fe, $0d79d, $0c7bc,
     $048c4, $058e5, $06886, $078a7, $00840, $01861, $02802, $03823,
     $0c9cc, $0d9ed, $0e98e, $0f9af, $08948, $09969, $0a90a, $0b92b,
     $05af5, $04ad4, $07ab7, $06a96, $01a71, $00a50, $03a33, $02a12,
     $0dbfd, $0cbdc, $0fbbf, $0eb9e, $09b79, $08b58, $0bb3b, $0ab1a,
     $06ca6, $07c87, $04ce4, $05cc5, $02c22, $03c03, $00c60, $01c41,
     $0edae, $0fd8f, $0cdec, $0ddcd, $0ad2a, $0bd0b, $08d68, $09d49,
     $07e97, $06eb6, $05ed5, $04ef4, $03e13, $02e32, $01e51, $00e70,
     $0ff9f, $0efbe, $0dfdd, $0cffc, $0bf1b, $0af3a, $09f59, $08f78,
     $09188, $081a9, $0b1ca, $0a1eb, $0d10c, $0c12d, $0f14e, $0e16f,
     $01080, $000a1, $030c2, $020e3, $05004, $04025, $07046, $06067,
     $083b9, $09398, $0a3fb, $0b3da, $0c33d, $0d31c, $0e37f, $0f35e,
     $002b1, $01290, $022f3, $032d2, $04235, $05214, $06277, $07256,
     $0b5ea, $0a5cb, $095a8, $08589, $0f56e, $0e54f, $0d52c, $0c50d,
     $034e2, $024c3, $014a0, $00481, $07466, $06447, $05424, $04405,
     $0a7db, $0b7fa, $08799, $097b8, $0e75f, $0f77e, $0c71d, $0d73c,
     $026d3, $036f2, $00691, $016b0, $06657, $07676, $04615, $05634,
     $0d94c, $0c96d, $0f90e, $0e92f, $099c8, $089e9, $0b98a, $0a9ab,
     $05844, $04865, $07806, $06827, $018c0, $008e1, $03882, $028a3,
     $0cb7d, $0db5c, $0eb3f, $0fb1e, $08bf9, $09bd8, $0abbb, $0bb9a,
     $04a75, $05a54, $06a37, $07a16, $00af1, $01ad0, $02ab3, $03a92,
     $0fd2e, $0ed0f, $0dd6c, $0cd4d, $0bdaa, $0ad8b, $09de8, $08dc9,
     $07c26, $06c07, $05c64, $04c45, $03ca2, $02c83, $01ce0, $00cc1,
     $0ef1f, $0ff3e, $0cf5d, $0df7c, $0af9b, $0bfba, $08fd9, $09ff8,
     $06e17, $07e36, $04e55, $05e74, $02e93, $03eb2, $00ed1, $01ef0);
{$WARNINGS ON}

{
procedure register;
begin
  RegisterComponents('BPDX Addons', [TDXComponent]);
end;
}

///////////////////////////////////////////////////////////////////////////////
// Internal Version Control Routines (used for DCU's mainly)
///////////////////////////////////////////////////////////////////////////////
procedure TDXComponent.SetReleaseDate(value: string);
Begin
End;

Function TDXComponent.GetReleaseDate:String;
Begin
   Result:=BPDX_RELEASE_DATE;
End;

constructor TDXComponent.Create(AOwner: TComponent);
Begin
{$IFDEF OBJECTS_ONLY}
   inherited create;
{$ELSE}
   inherited create(AOwner);
{$ENDIF}
   MyCriticalSection:=TDXCritical.Create;
End;

destructor TDXComponent.Destroy;
Begin
   MyCriticalSection.Free;
   MyCriticalSection:=Nil;
   inherited;
End;

constructor TDXCritical.Create;
Begin
   inherited;

{$IFDEF VER100}
   Synchronizer:=TCriticalSection.Create;
{$ELSE}
   Synchronizer:=TCriticalSection.Create;// TMultiReadExclusiveWriteSynchronizer.Create;
{$ENDIF}
End;

destructor TDXCritical.Destroy;
Begin
try
   Synchronizer.Free;
except
end;
   inherited;
End;

Procedure TDXCritical.StartingRead;
Begin
{$IFDEF VER100}
   Synchronizer.Acquire;
{$ELSE}
   Synchronizer.Acquire; //BeginRead;
{$ENDIF}
End;

Procedure TDXCritical.FinishedRead;
Begin
{$IFDEF VER100}
   Synchronizer.Release;
{$ELSE}
   Synchronizer.Release; //EndRead;
{$ENDIF}
End;

Procedure TDXCritical.StartingWrite;
Begin
{$IFDEF VER100}
   Synchronizer.Acquire;
{$ELSE}
   Synchronizer.Acquire; //BeginWrite;
{$ENDIF}
End;

Procedure TDXCritical.FinishedWrite;
Begin
{$IFDEF VER100}
   Synchronizer.Release;
{$ELSE}
   Synchronizer.Release; //EndWrite;
{$ENDIF}
End;

///////////////////////////////////////////////////////////////////////////////
// Windows/Operating System Routines
///////////////////////////////////////////////////////////////////////////////

Procedure ProcessWindowsMessageQueue;
{$IFDEF LINUX}
Begin
   Application.ProcessMessages;
End;
{$ELSE}
Var
   MsgRec:TMsg;

Begin
   If Not IsConsole then
      while PeekMessage(MsgRec,0,0,0,PM_REMOVE) do begin
         TranslateMessage(MsgRec);
         DispatchMessage(MsgRec)
      end;
End;
{$ENDIF}

function HiByteOfWord(Const W:Word):Byte;
Begin
   Result:=Hi(W);
End;

function MakeBytesToWord(Const A,B:Byte):Word;
Begin
   Result:=(A shl 8) + B;
End;

function WindowsWriteFile(hFile:THandle;const Buffer;nNumberOfBytesToWrite:DWORD;
  var lpNumberOfBytesWritten: DWORD):Boolean;
Begin
{$IFDEF LINUX}
   lpNumberOfBytesWritten:=FileWrite(hFile,Buffer,nNumberOfBytesToWrite);
   Result:=lpNumberOfBytesWritten=nNumberOfBytesToWrite;
{$ELSE}
   Result:=WriteFile(hFile,Buffer,nNumberOfBytesToWrite,lpNumberOfBytesWritten,Nil);
{$ENDIF}
End;

Procedure ShowMessageWindow(Const Caption,Message:String);
Begin
{$IFDEF LINUX}
   MessageDlg(Caption,Message,mtError,[mbOk],0);
{$ELSE}
   MessageBox(0,PChar(Message),PChar(Caption),MB_ICONEXCLAMATION or MB_SYSTEMMODAL);
{$ENDIF}
End;

Procedure DoSleepEX(Const Interval:DWord);
Begin
{$IFDEF LINUX}
   Sleep(Interval);
{$ELSE}
   SleepEx(Interval,False{True});
{$ENDIF}
End;

{$IFNDEF LINUX}
function RegistryStringGet(Const Key:HKey;SubKey:string):String;
var
   Reg:TRegistry;
   lResult:string;
   DValue:string;

begin
   lResult:='';
   DValue:=SubKey;
   Delete(DValue,1,PosLastChar('\',SubKey));
   Delete(SubKey,PosLastChar('\',SubKey),length(DValue)+1);
   Reg:=TRegistry.Create;
try
   Reg.RootKey:=Key;
   if Reg.OpenKey(SubKey,True) then
      lresult:=Reg.ReadString(DValue);
finally
   Reg.CloseKey;
   Reg.Free;
end;
   result:=lresult;
end;

function RegistryStringSet(Const Key:HKey;SubKey,Value:string):Boolean;
var
   Reg:TRegistry;
   DValue:string;

begin
   DValue:=SubKey;
   Delete(DValue,1,PosLastChar('\',SubKey));
   Delete(SubKey,PosLastChar('\',SubKey),length(DValue)+1);
   Reg:=TRegistry.Create;
   Result:=False;
try
   Reg.RootKey:=Key;
   if Reg.OpenKey(SubKey,True) then Begin
      Reg.WriteString(DValue,Value);
      Result:=True;
   End;
finally
   Reg.CloseKey;
   Reg.Free;
end;
end;

function GetRegistryString(Const Key:HKey;Const SubKey:string):string;
begin
   Result:=RegistryStringGet(Key,SubKey);
end;

function SetRegistryString(Const Key:HKey;SubKey,Value:string):Boolean;
begin
   Result:=RegistryStringSet(Key,SubKey,Value);
end;

function LaunchWebBrowser(Const URL:string;Const WindowState:Integer):Boolean;
var
   sLaunch: string;
   iPos: integer;

begin
   Result:=False;
   sLaunch:=GetRegistryString(HKEY_CLASSES_ROOT,'.htm');
   if sLaunch<>'' then begin
      sLaunch:=sLaunch + '\shell\open\command';
      sLaunch:=GetRegistryString(HKEY_CLASSES_ROOT,sLaunch);
      if sLaunch<>'' then begin
         iPos:=QuickPos('"%1"',sLaunch);
         if iPos=0 then iPos:=QuickPos('%1',sLaunch);
         if iPos<>0 then sLaunch:=Copy(sLaunch,1,iPos-1);
         sLaunch:=sLaunch+#32+URL;
         Result:=WinExec(PChar(sLaunch),WindowState)>31;
      end;
   end;
end;
{$ENDIF}

{$IFNDEF VER90}
///////////////////////////////////////////////////////////////////////////////
// References the external symbol to MS CoCreateGUID function which creates MS-style UUID's
///////////////////////////////////////////////////////////////////////////////
{$IFNDEF LINUX}
function CoCreateGuid; external ole32 name 'CoCreateGuid';
{$ENDIF}

Function MakeUUID:String;
Var
   UUIDVar: TGUID;
   UUID_String: String;
   k:Integer;

Begin
  CoCreateGuid(UUIDVar);
  UUID_String:=IntToHex(UUIDVar.D1, 8)+'-'+
               IntToHex(UUIDVar.D2, 4)+'-'+
               IntToHex(UUIDVar.D3, 4)+'-';
  for k := 0 to 1 do UUID_String:=UUID_String+IntToHex(UUIDVar.D4[k], 2);
  UUID_String:=UUID_String+'-';
  for k := 2 to 7 do UUID_String:=UUID_String+IntToHex(UUIDVar.D4[k], 2);
  Result:=UUID_String;
End;

Function RawUUID:String;
Var
   UUIDVar: TGUID;
   UUID_String: String;
   k:Integer;

Begin
  CoCreateGuid(UUIDVar);
  UUID_String:=IntToHex(UUIDVar.D1, 8)+
               IntToHex(UUIDVar.D2, 4)+
               IntToHex(UUIDVar.D3, 4);
  for k := 0 to 1 do UUID_String:=UUID_String+IntToHex(UUIDVar.D4[k], 2);
  for k := 2 to 7 do UUID_String:=UUID_String+IntToHex(UUIDVar.D4[k], 2);
  Result:=UUID_String;
End;

Function MakeUUIDPacked:String;
Var
   UUIDVar: TGUID;

Begin
  CoCreateGuid(UUIDVar);
  SetLength(Result,16);
  Move(UUIDVar.D1,Result[1],4);
  Move(UUIDVar.D2,Result[5],2);
  Move(UUIDVar.D3,Result[7],2);
  Move(UUIDVar.D4,Result[9],8);
End;
{$ENDIF}

{$IFDEF LINUX}
Function CoCreateGuid(var GUID:TGUID):HResult;
Begin
   Result:=CreateGUID(GUID);
End;
{$ENDIF}

///////////////////////////////////////////////////////////////////////////////
// Numeric Routines
///////////////////////////////////////////////////////////////////////////////
Function IsCharAlphaNumeric(Const C:char):Boolean;
Begin
{$IFNDEF ASM8086}
   Result:=C in ['0'..'9','A'..'Z','a'..'z'];
{$ELSE} // ASM CODE BY OZZ
asm
   mov AL,C
   cmp AL, $30   // 0
   jl @NoMatch   // it's before '0' so Result=False/Exit
   cmp AL, $7A   // z
   jg @NoMatch   // it's after 'z' so Result=False/Exit
   cmp AL, $39   // 9
   jg @TryAlpha  // it's after '9' so see if it is Alpha now
   jmp @Matched  // it's 0..9 so Result=True/Exit
@TryAlpha:
   cmp AL, $41   // A
   jl @NoMatch   // it's before 'A' so Result=False/Exit
   cmp AL, $5A   // Z
   jg @TryLower  // it's after 'Z' so see if it is lowecase Alpha
   jmp @Matched  // it's 'A'..'Z' so Result=True/Exit
@TryLower:
   cmp AL, $61   // a
   jl @NoMatch   // it's before 'a' so Result=False/Exit
   jmp @Matched  // it's 'a'..'z' so Result=True/Exit
@NoMatch:
   mov Result,0
   jmp @TheEnd
@Matched:
   mov Result,1
@TheEnd:
end {asm}
{$ENDIF}
End;

Function IsCharAlpha(Const c:Char):Boolean;
Begin
{$IFNDEF ASM8086}
   Result:=C in ['A'..'Z','a'..'z'];
{$ELSE} // ASM BY OZZ
asm
   mov AL,C
   cmp AL, $41   // A
   jl @NoMatch   // it's before 'A' so Result=False/Exit
   cmp AL, $7A   // z
   jg @NoMatch   // it's after 'z' so Result=False/Exit
   cmp AL, $5A   // Z
   jg @TryLower  // it's after 'Z' so see if it is lower now
   jmp @Matched  // it's A..Z so Result=True/Exit
@TryLower:
   cmp AL, $61   // a
   jl @NoMatch   // it's before 'a' so Result=False/Exit
   jmp @Matched  // it's 'a'..'z' so Result=True/Exit
@NoMatch:
   mov Result,0
   jmp @TheEnd
@Matched:
   mov Result,1
@TheEnd:
end {asm}
{$ENDIF}
End;

Function IsNumeric(Const c:char):Boolean;
begin
{$IFNDEF ASM8086}
   Result:=IsCharAlphaNumeric(c) and not IsCharAlpha(c);
{$ELSE} // ASM BY OZZ
asm
   mov AL,C
   cmp AL, $30   // 0
   jl @NoMatch   // it's before '0' so Result=False/Exit
   cmp AL, $39   // 9
   jg @NoMatch   // it's after '9' so Result=False/Exit
   jmp @Matched  // it's 0..9 so Result=True/Exit
@NoMatch:
   mov Result,0
   jmp @TheEnd
@Matched:
   mov Result,1
@TheEnd:
end {asm}
{$ENDIF}
end;

Function isNumericString(Const S:String):Boolean;
Var
   Loop,MaxLoop:Integer;

begin
   Result:=True;
   MaxLoop:=Length(S);
   Loop:=0;
   While (Loop<MaxLoop) and (Result) do Begin
      If S[Loop+1]<>'.' then
         Result:=IsNumeric(S[Loop+1]);
      Inc(Loop);
   End;
end;

Function Min(Const I1,I2:Integer):Integer;
Begin
{$IFNDEF ASM8086}
   If I1<I2 then Result:=I1
   Else Result:=I2;
{$ELSE} // ASM BY OZZ
   Result:=I1;
asm
   mov ECX, I2    // Store I2 in ECX
   mov EDX, I1    // Store I1 in EDX
   cmp EDX, ECX   // compare I2 to I1
   jl @TheEnd     // if I2<I1 then Exit {result already set}
@ItIsLess:
   mov Result,ECX // result=I2/Exit
@TheEnd:
end; {asm}
{$ENDIF}
End;

Function Max(Const I1,I2:Integer):Integer;

Begin
{$IFDEF ASM8086}
   If I1>I2 then Result:=I1
   Else Result:=I2;
{$ELSE} // ASM BY OZZ
   Result:=I1;
asm
   mov ECX, I2    // Store I2 in ECX
   mov EDX, I1    // Store I1 in EDX
   cmp EDX, ECX   // compare I2 to I1
   jg @TheEnd     // if I2>I1 then Exit {result already set}
@ItIsLess:
   mov Result,ECX // result=I2/Exit
@TheEnd:
end; {asm}
{$ENDIF}
End;

Function StringToInteger(Const S:String):Integer;
var
   E: Integer;

begin
   Val(S,Result,E);
End;

Procedure SwapMove(Source:Word;Var Dest);
Begin
   Source:=(HI(Source))+(LO(Source)*256);
   Move(Source,Dest,2);
End;

Function IntToCommaStr(Const Number:Integer):String;
Var
   StrPos:Integer;

Begin
   Result:=IntToStr(Number);
   StrPos:=Length(Result)-2;
   While StrPos>1 Do Begin
      Insert(',',Result,StrPos);
      StrPos:=StrPos-3;
   End;
End;

Function BinaryToString(Const Number:Byte):String;
Var
   Temp2:Byte;
   i:Word;

Begin
   Setlength(Result,8);
   FillChar(Result[1],8,'0');
   Temp2:=$80;
   For i := 1 to 8 Do Begin
      If (Number and Temp2)<>0 Then Result[i]:='1';
      Temp2:=Temp2 shr 1;
   End;
End;

Function StringToBinary(S:String):Byte;
Var
   i:Word;
   Temp1:Byte;
   Temp2:Byte;

Begin
   S:=Trim(S);
   While Length(S)<8 do S:='0'+S;
   Temp1:=0;
   Temp2:=$80;
   For i := 1 to 8 Do Begin
      If S[i]='1' Then Inc(Temp1,Temp2);
      Temp2:=Temp2 shr 1;
   End;
   Result:=Temp1;
End;

///////////////////////////////////////////////////////////////////////////////
// String Routines
///////////////////////////////////////////////////////////////////////////////
function QuickPos(const aFindString,aSourceString:String):integer;
var
   SourceLen,aSourceLen,aFindLen,StartPos:integer;

begin
{$IFNDEF ASM8086}
   Result:=Pos(aFindString,aSourceString);
{$ELSE}
   Result:=0;
   aSourceLen:=Length(aSourceString);
   If aSourceLen=0 then Exit;
   aFindLen:=Length(aFindString);
   If (aFindLen=0) or (aFindlen>AsourceLen) then Exit; {GSW FIX!}
   StartPos:=1;
   SourceLen:=aSourceLen-aFindLen;
   SourceLen:=(SourceLen-StartPos)+2;

asm
   push ESI
   push EDI
   push EBX
   mov EDI, aSourceString
   add EDI, StartPos
   dec EDI
   mov ESI, aFindString
   mov ECX, SourceLen
   mov Al, [ESI]
@ScaSB:
   mov Ah, [EDI]
   cmp Ah,Al
   jne @NextChar
@CompareStrings:
   mov EBX, aFindLen
   dec EBX
   jz @FullMatch
@CompareNext:
   mov Al, [ESI+EBX]
   mov Ah, [EDI+EBX]
   cmp Al, Ah
   jz @Matches
   mov Al, [ESI]
   jmp @NextChar
@Matches:
   dec EBX
   jnz @CompareNext
@FullMatch:
   mov EAX, EDI
   sub EAX, aSourceString
   inc EAX
   mov Result, EAX
   jmp @TheEnd
@NextChar:
   inc EDI
   dec ECX
   jnz @ScaSB
   mov Result,0
@TheEnd:
   pop EBX
   pop EDI
   pop ESI
end; {asm}
{$ENDIF}
end;

function CharPos(const C:Char;const aSource:String):Integer;
var
  L                           : Integer;
begin
  L := Length(aSource);
  Result:=0;
  if L = 0 then exit;

asm
  PUSH EDI                 //Preserve this register
  mov  EDI, aSource        //Point EDI at aSource
  mov  ECX, L              //Make a note of how many chars to search through
  mov  AL,  C              //and which char we want
@Loop:
  mov  AH, [EDI]
  inc  EDI
  xor  AH, AL
  jz   @Found
  dec  ECX
  jnz  @Loop
  jmp  @NotFound
@Found:
  sub  EDI, aSource        //EDI has been incremented, so EDI-OrigAdress = Char pos !
  mov  Result,   EDI
  jmp @TheEnd
@NotFound:
  mov  Result, 0 // fix (ozz)
@TheEnd:
  POP  EDI
  end;
end;

Function Fetch(var S:String;Const Sub:String;Const IgnoreCase:Boolean):String;
var
   P:Integer;

begin
   If IgnoreCase then P:=QuickPos(Uppercase(Sub),Uppercase(S))
   Else P:=QuickPos(Sub,S);
   if (P=0) then Begin
      Result:=S;
      S:='';
   End
   Else Begin
      Result:=Copy(S,1,P-1);
      Delete(S,1,P+(Length(Sub)-1));
   End;
end;

Function FetchByChar(var S:String;Const Sub:Char;Const IgnoreCase:Boolean):String;
var
   P:Integer;

begin
   If IgnoreCase then P:=CharPos(Upcase(Sub),Uppercase(S))
   Else P:=CharPos(Sub,S);
   if (P=0) then Begin
      Result:=S;
      S:='';
   End
   Else Begin
      Result:=Copy(S,1,P-1);
      Delete(S,1,P);
   End;
end;

Function Uppercase(Const S:String):String;
{$IFNDEF ASM8086}
var
   Loop:Integer;
   MaxLoop:Integer;

Begin
   Result:=S;
   MaxLoop:=Length(Result);
   For Loop:=MaxLoop downto 1 do
      If Result[Loop] in ['a'..'z'] then Dec(Result[Loop],32);
End;
{$ELSE} // Ozz: tweaked to use Pointer() which is faster than @string!
var
  LenOfString:Integer;
  FirstSource,FirstDest:Pointer;

begin
   LenOfString:=Length(S);
   If LenOfString=0 then Begin
      Result:='';
      Exit;
   End;
   SetLength(Result,LenOfString);
   FirstSource:=Pointer(s);
   FirstDest:=Pointer(Result);
asm
   PUSH ESI            //Firstly and most importantly
   PUSH EDI            //Delphi uses EBX, ESI, EDI extensively, so we need to
                       //push them onto the stack, and then pop them off after
   mov ESI, FirstSource//Move the address of Result into ESI
   mov EDI, FirstDest  //ESI and EDI are 2 generic "data moving" registers
                       //ESI = Source, EDI = Destination
                       //MovSB (MoveString Byte, there is also, MovSW word and MovSD double)
                       //MovXX copy from EDI to ESI, and then INC *both* ESI and EDI
                       //  and also DEC ECX (generic string length counter)
                       //But I will not use these as I need to Uppercase the results
   mov ECX, LenOfString//ECX will contain a count of how many chars left to do
@NextChar:
   mov AL, [ESI]       //Move ESI^ into AL
                       //  AL = Char, AX = Word, EAX = DWord, all different parts
                       //  of the same register
   cmp AL, $61
   jl  @NoUpper        // < 'a' don't convert
   cmp AL, $7A
   jg  @NoUpper        // > 'z' don't convert
   and AL, $DF          // Convert to uppercase
@NoUpper:
   mov [EDI], AL       // Put AL back into EDI^  (That's what [] means)
   Inc ESI             //Point to next character
   Inc EDI
   Dec ECX             //Decrement the count, if it reaches 0, the ZERO flag will be set
   jnz @NextChar       //"J"ump if "n"ot "z"ero to the next character
   POP EDI
   POP ESI
end; {asm}
end;
{$ENDIF}

Function Lowercase(Const S:String):String;
{$IFNDEF ASM8086}
var
   Loop:Integer;
   MaxLoop:Integer;

Begin
   Result:=S;
   MaxLoop:=Length(Result);
   For Loop:=MaxLoop downto 1 do
      If Result[Loop] in ['A'..'Z'] then Inc(Result[Loop],32);
End;
{$ELSE} // Original ASM By Peter for UPPERCASE, Ozz added xor logic for LOWERCASE
var
  LenOfString:Integer;
  FirstSource,FirstDest:Pointer;

begin
   LenOfString:=Length(S);
   If LenOfString=0 then Begin
      Result:='';
      Exit;
   End;
   SetLength(Result,LenOfString);
   FirstSource:=Pointer(S);
   FirstDest:=Pointer(Result);
asm
   PUSH ESI            //Firstly and most importantly
   PUSH EDI            //Delphi uses EBX, ESI, EDI extensively, so we need to
                       //push them onto the stack, and then pop them off after
   mov ESI, FirstSource//Move the address of Result into ESI
   mov EDI, FirstDest  //ESI and EDI are 2 generic "data moving" registers
                       //ESI = Source, EDI = Destination
                       //MovSB (MoveString Byte, there is also, MovSW word and MovSD double)
                       //MovXX copy from EDI to ESI, and then INC *both* ESI and EDI
                       //  and also DEC ECX (generic string length counter)
                       //But I will not use these as I need to Uppercase the results
   mov ECX, LenOfString//ECX will contain a count of how many chars left to do
@NextChar:
   mov AL, [ESI]       //Move ESI^ into AL
                       //  AL = Char, AX = Word, EAX = DWord, all different parts
                       //  of the same register
   cmp AL, 'A'
   jl  @NoUpper        // < 'a' don't convert
   cmp AL, 'Z'
   jg  @NoUpper        // > 'z' don't convert
   xor AL, $20          // Convert to lowercase
@NoUpper:
   mov [EDI], AL       // Put AL back into EDI^  (That's what [] means)
   Inc ESI             //Point to next character
   Inc EDI
   Dec ECX             //Decrement the count, if it reaches 0, the ZERO flag will be set
   jnz @NextChar       //"J"ump if "n"ot "z"ero to the next character
   POP EDI
   POP ESI
end; {asm}
end;
{$ENDIF}

Function ProperCase(Const S:String):String;
Var
   Len:Integer;
   MaxLen:Integer;

Begin
   Len:=Length(S);
   MaxLen:=Len;
   SetLength(Result,Len);
   Result:=Lowercase(S);
   While Len>0 do Begin
      If Not (Result[Len] in ['a'..'z']) and (Len<MaxLen) then
         Result[Len+1]:=Upcase(Result[Len+1]);
      Dec(Len);
   End;
   If (MaxLen>0) and (Result[1] in ['a'..'z']) then
      Result[1]:=Upcase(Result[1]);
End;

Function Trim(const S:string):string;
var
   I, L: Integer;
begin
   L := Length(S);
   I := 1;
   while (I <= L) and (S[I] <= ' ') do Inc(I);
   if I > L then Result := ''
   else begin
      while S[L] <= ' ' do Dec(L);
      Result := Copy(S, I, L - I + 1);
   end;
end;

Function NoCRLF(Const S:String):String;
Begin
   Result:=StringReplace(S,#13#10,'',[rfReplaceAll]);
End;

Function NoAngleBrackets(Const S:string):string;
var
   LenOfStr:Integer;

Begin
   Result:=S;
   LenOfStr:=Length(Result);
   If LenOfStr>1 then
      If (Result[1]='<') and (Result[LenOfStr]='>') then
         Result:=Copy(Result,2,LenOfStr-2);
End;

// Known Commands should be a 0 based array!
// For testing Winshoes products against ours, this command is useless to our
// engine. We use a dynamic parser which provides a much more flexible
// development solution for you.
Function InStrArray(const SearchStr:string;Const KnownCommands:Array of String):Integer;
begin
   for Result:=High(KnownCommands) downto Low(KnownCommands) do
      if SearchStr=KnownCommands[Result] then Exit;
   Result:=-1;
end;

Procedure InverseString(Var S:String;Count:Integer);
Var
   TmpStr:String;
   Ctr:Integer;
   Ch:Char;

Begin
   TmpStr:=Copy(S,1,Count);
   Ctr:=0;
   While Count>0 do Begin
      Ch:=TmpStr[Count];
      Dec(Count);
      Move(Ch,S[Ctr+1],1);
      Inc(Ctr);
   End;
End;

Function HexDump(Const S:String):String;
var
   Loop:Integer;
   MaxLoop:Integer;

Begin
   Result:='';
   Loop:=0;
   MaxLoop:=Length(S);
   While Loop<MaxLoop do Begin
      Result:=Result+IntToHex(Ord(S[Loop+1]),2)+#32;
      Inc(Loop);
   End;
End;

Function ReplaceChar(const Source:string;Const OldChar,NewChar:Char):string;
var
   Loop:Integer;

begin
   Result:=Source;
   if OldChar=NewChar then Exit;
   Loop:=Length(Source);
   While Loop>0 do Begin
      if Result[Loop]=OldChar then Result[Loop]:=NewChar;
      Dec(loop);
   End;
end;

Function ExtractLeft(const aSourceString:String;Const Size:Integer):String;
begin
   If Size>Length(aSourceString) then Result:=aSourceString
   Else Begin
      Setlength(Result,Size);
      Move(aSourceString[1],Result[1],Size);
   End;
end;

Function ExtractRight(const aSourceString:String;Const Size:Integer):String;
Var
   Len:Integer;

begin
   Len:=Length(aSourceString);
   If Size>Len then Result:=aSourceString
   Else Begin
      Setlength(Result,Size);
      Move(aSourceString[Len-Pred(Size)],Result[1],Size);
   End;
end;

Function ExtractWordAt(Const Text:String;Position:Integer):String;
Var
   Done:Boolean;
   StartAt:Integer;
   Len:Integer;
   OrgPosition:Integer;

begin
   Len:=Length(Text);
   Result:='';
   Done:=Not (UpCase(Text[Position]) in ['A'..'Z','0'..'9']);
   If (Position>0) and (Position<=Len) and not Done then Begin
      OrgPosition:=Position;
      While (Position>0) and not Done do Begin
         Done:=Not (UpCase(Text[Position]) in ['A'..'Z','0'..'9']);
         If Not Done then Dec(Position);
      End;
      StartAt:=Position;
      Position:=OrgPosition;
      Done:=False;
      While (Position<=Len) and not Done do Begin
         Done:=Not (UpCase(Text[Position]) in ['A'..'Z','0'..'9']);
         If Not Done then Inc(Position);
      End;
      Result:=Copy(Text,StartAt+1,Pred(Position)-StartAt);
   End;
end;

Function LeftJustify(Const S:String;Const MaxLength:Integer):String;
Begin
   Result:=LeftJustifyCh(S,#32,MaxLength);
End;

Function RightJustify(Const S:String;Const MaxLength:Integer):String;
Begin
   Result:=RightJustifyCh(S,#32,MaxLength);
End;

Function CleanChar(Const InChar:Char):Char;
Const
   CtlChars: String[32] = 'oooooooooXoollo><|!Pg*|^v><-^v';
   HiChars: String[64] = 'CueaaaageeeiiiAAEaaooouuyOUcLYPfarounNao?--//!<>***|||||||||||||';
   HiChars2: String[64]= '|--|-+||||=+|=++-=--==-||||*****abcnEduto0nd80En=+><fj/~oo.vn2* ';

Begin
   Case InChar of
      #0..#31:Result:=CtlChars[Ord(InChar)+1];
      #128..#191:Result:=HiChars[Ord(InChar) - 127];
      #192..#255:Result:=HiChars2[Ord(InChar) - 191];
   Else
      Result:=InChar;
   End;
End;

Function CleanStr(Const InStr:String):String;
Begin
   Result:='';
   While Length(Result)<Length(InStr) do
      Result:=Result+CleanChar(InStr[Length(Result)+1]);
End;

Function PosLastChar(Const Ch:Char;Const S:String):Integer;
Var
   I:Integer;

Begin
   i:=Length(S);
   While ((i>0) and (s[i]<>ch)) Do Dec(i);
   Result:=I;
End;

Function AsciiToOem(Const ax:String):String;
var
   i:integer;

begin
   Result:=AX;
   for i:=Length(Result) downto 1  do begin
      Case Ord(Result[i]) of
         132:Result[i]:=Char(228);
         142:Result[i]:=Char(196);
         129:Result[i]:=Char(252);
         154:Result[i]:=Char(220);
         148:Result[i]:=Char(246);
         153:Result[i]:=Char(214);
         225:Result[i]:=Char(223);
      end;
   end;
end;

Function OemToAscii(const ax:String):String;
var
   i:integer;

begin
   Result:=AX;
   for i:=Length(Result) downto 1 do begin
      Case Ord(Result[i]) of
         228:Result[i]:=Char(132);
         196:Result[i]:=Char(142);
         252:Result[i]:=Char(129);
         220:Result[i]:=Char(154);
         246:Result[i]:=Char(148);
         214:Result[i]:=Char(153);
         223:Result[i]:=Char(225);
      end;
   end;
end;

Function WordCount(Const S:string):Integer;
var
   I,Len:Integer;

begin
   Len:=Length(S);
   Result:=0;
   I:=1;
   while I<=Len do begin
      while (i<=len) and ((S[i]=#32) or (S[i]=#9) or (S[i]=';')) do inc(i);
      if I<=len then inc(Result);
      while (I<=len) and (S[i]<>#32) and (S[i]<>#9) and (S[i]<>';') do inc(i);
   end;
End;

Function CRC32ByChar(const Ch:Char;const starting_crc:LONGINT):LONGINT;
Begin
   Result:=crc_32_tab[BYTE(starting_crc XOR LONGINT(Ord(Ch)))] XOR ((starting_crc SHR 8) AND $00FFFFFF)
End;

Function CRC32ByString(Const S:String;Const starting_crc:LONGINT):LONGINT;
Var
   Loop:Integer;
   MaxLoop:Integer;

Begin
   Result:=starting_crc;
   MaxLoop:=Length(S);
   For Loop:=1 to MaxLoop do
      Result:=CRC32ByChar(S[Loop],Result);
End;

Function CRC16ByChar(const Ch:Char;const starting_crc:word):word;
Begin
   Result:=crc_16_tab[BYTE(starting_crc XOR Word(Ord(Ch)))] XOR ((starting_crc SHR 8) AND $00FF)
End;

Function CRC16ByString(const S:String;const starting_crc:word):word;
Var
   Loop:Integer;
   MaxLoop:Integer;

Begin
   Result:=starting_crc;
   MaxLoop:=Length(S);
   For Loop:=1 to MaxLoop do
      Result:=CRC16ByChar(S[Loop],Result);
End;

Function CRCARCByChar(const Ch:Char;const starting_crc:word):word;
Begin
   Result:=crc_arc_tab[BYTE(starting_crc XOR Word(Ord(Ch)))] XOR ((starting_crc SHR 8) AND $00FF)
End;

Function CRCARCByString(const S:String;const starting_crc:word):word;
Var
   Loop:Integer;
   MaxLoop:Integer;

Begin
   Result:=starting_crc;
   MaxLoop:=Length(S);
   For Loop:=1 to MaxLoop do
      Result:=CRCARCByChar(S[Loop],Result);
End;


Procedure SetLongBit(Var L:LongInt;Const Bit:Byte;Const Setting:Boolean);
Var
   Mask:LongInt;

Begin
   Mask:=1;
   Mask:=Mask Shl (Bit-1);
   If Setting Then L:=L or Mask
   Else L:=(L and (Not Mask));
End;

Function GetLongBit(const L:LongInt;const Bit:Byte):Boolean;
Var
   Mask:LongInt;

Begin
  Mask:=1;
  Mask:=Mask Shl (Bit-1);
  Result:=(L and Mask)<>0;
End;

Procedure SetWordBit(Var L:Word;const Bit:Byte;const Setting:Boolean);
Var
   Mask:Word;

Begin
   Mask:=1;
   Mask:=Mask Shl (Bit-1);
   If Setting Then L:=L or Mask
   Else L:=(L and (Not Mask));
End;

Function GetWordBit(const L:Word;const Bit:Byte):Boolean;
Var
   Mask:Word;

Begin
   Mask:=1;
   Mask:=Mask Shl (Bit-1);
   Result:=(L and Mask)<>0;
End;

Procedure SetByteBit(Var L:Byte;const Bit:Byte;const Setting:Boolean);
Var
   Mask:Byte;

Begin
   Mask:=1;
   Mask:=Mask Shl (Bit-1);
   If Setting Then L:=L or Mask
   Else L:=(L and (Not Mask));
End;

Function GetByteBit(const L:Byte;const Bit:Byte):Boolean;
Var
   Mask:Byte;

Begin
   Mask:=1;
   Mask:=Mask Shl (Bit-1);
   Result:=(L and Mask)<>0;
End;

Function Replicate(const Source:String;NumberOfTimes:Integer):String;
Var
   SourceLength:Integer;
   Dest:Integer;

Begin
// designed this way, for BIG strings!
   Dest:=1;
   SourceLength:=Length(Source);
   SetLength(Result,SourceLength * NumberOfTimes);
   While NumberOfTimes>0 do Begin
      Move(Source[1],Result[Dest],SourceLength);
      Inc(Dest,SourceLength);
      Dec(NumberOfTimes);
   End;
End;

Function IsWildCard(const Source:String):Boolean;
Begin
   Result:=CharPos('*',Source)+CharPos('?',Source)+CharPos('%',Source)>0;
End;

///////////////////////////////////////////////////////////////////////////////
// Internet Routines
///////////////////////////////////////////////////////////////////////////////
Function GetIndex(Const c:char):Integer;
var
   i:Integer;
{$IFDEF ASM8086}
   S:String;
{$ENDIF}

begin
{$IFNDEF ASM8086}
   i:=CharPos(c,Alphabet);  //overkill for just 1 character
{$ELSE}
   S := Alphabet;
asm
   PUSH EDI                 //Preserve this register
   mov  EDI, S              //Point EDI at Alphabet string
   mov  ECX, AlphaBetLength //Tell CPU how big Alphabet is
   mov  AL,  C              //and which char we want
   RepNE ScaSB              //"Rep"eat while "N"ot "E"qual
                            //this is the same as
                            //While (EDI^ <> AL) and (ECX>0) do begin
                            //  Inc(EDI);
                            //  Dec(ECX);
                            //end;
   jnz  @NotFound           //Zero flag will be set if there was a match
   sub  EDI, S              //EDI has been incremented, so EDI-OrigAdress = Char pos !
   mov  I,   EDI
@NotFound:
   POP  EDI
end;
{$ENDIF}
   if (i>0) then Dec(i);
   result:=i;
end;

//gsw and ozz
function DecodeUnit(Const InStr:String):ShortString;
var
   a,b,c,d:Byte;


begin
   a:=GetIndex(InStr[1]);
   b:=GetIndex(InStr[2]);
   If InStr[3]='=' then Begin
      SetLength(Result,1);
      result[1]:=chr((a shl 2) or (b shr 4));
   end
   Else If InStr[4]='=' then Begin
      SetLength(Result,2);
      c:=GetIndex(InStr[3]);
      result[1]:=chr((a shl 2) or (b shr 4));
      result[2]:=chr((b shl 4) or (c shr 2));
   End
   Else Begin
      c:=GetIndex(InStr[3]);
      d:=GetIndex(InStr[4]);
      SetLength(result,3);
      result[1]:=chr((a shl 2) or (b shr 4));
      result[2]:=chr((b shl 4) or (c shr 2));
      result[3]:=chr((c shl 6) or d);
   End;
end;


Function Base64ToString(Const S:String):String;
var
  i:Integer;

begin
   Result:='';
   for i:=((Length(s) div 4)-1) downto 0  do
      Result:=DecodeUnit(Copy(s,i*4+1,4))+Result;
end;

Function StringToBase64(Const S1:String):String;
Const
   Table:String='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

var
  I,K,L: Word;
  S: String;

begin
  L := Length(S1);
  if L mod 3 <> 0 then Inc(L, 3);
  SetLength(S,(L div 3) * 4);
  FillChar(S[1], Length(S), '=');
  I := 0;
  K := 1;
  while I < Length(S1) do
    begin
      S[K]   := Table[1+(Ord(S1[I+1]) shr 2)];
      S[K+1] := Table[1+(((Ord(S1[I+1]) and $03) shl 4) or (Ord(S1[I+2]) shr 4))];
      if I+1 >= Length(S1) then Break;
      S[K+2] := Table[1+(((Ord(S1[I+2]) and $0F) shl 2) or (Ord(S1[I+3]) shr 6))];
      if I+2 >= Length(S1) then Break;
      S[K+3] := Table[1+(Ord(S1[I+3]) and $3F)];
      Inc(I, 3);
      Inc(K, 4);
    end;
  Result := S;
End;

{Function StringToBase64(Const S1:String):String;
Const
   Table:String='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

var
  B:Array[0..65000] of Byte;
  I,K,L: Word;
  S: String;

begin
  FillChar(B, SizeOf(B), 0);
  Move(S1[1], B, Length(S1));
  L := Length(S1);
  if L mod 3 <> 0 then Inc(L, 3);
//  S[0] := Char((L div 3) * 4);
  SetLength(S,(L div 3) * 4);
  FillChar(S[1], Length(S), '=');
  I := 0;
  K := 1;
  while I < Length(S1) do
    begin
      S[K]   := Table[1+(B[I] shr 2)];
      S[K+1] := Table[1+(((B[I] and $03) shl 4) or (B[I+1] shr 4))];
      if I+1 >= Length(S1) then Break;
      S[K+2] := Table[1+(((B[I+1] and $0F) shl 2) or (B[I+2] shr 6))];
      if I+2 >= Length(S1) then Break;
      S[K+3] := Table[1+(B[I+2] and $3F)];
      Inc(I, 3); Inc(K, 4);
    end;
  Result := S;
End;}

function FixDottedIP(Const S:string):string;
var
   n:Cardinal;

begin
   Result:='.'+S;
   n:=QuickPos('.0',Result);
   while n>0 do begin
      Delete(Result,n+1,1);
      n:=QuickPos('.0',Result);
   end;
   n:=QuickPos('..',Result);
   While N>0 do begin
      Insert('0',Result,n+1);
      n:=QuickPos('..',Result);
   End;
   If Result[Length(Result)]='.' then Result:=Result+'0';
   Delete(Result,1,1);
end;

Function IPStringFormated(S:String):String;
Var
   n1,n2,n3,n4:Integer;

Begin
   N1:=StrToInt(Copy(S,1,CharPos('.',S)-1));
   Delete(S,1,CharPos('.',S));
   N2:=StrToInt(Copy(S,1,CharPos('.',S)-1));
   Delete(S,1,CharPos('.',S));
   N3:=StrToInt(Copy(S,1,CharPos('.',S)-1));
   Delete(S,1,CharPos('.',S));
   N4:=StringToInteger(S);
   Result:=IPAddressFormatted(N1,N2,N3,N4);
End;

Function IPAddressFormatted(Const I1,I2,I3,I4:Integer):String;
Begin
   Result:=IntToStr(I4);
   While Length(Result)<3 do Result:='0'+Result;
   Result:=IntToStr(I3)+'.'+Result;
   While Length(Result)<7 do Result:='0'+Result;
   Result:=IntToStr(I2)+'.'+Result;
   While Length(Result)<11 do Result:='0'+Result;
   Result:=IntToStr(I1)+'.'+Result;
   While Length(Result)<15 do Result:='0'+Result;
End;

function EscapeDecode(Const S:String):String;
var
   ch:Char;
   val:String;
   I:Integer;

begin
   Result:=S;
   I:=CharPos('%',Result);
   While I>0 do Begin
      Val:='$'+Copy(Result,I+1,2);
try
      Ch:=Char(StrToInt(Val));
except
      Ch:='a'; // 2.0.12
end;
      Result:=Copy(Result,1,I-1)+Ch+Copy(Result,I+3,Length(Result));
      I:=CharPos('%',Result);
   End;
   I:=CharPos('+',Result);
   While I>0 do Begin
      Result:=Copy(Result,1,I-1)+#32+Copy(Result,I+1,Length(Result));
      I:=CharPos('+',Result);
   End;
end;

Function EscapeEncode(Const S:String):String;
Var
   Loop:Integer;
   MaxLoop:Integer;

Begin
   Result:='';
   MaxLoop:=Length(S);
   For Loop:=1 to MaxLoop do
      If S[Loop] in ['0'..'9','.','-'] then Result:=Result+S[Loop] // 2.0.12
      Else
      If S[Loop]=#32 then Result:=Result+'+' //2.0.12 RC2
      Else
      If (S[Loop]<#21) or // 2.0.12 RC2
         (S[Loop]>#127)
         then Result:=Result+'%'+IntToHex(Ord(S[Loop]),2)
      Else Result:=Result+S[Loop]
End;

Function EncodeDomain(S:String):String;
Var
   Dot:Integer;

Begin
   Result:='';
   While (S<>'') do Begin
      Dot:=CharPos('.',S);
      Case Dot of
         0:Begin
            Result:=Result+Chr(Length(S))+S;
            S:='';
         End;
         Else Begin
            Result:=Result+Chr(Dot-1)+Copy(S,1,Dot-1);
            Delete(S,1,Dot);
         End;
      End;
   End;
   Result:=Result+#0;
End;

Function EncodeAddress(S:String):String;
Var
   Dot:Integer;

Begin
   Result:='';
   While (S<>'') do Begin
      Dot:=Pos('.',S);
      Case Dot of
         0:Begin
            Result:=Result+Chr(Length(S))+S;
            S:='';
         End;
         Else Begin
            Result:=Result+Chr(Dot-1)+Copy(S,1,Dot-1);
            Delete(S,1,Dot);
         End;
      End;
   End;
   Result:=Result+#7'in-addr'#4'arpa'#0;
End;

Function DecodeDomain(S:String):String;
Var
   L:Integer;

Begin
   Result:='';
   While Length(S)>0 do Begin
      L:=Ord(S[1]);
      If L>Length(S) then Begin
         Result:='';
         Exit;
      End;
      Result:=Result+Copy(S,2,L)+'.';
      Delete(S,1,L+1);
   End;
   If Copy(Result,Length(Result),1)='.'Then Delete(Result,Length(Result),1);
End;

Function GetActualEmailAddress(Parm,Command:String):String;
Var
   Colon,Quote:Integer;

begin
   // posibilities are:
   // [cmd]:<mailadrress>
   // [cmd] :<mailadrress>
   // [cmd]: <mailadrress>
   // [cmd] : <mailadrress>
   // [cmd] <mailadrress>
   // [cmd]<mailadrress>
   // you can also have "firstname lastname" in there also
   Quote:=CharPos('"',Parm);
   If Quote>0 then Begin
      If CharPos('>',Parm)>Quote then Begin
         Delete(Parm,1,Quote);
         Delete(Parm,1,CharPos('"',Parm));
      End
      Else Begin // 2.3
         Colon:=PosLastChar('"',Parm);
         Delete(Parm,Quote,Colon-Pred(Quote));
      End;
   End;
   // check if space, if so let remove everything before
   Trim(Parm);
   // ok now possibilities are:
   // [cmd]:<mailadrress>
   // :<mailadrress>
   // : <mailadrress>
   // [cmd]<mailadrress>
   Colon:=CharPos(':',Parm);
   // check if colon, if so let remove everything before
   If Colon>0 then
      Delete(Parm,1,Colon);
   // ok now possibilities are:
   //  <mailadrress>
   // [cmd]<mailadrress>
   // now let check if we have a command
   if lowercase(copy(parm,1,length(command)))=lowercase(command) then
      delete(Parm,1,length(command));
   // we trim to make sure we dont have any space left in there
   Parm:=Trim(Parm);
   // and return the result with no brackets
   Result:=NoAngleBrackets(Parm);
End;

///////////////////////////////////////////////////////////////////////////////
// Date and/or Time Routines
///////////////////////////////////////////////////////////////////////////////

Function DayOfTheYear(const DT:TDateTime):Integer;
Var
   J,Y:Word;

begin
   DecodeDate(DT,Y,J,J);
   Result:=Trunc(DT)-Trunc(EncodeDate(Y,1,1))+1;
end;

{$WARNINGS OFF}
Function DaysLeftThisYear(const DT:TDateTime):Integer;
Var
   J,Y:Word;

begin
   DecodeDate(DT,Y,J,J);
   Case IsLeapYear(Y) of
      True:Result:=366-DayOfTheYear(DT);
      False:Result:=365-DayOfTheYear(DT);
   End;
end;
{$WARNINGS ON}

Function DaysThisMonth(const DT:TDateTime):Integer;
Var
   J,M,Y:Word;

begin
   DecodeDate(DT,Y,M,J);
   Case M of
       2:If IsLeapYear(Y) then Result:=29
         Else Result:=28;
       4,6,9,11:Result:=30;
       Else Result:=31;
   End;
end;

Function DaysLeftThisMonth(const DT:TDateTime):Integer;
Var
   J,M,Y:Word;

begin
   DecodeDate(DT,Y,M,J);
   Case M of
       2:If IsLeapYear(Y) then Result:=29
         Else Result:=28;
       4,6,9,11:Result:=30;
       Else Result:=31;
   End;
   Result:=Result-J;
end;

Function IsTimeAM(const DT:TDateTime):Boolean;
begin
   Result:=Frac(DT)<0.5;
end;

Function IsTimePM(const DT:TDateTime):Boolean;
begin
   Result:=Frac(DT)>0.5;
end;

Function IsTimeNoon(const DT:TDateTime):Boolean;
begin
   Result:=Frac(DT)=0.5;
end;

Function IsTimeMidnight(const DT:TDateTime):Boolean;
begin
   Result:=Frac(DT)=0.0;
end;

Function DateTimeToGMT(const DT:TDateTime):TDateTime;
begin
   Result:=DT+LocalTimeZoneBias/1440;
end;

Function DateTimeToLocal(const DT:TDateTime):TDateTime;
begin
   Result:=DT-LocalTimeZoneBias/1440;
end;

Function IsLeapYear(Const Year:Word):Boolean;
begin
   Result:=((Year and 3)=0) and ((Year mod 100>0) or (Year mod 400=0));
end;

Function LocalTimeZoneBias:Integer;
{$IFDEF LINUX}
Var
   TV:TTimeval;
   TZ:TTimezone;

Begin
   gettimeofday(TV,TZ);
   Result:=TZ.tz_minuteswest;
End;
{$ELSE}
var
   TimeZoneInformation:TTimeZoneInformation;
   Bias:Longint;

begin
   case GetTimeZoneInformation(TimeZoneInformation) of
      TIME_ZONE_ID_STANDARD:Bias:=TimeZoneInformation.Bias+TimeZoneInformation.StandardBias;
      TIME_ZONE_ID_DAYLIGHT:Bias:=TimeZoneInformation.Bias+((TimeZoneInformation.DaylightBias div 60)*-100);
      else Bias:=TimeZoneInformation.Bias;
   End;
   Result:=Bias;
End;
{$ENDIF}

Function  TimeZone:String;
{$IFDEF LINUX}
Begin
   Result:=ShortTimeZone;
End;
{$ELSE}
var
   lpTimeZoneInfo:TTimeZoneInformation;

Begin
   Result:='';
   If GetTimeZoneInformation(lpTimeZoneInfo)=TIME_ZONE_ID_STANDARD then
      {$IFDEF VER90}
      Result:=WideCharToString({@}Pointer(lpTimeZoneInfo.StandardName))
      {$ELSE}
      Result:=lpTimeZoneInfo.StandardName
      {$ENDIF}
   Else
      If GetTimeZoneInformation(lpTimeZoneInfo)=TIME_ZONE_ID_DAYLIGHT then
      {$IFDEF VER90}
      Result:=WideCharToString({@}Pointer(lpTimeZoneInfo.DaylightName));
      {$ELSE}
      Result:=lpTimeZoneInfo.DaylightName;
      {$ENDIF}
End;
{$ENDIF}

Function  ShortTimeZone:String;
{$IFDEF LINUX}
var
  T: TTime_T;
  UT: TUnixTime;

begin
  __time(@T);
  localtime_r(@T, {$IFDEF FPC}@{$ENDIF}UT);
  Result:=PChar(UT.__tm_zone);
End;
{$ELSE}
Var
   TPos:Integer;

Begin
   Result:=TimeZone;
   TPos:=1;
   While TPos<=Length(Result) do
      If Not (Result[TPos] in ['A'..'Z']) then Delete(Result,TPos,1)
      Else Inc(TPos);
End;
{$ENDIF}

Function  TimeZoneBias:String; // this correct? 2.0.12
Begin
   Result:=IntToStr(LocalTimeZoneBIAS);
   While Length(Result)<4 do Result:='0'+Result;
   If IsNumeric(Result[1]) then Result:='-'+Result;
End;

Function ToUnixSlashes(Const S:String):String;
{.$IFNDEF ASM8086}
var
   Loop:Integer;
   MaxLoop:Integer;

begin
   Result:=S;
   MaxLoop:=Length(Result);
   For Loop:=1 to MaxLoop do If Result[Loop]='\' then Result[Loop]:='/';
end;
(*
{$ElSE}
Var
   LenOfResult:Integer;
   FirstChar:Pointer;

Begin
   Result:=S;
   LenOfResult:=Length(Result);
   If LenOfResult<1 then Exit; //2.4
   FirstChar:=Pointer(Result);
asm
   push ESI
   mov  ESI, FirstChar;
   mov  ECX, LenOfResult
@Loop:
   mov  Al, [ESI]
   cmp  Al, '\'
   jne  @NoChange
   mov  Al, '/'
   mov  [ESI], Al
@NoChange:
   Inc  ESI
   Dec  ECX
   jnz  @Loop
   pop  ESI
end;
End;
{$ENDIF}
*)

Function ToDOSSlashes(Const S:String):String;
{.$IFNDEF ASM8086}
var
   Loop:Integer;
   MaxLoop:Integer;

begin
   Result:=S;
   MaxLoop:=Length(Result);
   For Loop:=1 to MaxLoop do If Result[Loop]='/' then Result[Loop]:='\';
end;
(*
{$ElSE}
Var
   LenOfResult:Integer;
   FirstChar:Pointer;

Begin
   Result:=S;
   LenOfResult:=Length(Result);
   If LenOfResult<1 then Exit; //2.0.12 RC2
   FirstChar:=Pointer(Result);
asm
   push ESI
   mov  ESI, FirstChar;
   mov  ECX, LenOfResult
@Loop:
   mov  Al, [ESI]
   cmp  Al, '/'
   jne  @NoChange
   mov  Al, '\'
   mov  [ESI], Al
@NoChange:
   Inc  ESI
   Dec  ECX
   jnz  @Loop
   pop  ESI
end;
End;
{$ENDIF}
*)

Function ToOSSlashes(Const S:String):String; // 2.3
Begin
{$IFDEF LINUX}
   Result:=ToUnixSlashes(S);
{$ELSE}
   Result:=ToDOSSlashes(S);
{$ENDIF}
End;

(******************************************************************************
CHANGEDIR: {Rewritten to call Windows.API for the result!}
          The GetFullPathName function merges the name of the current drive and
          directory with the specified filename to determine the full path and
          filename of the specified file. It also calculates the address of the
          filename portion of the full path and filename. This function does not
          verify that the resulting path and filename are valid or that they
          refer to an existing file on the associated volume.
******************************************************************************)
Function ChangeDir(Const S,RP:String):String;
{$IFDEF LINUX}
Begin
   Result:=''; // redesign
End;
{$ELSE}
var
  FileName:String;
  FName: PChar;
  Buffer: array[0..MAX_PATH - 1] of Char;

begin
   FileName:=ToDOSSlashes(S+RP);
   SetString(Result,Buffer,GetFullPathName(PChar(FileName),SizeOf(Buffer),
      Buffer,FName));
End;
{$ENDIF}

Function DateTimeToGMTRFC822(Const DT:TDateTime):String;
Begin
   Result:=FormatDateTime('ddd, dd mmm yyyy hh:nn:ss',DateTimeToGMT(DT))+' GMT';
End;

Function DateTimeToGMTRFC850(Const DT:TDateTime):String;
Begin
   Result:=FormatDateTime('dddd, dd-mmm-yy hh:nn:ss',DateTimeToGMT(DT))+' GMT';
End;

Function DateTimeToRFC850(Const DT:TDateTime):String;
Begin
   Result:=FormatDateTime('dddd, dd-mmm-yy hh:nn:ss',DT)+#32+ShortTimeZone;
End;

Function DateTimeToRFC850Bias(Const DT:TDateTime):String;
Begin
   Result:=FormatDateTime('ddd, dd mmm yyyy hh:nn:ss',DT)+#32+TimeZoneBias;
End;

Function RFCToDateTime(S:String):TDateTime;
Var
   M,D,Y:Word;
   H,N,Sc,T:Word;
   Ch,CHtag:Char;
   Ts:String;
   PosCh:integer;

Begin

   // added bu gsw
   posch:=CharPos(';',S);
   if posch>0 then
    delete(s,posCH,length(s)-posCh+1);
   //
   T:=0;
// Figure out which format S is...
   Ch:=S[3];
   S:=Uppercase(S);
   If Ch=#32 then Begin // ANSI C ASCTIME()
      Delete(S,1,4); {remove DDD#32}
      Ts:=Copy(S,1,CharPos(#32,S)-1);
      Delete(S,1,Length(TS));
      S:=Trim(S);
      M:=QuickPos(TS,#32#32'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC') div 3;
      Ts:=Copy(S,1,CharPos(#32,S)-1);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      D:=StrToInt(TS);
except
      D:=1;
end;
      Ch:=S[3];
      If Ch<>':' then Begin {timestamp was not where we expected it, so it must be YEAR}
         Ts:=Copy(S,1,CharPos(#32,S)-1);
         Delete(S,1,Length(TS)+1);
         S:=Trim(S);
try
         Y:=StrToInt(TS);
except
         DecodeDate(Now,Y,T,T);
         T:=0;
end;
      End;
      Ts:=Copy(S,1,CharPos(':',S)-1);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      H:=StrToInt(TS);
Except
      H:=0;
End;
      Ts:=Copy(S,1,2);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      N:=StrToInt(TS);
Except
      N:=0;
End;
      Ts:=Copy(S,1,2);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      Sc:=StrToInt(TS);
Except
      Sc:=0;
End;
      If S<>'' then Begin {just insase it is setup wrong}
         Ch:=S[1];
         If Ch in ['0'..'9'] then Begin
try
            Y:=StrToInt(S);
except
            DecodeDate(Now,Y,T,T);
            T:=0;
end;
         End;
      End;
   End
   Else if Ch=',' then Begin // RFC 822 or RFC 1123
      Delete(S,1,CharPos(#32,S));
      S:=Trim(S);
      Ts:=Copy(S,1,CharPos(#32,S)-1);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      D:=StrToInt(TS);
except
      D:=1;
end;
      Ts:=Copy(S,1,CharPos(#32,S)-1);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);

      M:=QuickPos(TS,#32#32'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC') div 3;
      Ts:=Copy(S,1,CharPos(#32,S)-1);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      Y:=StrToInt(TS);
except
      DecodeDate(Now,Y,T,T);
      T:=0;
end;
      Ts:=Copy(S,1,CharPos(':',S)-1);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      H:=StrToInt(TS);
Except
      H:=0;
End;
      Ts:=Copy(S,1,2);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      N:=StrToInt(TS);
Except
      N:=0;
End;
      Ts:=Copy(S,1,2);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      Sc:=StrToInt(TS);
Except
      Sc:=0;
End;
   End
   Else
   Begin // RFC 850 or RFC 1036
      Delete(S,1,CharPos(#32,S));
      S:=Trim(S);

      // added by Gsw
      chtag:='-';
      posCh:=charpos(chtag,S);
      if (posCH>0) and (posCh<5) then
       chtag:='-'
      else
       chtag:=' ';
      //

      Ts:=Copy(S,1,CharPos(chtag,S)-1); // mod by gsw
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      D:=StrToInt(TS);
except
      D:=1;
end;
      Ts:=Copy(S,1,CharPos(chtag,S)-1); // mod by gsw
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
      M:=QuickPos(TS,#32#32'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC') div 3;
      Ts:=Copy(S,1,CharPos(#32,S)-1);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      Y:=StrToInt(TS);
except
      DecodeDate(Now,Y,T,T);
      T:=0;
end;
      Ts:=Copy(S,1,CharPos(':',S)-1);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      H:=StrToInt(TS);
Except
      H:=0;
End;
      Ts:=Copy(S,1,2);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      N:=StrToInt(TS);
Except
      N:=0;
End;
      Ts:=Copy(S,1,2);
      Delete(S,1,Length(TS)+1);
      S:=Trim(S);
try
      Sc:=StrToInt(TS);
Except
      Sc:=0;
End;
   End;
   // Clean up non-century type timestamps.
   If Y<100 then Begin
      DecodeDate(Now,Y,T,T);
{      If Y>1999 then Y:=Y+2000
      Else Y:=Y+1900;} {2.0.h}
   End;
   try  // added by gsw
    Result:=EncodeDate(Y,M,D)+EncodeTime(H,N,Sc,T);
   except
    result:=now;
   end;
End;

PROCEDURE UNPACKTIME(Const P:LONGINT;VAR DT:TDATETIME);
BEGIN
   DT:=FILEDATETODATETIME(P);
END;

PROCEDURE PACKTIME(VAR DT:TDATETIME;VAR P:LONGINT);
BEGIN
   P:=DATETIMETOFILEDATE(DT);
END;

Function GetDosDate: LongInt;
Begin
   Result:=DATETIMETOFILEDATE(Now);
End;

Function GetDOW:Word;
Begin
   Result:=DayOfWeek(Now);
End;

Function TimeOut(Const MyTime:DWord):Boolean;
Begin
   Result:=MyTime<=TimeCounter;
End;

Function TimeCounter:DWord;
{$IFDEF LINUX}
Var
   TV:TTimeval;

Begin
   gettimeofday(TV,nil);
   Result:=(TV.tv_sec*1000)+(TV.tv_usec div 1000);
End;
(* the following code returns EPOCH
var
  T: TTime_T;
begin
  __time(@T);
  Result:=T;
end;
//*)
{$ELSE}
Var
   lpSystemTimeAsFileTime:TFileTime;
   X:Cardinal;

Begin
   GetSystemTimeAsFileTime(lpSystemTimeAsFileTime);
   {$WARNINGS OFF}
   If lpSystemTimeAsFileTime.dwLowDateTime<0 then X:=lpSystemTimeAsFileTime.dwLowDateTime shr 1
   {$WARNINGS ON}
   Else X:=lpSystemTimeAsFileTime.dwLowDateTime;
   Result:=(((lpSystemTimeAsFileTime.dwHighDateTime mod 1000)*1000000)+
         X div 10000);
//   Result:=GetTickCount;
End;
{$ENDIF}

Function AddBackSlash(Const S:String):String;
Begin
   Result:=S;
   If Copy(Result,Length(Result),1)<>'\' then Result:=Result+'\';
End;

Function  NoBackSlash(Const S:String):String;
Var
   I:Integer;

Begin
   Result:=S;
   I:=Length(S);
   If I>0 then
      If Result[I]='\' then Delete(Result,Length(Result),1);
End;

{$IFDEF VER100} // Delphi3 code
function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    {$IFDEF VER90}
    Offset := Pos(Patt, SearchStr);
    {$ELSE}
    Offset := AnsiPos(Patt, SearchStr);
    {$ENDIF}
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;

procedure FreeAndNil(var Obj);
var
   Temp:TObject;

begin
   Temp:=TObject(Obj);
   Pointer(Obj):=nil;
   Temp.Free;
end;
{$ENDIF}

function PCharLen(Str:PChar):integer; // both the pas and asm are 3.8 times faster than SysUtil StrLen!!
{$IFDEF ASM8086}
asm
      MOV     EDX,7
      ADD     EDX,EAX                   { pointer+7 used in the end }
      PUSH    EBX                       { is necessary; even in your version}
      MOV     EBX,[EAX]                 { read first 4 bytes}
      ADD     EAX,4                     { increment pointer}
@L1:  LEA     ECX,[EBX-$01010101]       { subtract 1 from each byte}
      XOR     EBX,-1                    { invert all bytes}
      AND     ECX,EBX                   { and these two}
      MOV     EBX,[EAX]                 { read next 4 bytes}
      ADD     EAX,4                     { increment pointer}
      AND     ECX,80808080H             { test all sign bits}
      JZ      @L1                       { no zero bytes, continue loop}
      TEST    ECX,00008080H             { test first two bytes}
      JNZ     @L2                       { *was JNZ SHORT @L2*}
      SHR     ECX,16                    { not in the first 2 bytes}
      ADD     EAX,2
@L2:  SHL     CL,1                      { use carry flag to avoid a branch}
      POP     EBX                       { Likewise; see above}
      SBB     EAX,EDX                   { compute length}
end;
{$ELSE}
var
  p:^cardinal;
  q:pchar;
  bytes,r1,r2:cardinal;
begin
  p:=pointer(tStr);
  repeat
    q:=pchar(p^);
    r2:=cardinal({@}Pointer(q[-$01010101]));
    r1:=cardinal(q) xor $FFFFFFFF;
    bytes:=r1 and r2;
    inc(p);
  until (bytes and $80808080)<>0;
  result:=integer(p)-integer(tStr)-4;
  if (bytes and $00008080)=0 then
  begin
    bytes:=bytes shr 16;
    inc(result,2);
  end;
  if (bytes and $80)=0 then
    inc(result);
end;
{$ENDIF}

{$IFDEF ASM8086}
function LRot16(X: Word; c: longint): Word; assembler;
asm
  mov ecx,&c
  mov ax,&X
  rol ax,cl
  mov &Result,ax
end;

function RRot16(X: Word; c: longint): Word; assembler;
asm
  mov ecx,&c
  mov ax,&X
  ror ax,cl
  mov &Result,ax
end;

function LRot32(X: DWord; c: longint): DWord; register; assembler;
asm
  mov ecx, edx
  rol eax, cl
end;

function RRot32(X: DWord; c: longint): DWord; register; assembler;
asm
  mov ecx, edx
  ror eax, cl
end;

function SwapDWord(X: DWord): DWord; register; assembler;
asm
  xchg al,ah
  rol  eax,16
  xchg al,ah
end;

{$ELSE}
function LRot16(X: Word; c: longint): Word;
begin
  LRot16:= (X shl c) or (X shr (16 - c));
end;

function RRot16(X: Word; c: longint): Word;
begin
  RRot16:= (X shr c) or (X shl (16 - c));
end;

function LRot32(X: DWord; c: longint): DWord;
begin
  LRot32:= (X shl c) or (X shr (32 - c));
end;

function RRot32(X: DWord; c: longint): DWord;
begin
  RRot32:= (X shr c) or (X shl (32 - c));
end;

function SwapDWord(X: DWord): DWord;
begin
  Result:= (X shr 24) or ((X shr 8) and $FF00) or ((X shl 8) and $FF0000) or (X shl 24);
end;
{$ENDIF}

///////////////////////////////////////////////////////////////////////////////
// DXSock 3.0 Additions
///////////////////////////////////////////////////////////////////////////////
Function Center(S:String;MaxWidth:Integer):String;
Var
   I:Integer;
   Ws:String;

Begin
   If Length(S) mod 2=0 then Result:=S
   Else Result:=S+#32;
   If Length(Result)>=MaxWidth then Exit;
   I:=MaxWidth-Length(Result);
   If I mod 2<>0 then Begin
      Result:=Result+#32;
      Dec(I);
   End;
   If I>0 then Begin
      SetLength(Ws,I div 2);
      FillChar(Ws[1],I div 2,#32);
      Result:=Ws+Result+Ws;
   End;
End;

Function LeftJustifyCh(Const S:String;Const Ch:Char;Const MaxLength:Integer):String;
Begin
   If MaxLength<Length(S) then Begin //2.4
      Result:=Copy(S,1,MaxLength);
      Exit;
   End;
   SetLength(Result,MaxLength);
   FillChar(Result[1],MaxLength,Ch);
   Move(S[1],Result[1],Min(MaxLength,Length(S)));
End;

Function RightJustifyCh(Const S:String;Const Ch:Char;Const MaxLength:Integer):String;
Begin
   If MaxLength<Length(S) then Begin //2.4
      Result:=Copy(S,1,MaxLength);
      Exit;
   End;
   SetLength(Result,MaxLength);
   FillChar(Result[1],MaxLength,Ch);
   Move(S[1],Result[MaxLength-Pred(Length(S))],Min(MaxLength,Length(S)));
End;

Function EncodeTabs(S:string;TabSize:Byte):string;
Var
   Ws:String;

Begin
   Setlength(Ws,Tabsize);
   FillChar(Ws[1],TabSize,#32);
   Result:=StringReplace(S,Ws,#9,[rfReplaceAll]);
End;

Function DecodeTabs(S:string;TabSize:Byte):string;
Var
   Ws:String;

Begin
   Setlength(Ws,Tabsize);
   FillChar(Ws[1],TabSize,#32);
   Result:=StringReplace(S,#9,Ws,[rfReplaceAll]);
End;

function Filter(S:String;CS:CharSet):String;
Var
   Loop:Integer;

Begin
   Result:='';
   for Loop:=1 to Length(S) do Begin
      If not(S[Loop] in CS) then begin
         Result:=Result+S[Loop];
      end;
   end;
End;

Function SoundEx(S:String):String;
Const
   Table:Array[1..26] Of Char='.123.12..22455.12623.1.2.2';

Var
   SoundString:String[255];
   I1          : Integer;
   I2          : Integer;
   isNum       : boolean;
   Ch:Char;

Begin
   Result:=S;
   If S='' then Exit;
   isNum:=true;
   Repeat
      Ch:=UpCase(S[1]);
      if Ch>#64 then isNum:=false
      else Delete(S,1,1);
   until (isNum=false) or (S='');
   Result:=S;
   If S='' then Exit;
   SoundString[0]:=#255;
   FillChar(SoundString[1],255,'0');
// Step 1: ASCII to Soundex
   For I1:=1 to Length(S)-1 Do Begin
      I2:=Ord(UpCase(S[I1+1]))-64;
      If ((I2<1) Or (I2>26)) Then I2:=1;
      SoundString[I1]:=Table[I2];
   End;
// Initialize for second pass
   I1 := 1;
   Repeat
      While(SoundString[I1]='.') Do Delete(SoundString,I1,1);
      While((SoundString[I1]=SoundString[I1+1]) And (SoundString[I1]<>'0')) Do Delete(SoundString, I1, 1);
      Inc(I1);
   Until(SoundString[I1]='0');
   Result:=Ch+Copy(SoundString,1,3);
End;

function WildCompare(LookingFor,SourceStr:String):Boolean;
Var
   Ws:String;
   MaxInputWord:Integer;
   MaxWild:Integer;
   cInput:Integer;
   cWild:Integer;
   HelpWild:String;
   LengthHelpWild:Integer;
   Q:Integer;

function FindPart(helpwilds,input_word:string):integer;
Var
   Q1,Q2,Q3:Integer;
//   Between:Integer;
   Diff:Integer;

begin
   Q1:=CharPos('?',helpwilds);
   if Q1=0 then Result:=QuickPos(helpwilds,input_word)
   else Begin
      Q3:=Length(helpwilds);
      Diff:=Length(input_word)-Q3;
      If Diff<0 then begin
         Result:=0;
         Exit;
      end;
//      Between:=0;
      for Q1:=0 to Diff do begin
         for Q2:=1 to Q3 do begin
            If (input_word[Q1+Q2]=helpwilds[Q2]) or
               (helpwilds[Q2]='?') then begin
               if Q2=Q3 then Begin
                  Result:=Q1+1;
                  Exit;
               end;
            End
            else Break;
         End;
      End;
      Result:=0;
   end;
end;

function SearchNext(Var WildS:String):Integer;
Begin
   Result:=CharPos('*',WildS);
   If Result<>0 then WildS:=Copy(WildS,1,Result-1);
End;

Begin
   Ws:=LookingFor;
   While CharPos('%',Ws)>0 do Ws[CharPos('%',Ws)]:='*';
   While QuickPos('**',Ws)>0 do Delete(Ws,QuickPos('**',Ws),1);
   MaxInputWord:=Length(SourceStr);
   MaxWild:=Length(Ws);
   cInput:=1;
   cWild:=1;
   Result:=True;
   Repeat
      if SourceStr[cInput]=Ws[cWild] then Begin
         inc(cWild);
         inc(cInput);
         continue;
      end
      else if Ws[cWild]='?' then begin
         inc(cWild);
         inc(cInput);
         continue;
      end
      else if Ws[cWild]='*' then Begin
         HelpWild:=Copy(Ws,cWild+1,MaxWild);
         q:=SearchNext(HelpWild);
         LengthHelpWild:=Length(HelpWild);
         If Q=0 then begin
            If HelpWild='' then Exit;
            For Q:=0 to LengthHelpWild-1 do
               If (HelpWild[LengthHelpWild-Q]<>SourceStr[MaxInputWord-Q]) and
                  (HelpWild[LengthHelpWild-Q]<>'?') then Begin
                  Result:=False;
                  Exit;
               End;
            Exit;
         End;
         Inc(cWild,1+LengthHelpWild);
         Q:=FindPart(HelpWild,Copy(SourceStr,cInput,Length(SourceStr)));
         If Q=0 then Begin
            Result:=False;
            Exit;
         End;
         cInput:=Q+LengthHelpWild;
         Continue;
      End;
      Result:=False;
      Exit;
   Until (cInput>MaxInputWord) or (cWild>MaxWild);
   If cInput<=MaxInputWord then Result:=False
   Else If cWild<=MaxWild then Result:=False;
End;

end.