Skip to content
Permalink
Browse files

overloaded StringToSynUnicode() procedure

- with some refactoring of UNICODE compiler handling
  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Nov 8, 2019
1 parent 783560b commit 199a00515a820e96f8d5ea1d556ea04e6a25b408
Showing with 75 additions and 97 deletions.
  1. +1 −1 SQLite3/mORMot.pas
  2. +67 −89 SynCommons.pas
  3. +6 −6 SynOleDB.pas
  4. +1 −1 SynopseCommit.inc
var s: string;
begin
result := ExpandAsString(Row,Field,Client,s);
Text := StringToSynUnicode(s);
StringToSynUnicode(s,Text);
end;

function TSQLTable.GetTimeLog(Row, Field: integer; Expanded: boolean;
@@ -1554,7 +1554,12 @@ function StringToRawUnicode(const S: string): RawUnicode; overload;
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringToSynUnicode(const S: string): SynUnicode;
function StringToSynUnicode(const S: string): SynUnicode; overload;
{$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text into a SynUnicode encoded String
// - overloaded to avoid a copy to a temporary result string of a function
procedure StringToSynUnicode(const S: string; var result: SynUnicode); overload;
{$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text into a Raw Unicode encoded String
@@ -3042,8 +3047,10 @@ function Split(const Str, SepStr: RawUTF8; StartPos: integer=1): RawUTF8; overlo
/// split a RawUTF8 string into several strings, according to SepStr separator
// - this overloaded function will fill a DestPtr[] array of PRawUTF8
// - if any DestPtr[]=nil, the item will be skipped
procedure Split(const Str: RawUTF8; const SepStr: array of RawUTF8;
const DestPtr: array of PRawUTF8); overload;
// - if input Str end before al SepStr[] are found, DestPtr[] is set to ''
// - returns the number of values extracted into DestPtr[]
function Split(const Str: RawUTF8; const SepStr: array of RawUTF8;
const DestPtr: array of PRawUTF8): PtrInt; overload;

/// returns the last occurence of the given SepChar separated context
// - e.g. SplitRight('01/2/34','/')='34'
begin
SetString(result,PAnsiChar(pointer(S)),length(S)*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(const S: string): RawUnicode;
begin
result := CurrentAnsiConvert.AnsiToRawUnicode(S);
end;
{$endif}

{$ifdef UNICODE}
function StringToSynUnicode(const S: string): SynUnicode;
begin
result := S;
end;
{$else}
function StringToSynUnicode(const S: string): SynUnicode;
procedure StringToSynUnicode(const S: string; var result: SynUnicode); overload;
begin
result := CurrentAnsiConvert.AnsiToUnicodeString(pointer(S),length(S));
result := S;
end;
{$endif}

{$ifdef UNICODE}
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
begin
SetString(result,PAnsiChar(P),L*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
begin
result := CurrentAnsiConvert.AnsiToRawUnicode(P,L);
end;
{$endif}


{$ifdef UNICODE}
function RawUnicodeToString(P: PWideChar; L: integer): string;
begin
SetString(result,P,L);
end;
{$else}
function RawUnicodeToString(P: PWideChar; L: integer): string;
begin
result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);
end;
{$endif}

{$ifdef UNICODE}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string);
begin
SetString(result,P,L);
end;
{$else}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string);
begin
result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);
end;
{$endif}

{$ifdef UNICODE}
function RawUnicodeToString(const U: RawUnicode): string;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
SetString(result,PWideChar(pointer(U)),StrLenW(Pointer(U)));
end;
{$else}
function RawUnicodeToString(const U: RawUnicode): string;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
result := CurrentAnsiConvert.UnicodeBufferToAnsi(Pointer(U),StrLenW(Pointer(U)));
end;
{$endif}

{$ifdef UNICODE}
function SynUnicodeToString(const U: SynUnicode): string;
begin
result := U;
end;
{$else}
function SynUnicodeToString(const U: SynUnicode): string;
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
begin
result := CurrentAnsiConvert.UnicodeBufferToAnsi(Pointer(U),length(U));
UTF8DecodeToUnicodeString(P,L,result);
end;
{$endif}

{$ifdef UNICODE}
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string);
begin
UTF8DecodeToUnicodeString(P,L,result);
end;
function UTF8ToString(const Text: RawUTF8): string;
begin
UTF8DecodeToUnicodeString(pointer(Text),length(Text),result);
end;
{$else}
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
function StringToRawUnicode(const S: string): RawUnicode;
begin
CurrentAnsiConvert.UTF8BufferToAnsi(P,L,RawByteString(result));
result := CurrentAnsiConvert.AnsiToRawUnicode(S);
end;
{$endif}

{$ifdef UNICODE}
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string);
function StringToSynUnicode(const S: string): SynUnicode;
begin
UTF8DecodeToUnicodeString(P,L,result);
result := CurrentAnsiConvert.AnsiToUnicodeString(pointer(S),length(S));
end;
{$else}
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string);
procedure StringToSynUnicode(const S: string; var result: SynUnicode); overload;
begin
result := CurrentAnsiConvert.AnsiToUnicodeString(pointer(S),length(S));
end;
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
begin
result := CurrentAnsiConvert.AnsiToRawUnicode(P,L);
end;
function RawUnicodeToString(P: PWideChar; L: integer): string;
begin
result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);
end;
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string);
begin
result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);
end;
function RawUnicodeToString(const U: RawUnicode): string;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
result := CurrentAnsiConvert.UnicodeBufferToAnsi(Pointer(U),StrLenW(Pointer(U)));
end;
function SynUnicodeToString(const U: SynUnicode): string;
begin
result := CurrentAnsiConvert.UnicodeBufferToAnsi(Pointer(U),length(U));
end;
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
begin
CurrentAnsiConvert.UTF8BufferToAnsi(P,L,RawByteString(result));
end;
{$endif}

{$ifdef UNICODE}
function UTF8ToString(const Text: RawUTF8): string;
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string);
begin
UTF8DecodeToUnicodeString(pointer(Text),length(Text),result);
CurrentAnsiConvert.UTF8BufferToAnsi(P,L,RawByteString(result));
end;
{$else}
function UTF8ToString(const Text: RawUTF8): string;
begin
CurrentAnsiConvert.UTF8BufferToAnsi(pointer(Text),length(Text),RawByteString(result));
end;
{$endif}
{$endif UNICODE}

procedure UTF8ToWideString(const Text: RawUTF8; var result: WideString);
begin
LeftStr := tmp;
end;
if ToUpperCase then begin
LeftStr := UpperCaseU(LeftStr);
RightStr := UpperCaseU(RightStr);
UpperCaseSelf(LeftStr);
UpperCaseSelf(RightStr);
end;
end;

Split(Str,SepStr,LeftStr,result,ToUpperCase);
end;

procedure Split(const Str: RawUTF8; const SepStr: array of RawUTF8;
const DestPtr: array of PRawUTF8);
var s,i,j,n: integer;
function Split(const Str: RawUTF8; const SepStr: array of RawUTF8;
const DestPtr: array of PRawUTF8): PtrInt;
var s,i,j: PtrInt;
begin
j := 1;
n := 0;
result := 0;
s := 0;
if high(SepStr)>=0 then
while n<=high(DestPtr) do begin
while result<=high(DestPtr) do begin
i := PosEx(SepStr[s],Str,j);
if i=0 then begin
if DestPtr[n]<>nil then
DestPtr[n]^ := copy(Str,j,MaxInt);
inc(n);
if DestPtr[result]<>nil then
DestPtr[result]^ := copy(Str,j,MaxInt);
inc(result);
break;
end;
if DestPtr[n]<>nil then
DestPtr[n]^ := copy(Str,j,i-j);
inc(n);
if DestPtr[result]<>nil then
DestPtr[result]^ := copy(Str,j,i-j);
inc(result);
if s<high(SepStr) then
inc(s);
j := i+1;
end;
for i := n to high(DestPtr) do
for i := result to high(DestPtr) do
if DestPtr[i]<>nil then
DestPtr[i]^ := '';
end;
shell32,'SetCurrentProcessExplicitAppUserModelID');
if not Assigned(SetCurrentProcessExplicitAppUserModelID) then
exit; // API available since Windows Seven / Server 2008 R2
id := StringToSynUnicode(AppUserModelID);
StringToSynUnicode(AppUserModelID,id);
if Pos('.',AppUserModelID)=0 then
id := id+'.'+id; // at least CompanyName.ProductName
if SetCurrentProcessExplicitAppUserModelID(pointer(id))<>S_OK then
fStream.Seek(fInitialStreamPosition,soBeginning);
fStream.Read(pointer(result)^,Len);
end;
if reformat <> jsonCompact then begin // reformat using the very same instance
if reformat<>jsonCompact then begin // reformat using the very same instance
CancelAll;
AddJSONReformat(pointer(result),reformat,nil);
SetText(result);
@@ -1314,7 +1314,7 @@ function IsJetFile(const FileName: TFileName): boolean;
{ TOleDBStatement }

procedure TOleDBStatement.BindTextU(Param: Integer; const Value: RawUTF8;
IO: TSQLDBParamInOutType=paramIn);
IO: TSQLDBParamInOutType);
begin
if (Value='') and fConnection.Properties.StoreVoidStringAsNull then
CheckParam(Param,ftNull,IO) else
@@ -1352,13 +1352,13 @@ procedure TOleDBStatement.BindBlob(Param: Integer;
end;

procedure TOleDBStatement.BindBlob(Param: Integer; Data: pointer; Size: integer;
IO: TSQLDBParamInOutType=paramIn);
IO: TSQLDBParamInOutType);
begin
SetString(CheckParam(Param,ftBlob,IO)^.VBlob,PAnsiChar(Data),Size);
end;

procedure TOleDBStatement.Bind(Param: Integer; Value: double;
IO: TSQLDBParamInOutType=paramIn);
IO: TSQLDBParamInOutType);
begin
CheckParam(Param,ftDouble,IO)^.VInt64 := PInt64(@Value)^;
end;
@@ -1386,19 +1386,19 @@ procedure TOleDBStatement.BindArray(Param: Integer;
end;

procedure TOleDBStatement.Bind(Param: Integer; Value: Int64;
IO: TSQLDBParamInOutType=paramIn);
IO: TSQLDBParamInOutType);
begin
CheckParam(Param,ftInt64,IO)^.VInt64 := Value;
end;

procedure TOleDBStatement.BindCurrency(Param: Integer; Value: currency;
IO: TSQLDBParamInOutType=paramIn);
IO: TSQLDBParamInOutType);
begin
CheckParam(Param,ftCurrency,IO)^.VInt64 := PInt64(@Value)^;
end;

procedure TOleDBStatement.BindDateTime(Param: Integer; Value: TDateTime;
IO: TSQLDBParamInOutType=paramIn);
IO: TSQLDBParamInOutType);
begin
CheckParam(Param,ftDate,IO)^.VInt64 := PInt64(@Value)^;
end;
@@ -1 +1 @@
'1.18.5450'
'1.18.5451'

0 comments on commit 199a005

Please sign in to comment.
You can’t perform that action at this time.