unit QExport4EmsWideStrUtils;

{$I QExport4VerCtrl.inc}

interface

uses
   {$IFDEF VCL16}
    System.SysUtils,
    Winapi.Windows;
  {$ELSE}
     {$IFDEF VER130}
     SysConst,
     {$ENDIF}
     Windows,
     SysUtils;
  {$ENDIF}

{$IFDEF QE_UNICODE}
function QECompareStr(const S1, S2: WideString): Integer;
function QECompareText(const S1, S2: WideString): Integer;
function QEUpperCase(const S: WideString): WideString;
function QELowerCase(const S: WideString): WideString;
function QEPos(const Substr, S: WideString): Integer;
function QEPosEx(const Substr, S: WideString; Index: Integer): Integer;
procedure QEInsert(const Substr: WideString; var S: WideString; const Index: Integer);
procedure QEDelete(var S: WideString; const Index, Count: Integer);
function QEFormat(const Format: WideString; const Args: array of const): WideString;
function QEStringReplace(const S, OldPattern, NewPattern: WideString;
  Flags: TReplaceFlags): WideString;
function QEQuotedStr(const S: WideString; Quote: WideChar): WideString;
{$ELSE}
function QECompareStr(const S1, S2: string): Integer;
function QECompareText(const S1, S2: string): Integer;
function QEUpperCase(const S: string): string;
function QELowerCase(const S: string): string;
function QEPos(const Substr, S: string): Integer;
function QEPosEx(const Substr, S: string; Index: Integer): Integer;
procedure QEInsert(const Substr: string; var S: string; const Index: Integer);
procedure QEDelete(var S: string; const Index, Count: Integer);
function QEFormat(const Format: string; const Args: array of const): string;
function QEStringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
function QEQuotedStr(const S: string; Quote: Char): string;
{$ENDIF}

function WideStringPosEx(const Substr, S: WideString; Index: Integer): Integer;

{$IFDEF QE_UNICODE}
{$IFNDEF VCL9}
procedure WideFmtStr(var Result: WideString; const Format: WideString;
  const Args: array of const);
{$IFDEF VER130}
procedure FormatErr(ErrorCode: Integer; Format: PChar; FmtLen: Cardinal);
procedure WideFormatError(ErrorCode: Integer; Format: PWideChar;
  FmtLen: Cardinal);
function WideFormatBuf(var Buffer; BufLen: Cardinal; const Format;
  FmtLen: Cardinal; const Args: array of const): Cardinal;
{$ENDIF}
function WideFormat(const Format: WideString; const Args: array of const): WideString;
function WideStringReplace(const S, OldPattern, NewPattern: Widestring;
  Flags: TReplaceFlags): Widestring;
function WideReplaceStr(const AText, AFromText, AToText: WideString): WideString;
function WideReplaceText(const AText, AFromText, AToText: WideString): WideString;
function WStrAlloc(Size: Cardinal): PWideChar;
function WStrBufSize(const Str: PWideChar): Cardinal;
{$ENDIF}
{$IFNDEF VCL10}
function WStrMove(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar;
{$ENDIF}
{$IFNDEF VCL9}
function WStrNew(const Str: PWideChar): PWideChar;
procedure WStrDispose(Str: PWideChar);
{$ENDIF}
{$IFNDEF VCL9}
function WStrLen(Str: PWideChar): Cardinal;
function WStrEnd(Str: PWideChar): PWideChar;
{$ENDIF}
{$IFNDEF VCL10}
function WStrCat(Dest: PWideChar; const Source: PWideChar): PWideChar;
{$ENDIF}
{$IFNDEF VCL9}
function WStrCopy(Dest, Source: PWideChar): PWideChar;
function WStrLCopy(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
function WStrPCopy(Dest: PWideChar; const Source: AnsiString): PWideChar;
function WStrPLCopy(Dest: PWideChar; const Source: AnsiString; MaxLen: Cardinal): PWideChar;
{$ENDIF}
{$IFNDEF VCL10}
function WStrScan(const Str: PWideChar; Chr: WideChar): PWideChar;
function WStrComp(Str1, Str2: PWideChar): Integer;
function WStrPos(Str, SubStr: PWideChar): PWideChar;
{$ENDIF}
function WStrECopy(Dest, Source: PWideChar): PWideChar;
function WStrLComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
function WStrLIComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
function WStrIComp(Str1, Str2: PWideChar): Integer;
function WStrLower(Str: PWideChar): PWideChar;
function WStrUpper(Str: PWideChar): PWideChar;
function WStrRScan(const Str: PWideChar; Chr: WideChar): PWideChar;
function WStrLCat(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
function WStrPas(const Str: PWideChar): WideString;

{$IFNDEF VCL10}
function WideLastChar(const S: WideString): PWideChar;
function WideQuotedStr(const S: WideString; Quote: WideChar): WideString;
{$ENDIF}
{$IFNDEF VCL9}
function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): Widestring;
{$ENDIF}
{$IFNDEF VCL10}
function WideDequotedStr(const S: WideString; AQuote: WideChar): WideString;
{$ENDIF}

{$ENDIF}

implementation

uses
  {$IFDEF VCL16}
    System.WideStrUtils,
    System.Math;
  {$ELSE}
    {$IFDEF VCL9}
      WideStrUtils,
    {$ENDIF}
    Math;
  {$ENDIF}

{$IFDEF QE_UNICODE}

{$IFDEF VER130}
type
  _EOSError = class(Exception)
  public
    ErrorCode: DWORD;
  end;

  PCardinal = ^Cardinal;

resourcestring
  _SOSError = 'System Error.  Code: %d.'+#10+'%s';
  _SUnkOSError = 'A call to an OS function failed';

function _DumbItDownFor95(const S1, S2: WideString; CmpFlags: Integer): Integer;
var
  a1, a2: AnsiString;
begin
  a1 := s1;
  a2 := s2;
  Result := CompareStringA(LOCALE_USER_DEFAULT, CmpFlags, PChar(a1), Length(a1),
    PChar(a2), Length(a2)) - 2;
end;

procedure _RaiseLastOSError;
var
  LastError: Integer;
  Error: _EOSError;
begin
  LastError := GetLastError;
  if LastError <> 0 then
    Error := _EOSError.CreateResFmt(@_SOSError, [LastError,
      SysErrorMessage(LastError)])
  else
    Error := _EOSError.CreateRes(@_SUnkOSError);
  Error.ErrorCode := LastError;
  raise Error;
end;

function _WideCompareStr(const S1, S2: WideString): Integer;
begin
  SetLastError(0);
  Result := CompareStringW(LOCALE_USER_DEFAULT, 0, PWideChar(S1), Length(S1),
    PWideChar(S2), Length(S2)) - 2;
  case GetLastError of
    0: ;
    ERROR_CALL_NOT_IMPLEMENTED: Result := _DumbItDownFor95(S1, S2, 0);
  else
    _RaiseLastOSError;
  end;
end;

function _WideCompareText(const S1, S2: WideString): Integer;
begin
  SetLastError(0);
  Result := CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PWideChar(S1),
    Length(S1), PWideChar(S2), Length(S2)) - 2;
  case GetLastError of
    0: ;
    ERROR_CALL_NOT_IMPLEMENTED: Result := _DumbItDownFor95(S1, S2, NORM_IGNORECASE);
  else
    _RaiseLastOSError;
  end;
end;

function _WideUpperCase(const S: WideString): WideString;
var
  Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PWideChar(S), Len);
  if Len > 0 then CharUpperBuffW(Pointer(Result), Len);
end;

function _WideLowerCase(const S: WideString): WideString;
var
  Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PWideChar(S), Len);
  if Len > 0 then CharLowerBuffW(Pointer(Result), Len);
end;
{$ENDIF}

{$ENDIF}

{$IFDEF QE_UNICODE}
function QECompareStr(const S1, S2: WideString): Integer;
begin
{$IFDEF VCL6}
  Result := WideCompareStr(S1, S2);
{$ELSE}
  Result := _WideCompareStr(S1, S2);
{$ENDIF}
end;
{$ELSE}
function QECompareStr(const S1, S2: string): Integer;
begin
  Result := AnsiCompareStr(S1, S2);
end;
{$ENDIF}

{$IFDEF QE_UNICODE}
function QECompareText(const S1, S2: WideString): Integer;
begin
{$IFDEF VCL6}
  Result := WideCompareText(S1, S2);
{$ELSE}
  Result := _WideCompareText(S1, S2);
{$ENDIF}
end;
{$ELSE}
function QECompareText(const S1, S2: string): Integer;
begin
  Result := AnsiCompareText(S1, S2);
end;
{$ENDIF}

{$IFDEF QE_UNICODE}
function QEUpperCase(const S: WideString): WideString;
begin
{$IFDEF VCL6}
  Result := WideUpperCase(S);
{$ELSE}
  Result := _WideUpperCase(S);
{$ENDIF}
end;
{$ELSE}
function QEUpperCase(const S: string): string;
begin
  Result := AnsiUpperCase(S);
end;
{$ENDIF}

{$IFDEF QE_UNICODE}
function QELowerCase(const S: WideString): WideString;
begin
{$IFDEF VCL6}
  Result := WideLowerCase(S);
{$ELSE}
  Result := _WideLowerCase(S);
{$ENDIF}
end;
{$ELSE}
function QELowerCase(const S: string): string;
begin
  Result := AnsiLowerCase(S);
end;
{$ENDIF}

function WideStringPosEx(const Substr, S: WideString; Index: Integer): Integer;
var
  i: Integer;
  wc: WideChar;
  ws: WideString;
begin
  Result := 0;
  if (Substr = '') or (S = '') then Exit;

  for i := Index to Length(S) do
  begin
    wc := S[i];
    if wc = Substr[1] then
    begin
      ws := Copy(S, i, Length(Substr));
      if QECompareStr(Substr, ws) = 0 then
      begin
        Result := i;
        Exit;
      end;
    end;
  end;
end;

{$IFDEF QE_UNICODE}
function QEPosEx(const Substr, S: WideString; Index: Integer): Integer;
var
  i: Integer;
  wc: WideChar;
  ws: WideString;
begin
  Result := 0;
  if (Substr = '') or (S = '') then Exit;

  for i := Index to Length(S) do
  begin
    wc := S[i];
    if wc = Substr[1] then
    begin
      ws := Copy(S, i, Length(Substr));
      if QECompareStr(Substr, ws) = 0 then
      begin
        Result := i;
        Exit;
      end;
    end;
  end;
end;
{$ELSE}
function QEPosEx(const Substr, S: string; Index: Integer): Integer;
var
  i: Integer;
  ch: Char;
  st: String;
begin
  Result := 0;
  if (Substr = '') or (S = '') then Exit;

  for i := Index to Length(S) do
  begin
    ch := S[i];
    if ch = Substr[1] then
    begin
      st := Copy(S, i, Length(Substr));
      if QECompareStr(Substr, st) = 0 then
      begin
        Result := i;
        Exit;
      end;
    end;
  end;
end;
{$ENDIF}

{$IFDEF QE_UNICODE}
function QEPos(const Substr, S: WideString): Integer;
var
  i: Integer;
  wc: WideChar;
  ws: WideString;
begin
  Result := 0;
  if (Substr = '') or (S = '') then Exit;

  for i := 1 to Length(S) do
  begin
    wc := S[i];
    if wc = Substr[1] then
    begin
      ws := Copy(S, i, Length(Substr));
      if QECompareStr(Substr, ws) = 0 then
      begin
        Result := i;
        Exit;
      end;
    end;
  end;
end;
{$ELSE}
function QEPos(const Substr, S: string): Integer;
begin
  Result := SysUtils.AnsiPos(Substr, S);
end;
{$ENDIF}

{$IFDEF QE_UNICODE}
procedure QEInsert(const Substr: WideString; var S: WideString; const Index: Integer);
begin
  System.Insert(Substr, S, Index);
end;
{$ELSE}
procedure QEInsert(const Substr: string; var S: string; const Index: Integer);
begin
  System.Insert(Substr, S, Index);
end;
{$ENDIF}

{$IFDEF QE_UNICODE}
procedure QEDelete(var S: WideString; const Index, Count: Integer);
begin
  System.Delete(S, Index, Count);
end;
{$ELSE}
procedure QEDelete(var S: string; const Index, Count: Integer);
begin
  System.Delete(S, Index, Count);
end;
{$ENDIF}

{$IFDEF QE_UNICODE}

{$IFNDEF VCL9}
procedure WideFmtStr(var Result: WideString; const Format: WideString;
  const Args: array of const);
const
  BufSize = 2048;
var
  Len, BufLen: Integer;
  Buffer: array[0..BufSize-1] of WideChar;
begin
  if Length(Format) < (BufSize - (BufSize div 4)) then
  begin
    BufLen := BufSize;
    Len := WideFormatBuf(Buffer, BufSize - 1, Pointer(Format)^, Length(Format), Args);
    if Len < BufLen - 1 then
    begin
      SetString(Result, Buffer, Len);
      Exit;
    end;
  end
  else
  begin
    BufLen := Length(Format);
    Len := BufLen;
  end;

  while Len >= BufLen - 1 do
  begin
    Inc(BufLen, BufLen);
    Result := '';          // prevent copying of existing data, for speed
    SetLength(Result, BufLen);
    Len := WideFormatBuf(Pointer(Result)^, BufLen - 1, Pointer(Format)^,
      Length(Format), Args);
  end;
  SetLength(Result, Len);
end;


{$IFDEF VER130}

procedure FormatErr(ErrorCode: Integer; Format: PChar; FmtLen: Cardinal);
const
  FormatErrorStrs: array[0..1] of PResStringRec = (
    @SInvalidFormat, @SArgumentMissing);
var
  Buffer: array[0..31] of Char;
begin
  if FmtLen > 31 then FmtLen := 31;
  if StrByteType(Format, FmtLen-1) = mbLeadByte then Dec(FmtLen);
  StrMove(Buffer, Format, FmtLen);
  Buffer[FmtLen] := #0;
  raise EConvertError.CreateFmt(LoadResString(FormatErrorStrs[ErrorCode]), [PChar(@Buffer)]);
end;

procedure WideFormatError(ErrorCode: Integer; Format: PWideChar;
  FmtLen: Cardinal);
var
  WideFormat: WideString;
  FormatText: string;
begin
  SetLength(WideFormat, FmtLen);
  SetString(WideFormat, Format, FmtLen);
  FormatText := WideFormat;
  FormatErr(ErrorCode, PChar(FormatText), FmtLen);
end;

function WideFormatBuf(var Buffer; BufLen: Cardinal; const Format;
  FmtLen: Cardinal; const Args: array of const): Cardinal;
var
  ArgIndex, Width, Prec: Integer;
  BufferOrg, FormatOrg, FormatPtr: PWideChar;
  JustFlag: WideChar;
  StrBuf: array[0..64] of WideChar;
  TempWideStr: WideString;
  TempInt64 : Int64;
  SaveGOT: Integer;
{ in: eax <-> Buffer }
{ in: edx <-> BufLen }
{ in: ecx <-> Format }

asm
        PUSH    EBX
        PUSH    ESI
        PUSH    EDI
        MOV     EDI,EAX
        MOV     ESI,ECX
{$IFDEF PIC}
        CALL    GetGOT
{$ELSE}
        XOR     EAX,EAX
{$ENDIF}
        MOV     SaveGOT,EAX
        MOV     ECX,FmtLen
        LEA     ECX,[ECX*2+ESI]
        MOV     BufferOrg,EDI
        XOR     EAX,EAX
        MOV     ArgIndex,EAX
        MOV     TempWideStr,EAX

@Loop:
        OR      EDX,EDX
        JE      @Done

@NextChar:
        CMP     ESI,ECX
        JE      @Done
        LODSW
        CMP     AX,'%'
        JE      @Format

@StoreChar:
        STOSW
        DEC     EDX
        JNE     @NextChar

@Done:
        MOV     EAX,EDI
        SUB     EAX,BufferOrg
        SHR     EAX,1
        JMP     @Exit

@Format:
        CMP     ESI,ECX
        JE      @Done
        LODSW
        CMP     AX,'%'
        JE      @StoreChar
        LEA     EBX,[ESI-4]
        MOV     FormatOrg,EBX
@A0:    MOV     JustFlag,AX
        CMP     AX,'-'
        JNE     @A1
        CMP     ESI,ECX
        JE      @Done
        LODSW
@A1:    CALL    @Specifier
        CMP     AX,':'
        JNE     @A2
        MOV     ArgIndex,EBX
        CMP     ESI,ECX
        JE      @Done
        LODSW
        JMP     @A0

@A2:    MOV     Width,EBX
        MOV     EBX,-1
        CMP     AX,'.'
        JNE     @A3
        CMP     ESI,ECX
        JE      @Done
        LODSW
        CALL    @Specifier
@A3:    MOV     Prec,EBX
        MOV     FormatPtr,ESI
        PUSH    ECX
        PUSH    EDX

        CALL    @Convert

        POP     EDX
        MOV     EBX,Width
        SUB     EBX,ECX        //(* ECX <=> number of characters output *)
        JAE     @A4            //(*         jump -> output smaller than width *)
        XOR     EBX,EBX

@A4:    CMP     JustFlag,'-'
        JNE     @A6
        SUB     EDX,ECX
        JAE     @A5
        ADD     ECX,EDX
        XOR     EDX,EDX

@A5:    REP     MOVSW

@A6:    XCHG    EBX,ECX
        SUB     EDX,ECX
        JAE     @A7
        ADD     ECX,EDX
        XOR     EDX,EDX
@A7:    MOV     AX,' '
        REP     STOSW
        XCHG    EBX,ECX
        SUB     EDX,ECX
        JAE     @A8
        ADD     ECX,EDX
        XOR     EDX,EDX
@A8:    REP     MOVSW
        POP     ECX
        MOV     ESI,FormatPtr
        JMP     @Loop

@Specifier:
        XOR     EBX,EBX
        CMP     AX,'*'
        JE      @B3
@B1:    CMP     AX,'0'
        JB      @B5
        CMP     AX,'9'
        JA      @B5
        IMUL    EBX,EBX,10
        SUB     AX,'0'
        MOVZX   EAX,AX
        ADD     EBX,EAX
        CMP     ESI,ECX
        JE      @B2
        LODSW
        JMP     @B1
@B2:    POP     EAX
        JMP     @Done
@B3:    MOV     EAX,ArgIndex
        CMP     EAX,Args.Integer[-4]
        JA      @B4
        INC     ArgIndex
        MOV     EBX,Args
        CMP     [EBX+EAX*8].Byte[4],vtInteger
        MOV     EBX,[EBX+EAX*8]
        JE      @B4
        XOR     EBX,EBX
@B4:    CMP     ESI,ECX
        JE      @B2
        LODSW
@B5:    RET

@Convert:
        AND     AL,0DFH
        MOV     CL,AL
        MOV     EAX,1
        MOV     EBX,ArgIndex
        CMP     EBX,Args.Integer[-4]
        JA      @ErrorExit
        INC     ArgIndex
        MOV     ESI,Args
        LEA     ESI,[ESI+EBX*8]
        MOV     EAX,[ESI].Integer[0]       // TVarRec.data
        MOVZX   EDX,[ESI].Byte[4]          // TVarRec.VType
{$IFDEF PIC}
        MOV     EBX, SaveGOT
        ADD     EBX, offset @CvtVector
        MOV     EBX, [EBX+EDX*4]
        ADD     EBX, SaveGOT
        JMP     EBX
{$ELSE}
        JMP     @CvtVector.Pointer[EDX*4]
{$ENDIF}

@CvtVector:
        DD      @CvtInteger                // vtInteger
        DD      @CvtBoolean                // vtBoolean
        DD      @CvtChar                   // vtChar
        DD      @CvtExtended               // vtExtended
        DD      @CvtShortStr               // vtString
        DD      @CvtPointer                // vtPointer
        DD      @CvtPChar                  // vtPChar
        DD      @CvtObject                 // vtObject
        DD      @CvtClass                  // vtClass
        DD      @CvtWideChar               // vtWideChar
        DD      @CvtPWideChar              // vtPWideChar
        DD      @CvtAnsiStr                // vtAnsiString
        DD      @CvtCurrency               // vtCurrency
        DD      @CvtVariant                // vtVariant
        DD      @CvtInterface              // vtInterface
        DD      @CvtWideString             // vtWideString
        DD      @CvtInt64                  // vtInt64

@CvtBoolean:
@CvtObject:
@CvtClass:
@CvtInterface:
@CvtError:
        XOR     EAX,EAX

@ErrorExit:
        CALL    @ClearTmpWideStr
        MOV     EDX,FormatOrg
        MOV     ECX,FormatPtr
        SUB     ECX,EDX
        SHR     ECX,1
        MOV     EBX, SaveGOT
{$IFDEF PC_MAPPED_EXCEPTIONS}
        //  Because of all the assembly code here, we can't call a routine
        //  that throws an exception if it looks like we're still on the
        //  stack.  The static disassembler cannot give sufficient unwind
        //  frame info to unwind the confusion that is generated from the
        //  assembly code above.  So before we throw the exception, we
        //  go to some lengths to excise ourselves from the stack chain.
        //  We were passed 12 bytes of parameters on the stack, and we have
        //  to make sure that we get rid of those, too.
        MOV     ESP, EBP        // Ditch everthing to the frame
        MOV     EBP, [ESP + 4]  // Get the return addr
        MOV     [ESP + 16], EBP // Move the ret addr up in the stack
        POP     EBP             // Ditch the rest of the frame
        ADD     ESP, 12         // Ditch the space that was taken by params
        JMP     WideFormatError // Off to FormatErr
{$ELSE}
        CALL    WideFormatError
{$ENDIF}
        // The above call raises an exception and does not return

@CvtInt64:
        // CL  <= format character
        // EAX <= address of int64
        // EBX <= TVarRec.VType

        LEA     EBX, TempInt64       // (input is array of const; save original)
        MOV     EDX, [EAX]
        MOV     [EBX], EDX
        MOV     EDX, [EAX + 4]
        MOV     [EBX + 4], EDX

        // EBX <= address of TempInt64

        CMP     CL,'D'
        JE      @DecI64
        CMP     CL,'U'
        JE      @DecI64_2
        CMP     CL,'X'
        JNE     @CvtError

@HexI64:
        MOV     ECX,16               // hex divisor
        JMP     @CvtI64

@DecI64:
        TEST    DWORD PTR [EBX + 4], $80000000      // sign bit set?
        JE      @DecI64_2            //   no -> bypass '-' output

        NEG     DWORD PTR [EBX]      // negate lo-order, then hi-order
        ADC     DWORD PTR [EBX+4], 0
        NEG     DWORD PTR [EBX+4]

        CALL    @DecI64_2

        MOV     AX,'-'
        INC     ECX
        INC     ECX
        DEC     ESI
        DEC     ESI
        MOV     [ESI],AX
        RET

@DecI64_2:                           // unsigned int64 output
        MOV     ECX,10               // decimal divisor

@CvtI64:
        LEA     ESI,StrBuf[64]

@CvtI64_1:
        PUSH    EBX
        PUSH    ECX                  // save radix
        PUSH    0
        PUSH    ECX                  // radix divisor (10 or 16 only)
        MOV     EAX, [EBX]
        MOV     EDX, [EBX + 4]
        MOV     EBX, SaveGOT
        CALL    System.@_llumod
        POP     ECX                  // saved radix
        POP     EBX

        XCHG    EAX, EDX             // lo-value to EDX for character output
        ADD     DX,'0'
        CMP     DX,'0'+10
        JB      @CvtI64_2

        ADD     DX,('A'-'0')-10

@CvtI64_2:
        DEC     ESI
        DEC     ESI
        MOV     [ESI],DX

        PUSH    EBX
        PUSH    ECX                  // save radix
        PUSH    0
        PUSH    ECX                  // radix divisor (10 or 16 only)
        MOV     EAX, [EBX]           // value := value DIV radix
        MOV     EDX, [EBX + 4]
        MOV     EBX, SaveGOT
        CALL    System.@_lludiv
        POP     ECX                  // saved radix
        POP     EBX
        MOV     [EBX], EAX
        MOV     [EBX + 4], EDX
        OR      EAX,EDX              // anything left to output?
        JNE     @CvtI64_1            //   no jump => EDX:EAX = 0

        LEA     ECX,StrBuf[64]
        SUB     ECX,ESI
        SHR     ECX,1
        MOV     EDX,Prec
        CMP     EDX,16
        JBE     @CvtI64_3
        RET

@CvtI64_3:
        SUB     EDX,ECX
        JBE     @CvtI64_5
        ADD     ECX,EDX
        MOV     AX,'0'

@CvtI64_4:
        DEC     ESI
        DEC     ESI
        MOV     [ESI],AX
        DEC     EDX
        JNE     @CvtI64_4

@CvtI64_5:
        RET
////////////////////////////////////////////////

@CvtInteger:
        CMP     CL,'D'
        JE      @C1
        CMP     CL,'U'
        JE      @C2
        CMP     CL,'X'
        JNE     @CvtError
        MOV     ECX,16
        JMP     @CvtLong
@C1:    OR      EAX,EAX
        JNS     @C2
        NEG     EAX
        CALL    @C2
        MOV     AX,'-'
        INC     ECX
        DEC     ESI
        DEC     ESI
        MOV     [ESI],AX
        RET
@C2:    MOV     ECX,10

@CvtLong:
        LEA     ESI,StrBuf[32]
@D1:    XOR     EDX,EDX
        DIV     ECX
        ADD     EDX,'0'
        CMP     EDX,'0'+10
        JB      @D2
        ADD     EDX,('A'-'0')-10
@D2:    DEC     ESI
        DEC     ESI
        MOV     [ESI],DX
        OR      EAX,EAX
        JNE     @D1
        LEA     ECX,StrBuf[32]
        SUB     ECX,ESI
        SHR     ECX,1
        MOV     EDX,Prec
        CMP     EDX,16
        JBE     @D3
        RET
@D3:    SUB     EDX,ECX
        JBE     @D5
        ADD     ECX,EDX
        MOV     AX,'0'
@D4:    DEC     ESI
        DEC     ESI
        MOV     [ESI],AX
        DEC     EDX
        JNE     @D4
@D5:    RET

@CvtChar:
        CMP     CL,'S'
        JNE     @CvtError
        MOV     EAX,ESI
        MOV     ECX,1
        JMP     @CvtAnsiThingLen

@CvtWideChar:
        CMP     CL,'S'
        JNE     @CvtError
        MOV     ECX,1
        RET

@CvtVariant:
        CMP     CL,'S'
        JNE     @CvtError
        CMP     [EAX].TVarData.VType,varNull
        JBE     @CvtEmptyStr
        MOV     EDX,EAX
        LEA     EAX,TempWideStr
        PUSH    EBX
        MOV     EBX, SaveGOT
        CALL    System.@VarToWStr
        POP     EBX
        MOV     ESI,TempWideStr
        JMP     @CvtWideStrRef

@CvtEmptyStr:
        XOR     ECX,ECX
        RET

@CvtShortStr:
        CMP     CL,'S'
        JNE     @CvtError
        MOVZX   ECX,BYTE PTR [EAX]
        INC     EAX

@CvtAnsiThingLen:
        MOV     ESI,OFFSET System.@WStrFromPCharLen
        JMP     @CvtAnsiThing

@CvtPChar:
        MOV    ESI,OFFSET System.@WStrFromPChar
        JMP    @CvtAnsiThingTest

@CvtAnsiStr:
        MOV    ESI,OFFSET System.@WStrFromLStr

@CvtAnsiThingTest:
        CMP    CL,'S'
        JNE    @CvtError

@CvtAnsiThing:
        ADD    ESI, SaveGOT
        MOV    EDX,EAX
        LEA    EAX,TempWideStr
        PUSH   EBX
        MOV    EBX, SaveGOT
        CALL   ESI
        POP    EBX
        MOV    ESI,TempWideStr
        JMP    @CvtWideStrRef

@CvtWideString:
        CMP     CL,'S'
        JNE     @CvtError
        MOV     ESI,EAX

@CvtWideStrRef:
        OR      ESI,ESI
        JE      @CvtEmptyStr
        MOV     ECX,[ESI-4]
        SHR     ECX,1

@CvtWideStrLen:
        CMP     ECX,Prec
        JA      @E1
        RET
@E1:    MOV     ECX,Prec
        RET

@CvtPWideChar:
        CMP     CL,'S'
        JNE     @CvtError
        MOV     ESI,EAX
        PUSH    EDI
        MOV     EDI,EAX
        XOR     EAX,EAX
        MOV     ECX,Prec
        JECXZ   @F1
        REPNE   SCASW
        JNE     @F1
        DEC     EDI
        DEC     EDI
@F1:    MOV     ECX,EDI
        SUB     ECX,ESI
        SHR     ECX,1
        POP     EDI
        RET

@CvtPointer:
        CMP     CL,'P'
        JNE     @CvtError
        MOV     Prec,8
        MOV     ECX,16
        JMP     @CvtLong

@CvtCurrency:
        MOV     BH,fvCurrency
        JMP     @CvtFloat

@CvtExtended:
        MOV     BH,fvExtended

@CvtFloat:
        MOV     ESI,EAX
        MOV     BL,ffGeneral
        CMP     CL,'G'
        JE      @G2
        MOV     BL,ffExponent
        CMP     CL,'E'
        JE      @G2
        MOV     BL,ffFixed
        CMP     CL,'F'
        JE      @G1
        MOV     BL,ffNumber
        CMP     CL,'N'
        JE      @G1
        CMP     CL,'M'
        JNE     @CvtError
        MOV     BL,ffCurrency
@G1:    MOV     EAX,18
        MOV     EDX,Prec
        CMP     EDX,EAX
        JBE     @G3
        MOV     EDX,2
        CMP     CL,'M'
        JNE     @G3
        MOVZX   EDX,CurrencyDecimals
        JMP     @G3
@G2:    MOV     EAX,Prec
        MOV     EDX,3
        CMP     EAX,18
        JBE     @G3
        MOV     EAX,15
@G3:    PUSH    EBX
        PUSH    EAX
        PUSH    EDX
        LEA     EAX,StrBuf
        MOV     EDX,ESI
        MOVZX   ECX,BH
        MOV     EBX, SaveGOT
        CALL    FloatToText
        MOV     ECX,EAX
        LEA     EAX,StrBuf
        JMP     @CvtAnsiThingLen

@ClearTmpWideStr:
        PUSH    EBX
        PUSH    EAX
        LEA     EAX,TempWideStr
        MOV     EBX, SaveGOT
        CALL    System.@WStrClr
        POP     EAX
        POP     EBX
        RET

@Exit:
        CALL    @ClearTmpWideStr
        POP     EDI
        POP     ESI
        POP     EBX
end;
{$ENDIF}


{$ENDIF}
function QEFormat(const Format: WideString; const Args: array of const): WideString;
begin
  WideFmtStr(Result, Format, Args);
end;
{$ELSE}
function QEFormat(const Format: string; const Args: array of const): string;
begin
  Result := SysUtils.Format(Format, Args);
end;
{$ENDIF}

{$IFDEF QE_UNICODE}
{$IFNDEF VCL9}
function WideStringReplace(const S, OldPattern, NewPattern: Widestring;
  Flags: TReplaceFlags): Widestring;
var
  SearchStr, Patt, NewStr: Widestring;
  Offset: Integer;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := QEUpperCase(S);
    Patt := QEUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := Pos(Patt, SearchStr);
    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;
{$ENDIF}
function QEStringReplace(const S, OldPattern, NewPattern: WideString;
  Flags: TReplaceFlags): WideString;
begin
  Result := WideStringReplace(S, OldPattern, NewPattern, Flags);
end;
{$ELSE}
function QEStringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
begin
  Result := SysUtils.StringReplace(S, OldPattern, NewPattern, Flags);
end;
{$ENDIF}

{$IFDEF QE_UNICODE}
{$IFNDEF VCL10}
function WideQuotedStr(const S: WideString; Quote: WideChar): WideString;
var
  P, Src,
  Dest: PWideChar;
  AddCount: Integer;
begin
  AddCount := 0;
  P := WStrScan(PWideChar(S), Quote);
  while (P <> nil) do
  begin
    Inc(P);
    Inc(AddCount);
    P := WStrScan(P, Quote);
  end;

  if AddCount = 0 then
    Result := Quote + S + Quote
  else
  begin
    SetLength(Result, Length(S) + AddCount + 2);
    Dest := PWideChar(Result);
    Dest^ := Quote;
    Inc(Dest);
    Src := PWideChar(S);
    P := WStrScan(Src, Quote);
    repeat
      Inc(P);
      Move(Src^, Dest^, 2 * (P - Src));
      Inc(Dest, P - Src);
      Dest^ := Quote;
      Inc(Dest);
      Src := P;
      P := WStrScan(Src, Quote);
    until P = nil;
    P := WStrEnd(Src);
    Move(Src^, Dest^, 2 * (P - Src));
    Inc(Dest, P - Src);
    Dest^ := Quote;
  end;
end;
{$ENDIF}
function QEQuotedStr(const S: WideString; Quote: WideChar): WideString;
begin
  Result := WideQuotedStr(S, Quote);
end;
{$ELSE}
function QEQuotedStr(const S: string; Quote: Char): string;
begin
  Result := SysUtils.AnsiQuotedStr(S, Quote);
end;
{$ENDIF}

{$IFDEF QE_UNICODE}
{$IFNDEF VCL9}
function WideFormat(const Format: WideString; const Args: array of const): WideString;
begin
  WideFmtStr(Result, Format, Args);
end;

function WideReplaceStr(const AText, AFromText, AToText: WideString): WideString;
begin
  Result := WideStringReplace(AText, AFromText, AToText, [rfReplaceAll]);
end;

function WideReplaceText(const AText, AFromText, AToText: WideString): WideString;
begin
  Result := WideStringReplace(AText, AFromText, AToText, [rfReplaceAll, rfIgnoreCase]);
end;

function WStrAlloc(Size: Cardinal): PWideChar;
begin
  Size := SizeOf(Cardinal) + (Size * SizeOf(WideChar));
  GetMem(Result, Size);
  PCardinal(Result)^ := Size;
  Inc(PAnsiChar(Result), SizeOf(Cardinal));
end;

function WStrBufSize(const Str: PWideChar): Cardinal;
var
  P: PWideChar;
begin
  P := Str;
  Dec(PAnsiChar(P), SizeOf(Cardinal));
  Result := PCardinal(P)^ - SizeOf(Cardinal);
  Result := Result div SizeOf(WideChar);
end;
{$ENDIF}

{$IFNDEF VCL10}
function WStrMove(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar;
var
  Length: Integer;
begin
  Result := Dest;
  Length := Count * SizeOf(WideChar);
  Move(Source^, Dest^, Length);
end;
{$ENDIF}

{$IFNDEF VCL9}
function WStrNew(const Str: PWideChar): PWideChar;
var
  Size: Cardinal;
begin
  if Str = nil then Result := nil else
  begin
    Size := WStrLen(Str) + 1;
    Result := WStrMove(WStrAlloc(Size), Str, Size);
  end;
end;

procedure WStrDispose(Str: PWideChar);
begin
  if Str <> nil then
  begin
    Dec(PAnsiChar(Str), SizeOf(Cardinal));
    FreeMem(Str, Cardinal(Pointer(Str)^));
  end;
end;
{$ENDIF}

{$IFNDEF VCL9}
function WStrLen(Str: PWideChar): Cardinal;
begin
  Result := WStrEnd(Str) - Str;
end;

function WStrEnd(Str: PWideChar): PWideChar;
begin
  Result := Str;
  While Result^ <> #0 do
    Inc(Result);
end;
{$ENDIF}

{$IFNDEF VCL10}
function WStrCat(Dest: PWideChar; const Source: PWideChar): PWideChar;
begin
  Result := Dest;
  WStrCopy(WStrEnd(Dest), Source);
end;
{$ENDIF}

{$IFNDEF VCL9}
function WStrCopy(Dest, Source: PWideChar): PWideChar;
begin
  Result := WStrLCopy(Dest, Source, MaxInt);
end;

function WStrLCopy(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
var
  Count: Cardinal;
begin
  Result := Dest;
  Count := 0;
  while (Count < MaxLen) and (Source^ <> #0) do
  begin
    Dest^ := Source^;
    Inc(Source);
    Inc(Dest);
    Inc(Count);
  end;
  Dest^ := #0;
end;

function WStrPCopy(Dest: PWideChar; const Source: AnsiString): PWideChar;
begin
  Result := WStrPLCopy(Dest, Source, MaxInt);
end;

function WStrPLCopy(Dest: PWideChar; const Source: AnsiString; MaxLen: Cardinal): PWideChar;
begin
  Result := WStrLCopy(Dest, PWideChar(WideString(Source)), MaxLen);
end;
{$ENDIF}

{$IFNDEF VCL10}
function WStrScan(const Str: PWideChar; Chr: WideChar): PWideChar;
begin
  Result := Str;
  while Result^ <> Chr do
  begin
    if Result^ = #0 then
    begin
      Result := nil;
      Exit;
    end;
    Inc(Result);
  end;
end;

function WStrComp(Str1, Str2: PWideChar): Integer;
begin
  Result := WStrLComp(Str1, Str2, MaxInt);
end;

function WStrPos(Str, SubStr: PWideChar): PWideChar;
var
  PSave: PWideChar;
  P: PWideChar;
  PSub: PWideChar;
begin
  Result := nil;
  if (Str <> nil) and (Str^ <> #0) and (SubStr <> nil) and (SubStr^ <> #0) then
  begin
    P := Str;
    while P^ <> #0 do
    begin
      if P^ = SubStr^ then
      begin
        PSave := P;
        PSub := SubStr;
        while (P^ = PSub^) do
        begin
          Inc(P);
          Inc(PSub);
          if (PSub^ = #0) then
          begin
            Result := PSave;
            exit;
          end;
          if (P^ = #0) then
            Exit;
        end;
        P := PSave;
      end;
      Inc(P);
    end;
  end;
end;
{$ENDIF}

function WStrECopy(Dest, Source: PWideChar): PWideChar;
begin
  Result := WStrEnd(WStrCopy(Dest, Source));
end;

function WStrComp_EX(Str1, Str2: PWideChar; MaxLen: Cardinal; dwCmpFlags: Cardinal): Integer;
var
  Len1, Len2: Integer;
begin
  if MaxLen = Cardinal(MaxInt) then
  begin
    Len1 := -1;
    Len2 := -1;
  end
  else begin
    Len1 := Min(WStrLen(Str1), MaxLen);
    Len2 := Min(WStrLen(Str2), MaxLen);
  end;
  Result := CompareStringW(GetThreadLocale, dwCmpFlags, Str1, Len1, Str2, Len2) - 2;
end;

function WStrLComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
begin
  Result := WStrComp_EX(Str1, Str2, MaxLen, 0);
end;

function WStrLIComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
begin
  Result := WStrComp_EX(Str1, Str2, MaxLen, NORM_IGNORECASE);
end;

function WStrIComp(Str1, Str2: PWideChar): Integer;
begin
  Result := WStrLIComp(Str1, Str2, MaxInt);
end;

function WStrLower(Str: PWideChar): PWideChar;
begin
  Result := Str;
  CharLowerBuffW(Str, WStrLen(Str))
end;

function WStrUpper(Str: PWideChar): PWideChar;
begin
  Result := Str;
  CharUpperBuffW(Str, WStrLen(Str))
end;

function WStrRScan(const Str: PWideChar; Chr: WideChar): PWideChar;
var
  MostRecentFound: PWideChar;
begin
  if Chr = #0 then
    Result := WStrEnd(Str)
  else
  begin
    Result := nil;
    MostRecentFound := Str;
    while True do
    begin
      while MostRecentFound^ <> Chr do
      begin
        if MostRecentFound^ = #0 then
          Exit;
        Inc(MostRecentFound);
      end;
      Result := MostRecentFound;
      Inc(MostRecentFound);
    end;
  end;
end;

function WStrLCat(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
begin
  Result := Dest;
  WStrLCopy(WStrEnd(Dest), Source, MaxLen - WStrLen(Dest));
end;

function WStrPas(const Str: PWideChar): WideString;
begin
  Result := Str;
end;

{$IFNDEF VCL10}
function WideLastChar(const S: WideString): PWideChar;
begin
  if S = '' then
    Result := nil
  else
    Result := @S[Length(S)];
end;
{$ENDIF}

{$IFNDEF VCL9}
function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): Widestring;
var
  P, Dest: PWideChar;
  DropCount: Integer;
begin
  Result := '';
  if (Src = nil) or (Src^ <> Quote) then Exit;
  Inc(Src);
  DropCount := 1;
  P := Src;
  Src := WStrScan(Src, Quote);
  while Src <> nil do   
  begin
    Inc(Src);
    if Src^ <> Quote then Break;
    Inc(Src);
    Inc(DropCount);
    Src := WStrScan(Src, Quote);
  end;
  if Src = nil then Src := WStrEnd(P);
  if ((Src - P) <= 1) then Exit;
  if DropCount = 1 then
    SetString(Result, P, Src - P - 1)
  else
  begin
    SetLength(Result, Src - P - DropCount);
    Dest := PWideChar(Result);
    Src := WStrScan(P, Quote);
    while Src <> nil do
    begin
      Inc(Src);
      if Src^ <> Quote then Break;
      Move(P^, Dest^, (Src - P) * SizeOf(WideChar));
      Inc(Dest, Src - P);
      Inc(Src);
      P := Src;
      Src := WStrScan(Src, Quote);
    end;
    if Src = nil then Src := WStrEnd(P);
    Move(P^, Dest^, (Src - P - 1) * SizeOf(WideChar));
  end;
end;
{$ENDIF}

{$IFNDEF VCL10}
function WideDequotedStr(const S: WideString; AQuote: WideChar): WideString;
var
  LText : PWideChar;
begin
  LText := PWideChar(S);
  Result := WideExtractQuotedStr(LText, AQuote);
  if Result = '' then
    Result := S;
end;
{$ENDIF}

{$ENDIF}

end.
