mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
3709 lines
98 KiB
ObjectPascal
3709 lines
98 KiB
ObjectPascal
{-------------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is SynUnicode.pas by Maël Hörz, released 2004-05-30.
|
|
All Rights Reserved.
|
|
TUnicodeStrings/TUnicodeStringList-code (originally written by Mike Lischke) is based
|
|
on JclUnicode.pas which is part of the JCL (www.delphi-jedi.org).
|
|
|
|
Contributors to the SynEdit and mwEdit projects are listed in the
|
|
Contributors.txt file.
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
GNU General Public License Version 2 or later (the "GPL"), in which case
|
|
the provisions of the GPL are applicable instead of those above.
|
|
If you wish to allow use of your version of this file only under the terms
|
|
of the GPL and not to allow others to use your version of this file
|
|
under the MPL, indicate your decision by deleting the provisions above and
|
|
replace them with the notice and other provisions required by the GPL.
|
|
If you do not delete the provisions above, a recipient may use your version
|
|
of this file under either the MPL or the GPL.
|
|
|
|
$Id: SynUnicode.pas,v 1.1.3.19 2012/11/07 08:54:20 CodehunterWorks Exp $
|
|
|
|
You may retrieve the latest version of this file at the SynEdit home page,
|
|
located at http://SynEdit.SourceForge.net
|
|
|
|
Provides:
|
|
- Unicode(PWideChar) versions of the most important PAnsiChar-functions in
|
|
SysUtils and some functions unavailable in Delphi 5.
|
|
- An adapted and lighter version of TUnicodeStrings/TUnicodeStringList taken
|
|
from JCL, but made portable.
|
|
- function for loading and saving of Unicode files, and detecting the encoding
|
|
- Unicode clipboard support
|
|
- Unicode-version of TCanvas-methods
|
|
- Some character constants like CR&LF.
|
|
|
|
Last Changes:
|
|
- 1.1.3.19: Added TUnicodeStringList.CustomSort
|
|
-------------------------------------------------------------------------------}
|
|
|
|
{$IFNDEF QSYNUNICODE}
|
|
unit SynUnicode;
|
|
{$ENDIF}
|
|
|
|
{$I SynEdit.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}
|
|
Windows,
|
|
{$ENDIF}
|
|
Messages,
|
|
Controls,
|
|
Forms,
|
|
Graphics,
|
|
Clipbrd,
|
|
{$IFDEF SYN_COMPILER_6_UP}
|
|
Types,
|
|
{$ENDIF}
|
|
Classes,
|
|
SysUtils,
|
|
TypInfo;
|
|
|
|
{$IFNDEF SYN_COMPILER_6_UP}
|
|
type
|
|
UTF8String = type string;
|
|
PUTF8String = ^UTF8String;
|
|
{$ENDIF}
|
|
{$IFNDEF UNICODE}
|
|
type
|
|
UnicodeString = WideString;
|
|
{$ENDIF}
|
|
|
|
const
|
|
SLineBreak = {$IFDEF SYN_LINUX} #10 {$ELSE} #13#10 {$ENDIF};
|
|
UTF8BOM: array[0..2] of Byte = ($EF, $BB, $BF);
|
|
UTF16BOMLE: array[0..1] of Byte = ($FF, $FE);
|
|
UTF16BOMBE: array[0..1] of Byte = ($FE, $FF);
|
|
UTF32BOMLE: array[0..3] of Byte = ($FF, $FE, $00, $00);
|
|
UTF32BOMBE: array[0..3] of Byte = ($00, $00, $FE, $FF);
|
|
|
|
const
|
|
// constants describing range of the Unicode Private Use Area (Unicode 3.2)
|
|
PrivateUseLow = WideChar($E000);
|
|
PrivateUseHigh = WideChar($F8FF);
|
|
// filler char: helper for painting wide glyphs
|
|
FillerChar = PrivateUseLow;
|
|
|
|
const
|
|
WideNull = WideChar(#0);
|
|
WideTabulator = WideChar(#9);
|
|
WideSpace = WideChar(#32);
|
|
|
|
// logical line breaks
|
|
WideLF = WideChar(#10);
|
|
WideLineFeed = WideChar(#10);
|
|
WideVerticalTab = WideChar(#11);
|
|
WideFormFeed = WideChar(#12);
|
|
WideCR = WideChar(#13);
|
|
WideCarriageReturn = WideChar(#13);
|
|
WideCRLF = UnicodeString(#13#10);
|
|
WideLineSeparator = WideChar($2028);
|
|
WideParagraphSeparator = WideChar($2029);
|
|
|
|
// byte order marks for Unicode files
|
|
// Unicode text files (in UTF-16 format) should contain $FFFE as first character to
|
|
// identify such a file clearly. Depending on the system where the file was created
|
|
// on this appears either in big endian or little endian style.
|
|
BOM_LSB_FIRST = WideChar($FEFF);
|
|
BOM_MSB_FIRST = WideChar($FFFE);
|
|
|
|
type
|
|
TSaveFormat = (sfUTF16LSB, sfUTF16MSB, sfUTF8, sfAnsi);
|
|
|
|
const
|
|
sfUnicodeLSB = sfUTF16LSB;
|
|
sfUnicodeMSB = sfUTF16MSB;
|
|
|
|
type
|
|
TFontCharSet = 0..255;
|
|
|
|
{$IFDEF UNICODE}
|
|
TUnicodeStrings = TStrings;
|
|
{$ELSE}
|
|
{ TUnicodeStrings }
|
|
|
|
TUnicodeStrings = class;
|
|
|
|
// Event used to give the application a chance to switch the way of how to save
|
|
// the text in TUnicodeStrings if the text contains characters not only from the
|
|
// ANSI block but the save type is ANSI. On triggering the event the application
|
|
// can change the property SaveUnicode as needed. This property is again checked
|
|
// after the callback returns.
|
|
TConfirmConversionEvent = procedure (Sender: TUnicodeStrings; var Allowed: Boolean) of object;
|
|
|
|
TUnicodeStrings = class(TPersistent)
|
|
private
|
|
FUpdateCount: Integer;
|
|
FSaved: Boolean; // set in SaveToStream, True in case saving was successfull otherwise False
|
|
FOnConfirmConversion: TConfirmConversionEvent;
|
|
FSaveFormat: TSaveFormat; // overrides the FSaveUnicode flag, initialized when a file is loaded,
|
|
// expect losses if it is set to sfAnsi before saving
|
|
function GetCommaText: UnicodeString;
|
|
function GetName(Index: Integer): UnicodeString;
|
|
function GetValue(const Name: UnicodeString): UnicodeString;
|
|
procedure ReadData(Reader: TReader);
|
|
procedure SetCommaText(const Value: UnicodeString);
|
|
procedure SetValue(const Name, Value: UnicodeString);
|
|
procedure WriteData(Writer: TWriter);
|
|
function GetSaveUnicode: Boolean;
|
|
procedure SetSaveUnicode(const Value: Boolean);
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure DoConfirmConversion(var Allowed: Boolean); virtual;
|
|
procedure Error(const Msg: string; Data: Integer);
|
|
function Get(Index: Integer): UnicodeString; virtual; abstract;
|
|
function GetCapacity: Integer; virtual;
|
|
function GetCount: Integer; virtual; abstract;
|
|
function GetObject(Index: Integer): TObject; virtual;
|
|
function GetTextStr: UnicodeString; virtual;
|
|
procedure Put(Index: Integer; const S: UnicodeString); virtual; abstract;
|
|
procedure PutObject(Index: Integer; AObject: TObject); virtual; abstract;
|
|
procedure SetCapacity(NewCapacity: Integer); virtual;
|
|
procedure SetUpdateState(Updating: Boolean); virtual;
|
|
public
|
|
constructor Create;
|
|
|
|
function Add(const S: UnicodeString): Integer; virtual;
|
|
function AddObject(const S: UnicodeString; AObject: TObject): Integer; virtual;
|
|
procedure Append(const S: UnicodeString);
|
|
procedure AddStrings(Strings: TStrings); overload; virtual;
|
|
procedure AddStrings(Strings: TUnicodeStrings); overload; virtual;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
procedure BeginUpdate;
|
|
procedure Clear; virtual; abstract;
|
|
procedure Delete(Index: Integer); virtual; abstract;
|
|
procedure EndUpdate;
|
|
function Equals(Strings: TUnicodeStrings): Boolean;
|
|
procedure Exchange(Index1, Index2: Integer); virtual;
|
|
function GetSeparatedText(Separators: UnicodeString): UnicodeString; virtual;
|
|
function GetText: PWideChar; virtual;
|
|
function IndexOf(const S: UnicodeString): Integer; virtual;
|
|
function IndexOfName(const Name: UnicodeString): Integer;
|
|
function IndexOfObject(AObject: TObject): Integer;
|
|
procedure Insert(Index: Integer; const S: UnicodeString); virtual; abstract;
|
|
procedure InsertObject(Index: Integer; const S: UnicodeString; AObject: TObject);
|
|
procedure LoadFromFile(const FileName: TFileName); virtual;
|
|
procedure LoadFromStream(Stream: TStream); virtual;
|
|
procedure Move(CurIndex, NewIndex: Integer); virtual;
|
|
procedure SaveToFile(const FileName: TFileName); overload; virtual;
|
|
procedure SaveToFile(const FileName: TFileName; WithBOM: Boolean); overload; virtual;
|
|
procedure SaveToStream(Stream: TStream; WithBOM: Boolean = True); virtual;
|
|
procedure SetTextStr(const Value: UnicodeString); virtual;
|
|
|
|
property Capacity: Integer read GetCapacity write SetCapacity;
|
|
property CommaText: UnicodeString read GetCommaText write SetCommaText;
|
|
property Count: Integer read GetCount;
|
|
property Names[Index: Integer]: UnicodeString read GetName;
|
|
property Objects[Index: Integer]: TObject read GetObject write PutObject;
|
|
property Values[const Name: UnicodeString]: UnicodeString read GetValue write SetValue;
|
|
property Saved: Boolean read FSaved;
|
|
property SaveUnicode: Boolean read GetSaveUnicode write SetSaveUnicode default True;
|
|
property SaveFormat: TSaveFormat read FSaveFormat write FSaveFormat default sfUnicodeLSB;
|
|
property Strings[Index: Integer]: UnicodeString read Get write Put; default;
|
|
property Text: UnicodeString read GetTextStr write SetTextStr;
|
|
|
|
property OnConfirmConversion: TConfirmConversionEvent read FOnConfirmConversion write FOnConfirmConversion;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF UNICODE}
|
|
TUnicodeStringList = TStringList;
|
|
{$ELSE}
|
|
{ TUnicodeStringList }
|
|
|
|
//----- TUnicodeStringList class
|
|
TDynWideCharArray = array of WideChar;
|
|
TUnicodeStringItem = record
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
FString: PWideChar; // "array of WideChar";
|
|
{$ELSE}
|
|
FString: UnicodeString;
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
FObject: TObject;
|
|
end;
|
|
|
|
TUnicodeStringList = class;
|
|
TUnicodeStringItemList = array of TUnicodeStringItem;
|
|
TUnicodeStringListSortCompare = function (AString1, AString2: UnicodeString): Integer;
|
|
|
|
TUnicodeStringList = class(TUnicodeStrings)
|
|
private
|
|
FList: TUnicodeStringItemList;
|
|
FCount: Integer;
|
|
FSorted: Boolean;
|
|
FDuplicates: TDuplicates;
|
|
FOnChange: TNotifyEvent;
|
|
FOnChanging: TNotifyEvent;
|
|
procedure ExchangeItems(Index1, Index2: Integer);
|
|
procedure Grow;
|
|
procedure QuickSort(L, R: Integer); overload;
|
|
procedure QuickSort(L, R: Integer; SCompare: TUnicodeStringListSortCompare); overload;
|
|
procedure InsertItem(Index: Integer; const S: UnicodeString);
|
|
procedure SetSorted(Value: Boolean);
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
procedure SetListString(Index: Integer; const S: UnicodeString);
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
protected
|
|
procedure Changed; virtual;
|
|
procedure Changing; virtual;
|
|
function Get(Index: Integer): UnicodeString; override;
|
|
function GetCapacity: Integer; override;
|
|
function GetCount: Integer; override;
|
|
function GetObject(Index: Integer): TObject; override;
|
|
procedure Put(Index: Integer; const S: UnicodeString); override;
|
|
procedure PutObject(Index: Integer; AObject: TObject); override;
|
|
procedure SetCapacity(NewCapacity: Integer); override;
|
|
procedure SetUpdateState(Updating: Boolean); override;
|
|
public
|
|
destructor Destroy; override;
|
|
|
|
function Add(const S: UnicodeString): Integer; override;
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
procedure Exchange(Index1, Index2: Integer); override;
|
|
function Find(const S: UnicodeString; var Index: Integer): Boolean; virtual;
|
|
function IndexOf(const S: UnicodeString): Integer; override;
|
|
procedure Insert(Index: Integer; const S: UnicodeString); override;
|
|
procedure Sort; virtual;
|
|
procedure CustomSort(Compare: TUnicodeStringListSortCompare); virtual;
|
|
|
|
property Duplicates: TDuplicates read FDuplicates write FDuplicates;
|
|
property Sorted: Boolean read FSorted write SetSorted;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF UNICODE}
|
|
{ PWideChar versions of important PAnsiChar functions from SysUtils }
|
|
function WStrLen(const Str: PWideChar): Cardinal;
|
|
function WStrEnd(const Str: PWideChar): PWideChar;
|
|
function WStrMove(Dest: PWideChar; const Source: PWideChar; Count: Integer): PWideChar;
|
|
function WStrCopy(Dest: PWideChar; const Source: PWideChar): PWideChar;
|
|
function WStrLCopy(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
|
|
function WStrCat(Dest: PWideChar; const Source: PWideChar): PWideChar;
|
|
function WStrScan(const Str: PWideChar; Chr: WideChar): PWideChar;
|
|
function WStrAlloc(Size: Cardinal): PWideChar;
|
|
function WStrNew(const Str: PWideChar): PWideChar;
|
|
procedure WStrDispose(Str: PWideChar);
|
|
{$ENDIF}
|
|
|
|
|
|
{$IFNDEF SYN_COMPILER_6_UP}
|
|
{$IFDEF MSWINDOWS}
|
|
function UnicodeToUtf8(Dest: PAnsiChar; MaxDestBytes: Cardinal;
|
|
Source: PWideChar; SourceChars: Cardinal): Cardinal;
|
|
function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal;
|
|
Source: PAnsiChar; SourceBytes: Cardinal): Cardinal;
|
|
function UTF8Encode(const WS: UnicodeString): UTF8String;
|
|
function UTF8Decode(const S: UTF8String): UnicodeString;
|
|
function AnsiToUtf8(const S: string): UTF8String;
|
|
function Utf8ToAnsi(const S: UTF8String): string;
|
|
|
|
function WideCompareStr(const S1, S2: UnicodeString): Integer;
|
|
function WideCompareText(const S1, S2: UnicodeString): Integer;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
// Kylix has them, but Delphi 5 doesn't and Delphi 6&7 versions are buggy
|
|
// in Win9X (fix taken from Troy Wolbrinks TntUnicode-package)
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFNDEF UNICODE}
|
|
var
|
|
DefaultSystemCodePage: Cardinal; // implicitly used when converting AnsiString <--> UnicodeString.
|
|
{$ENDIF}
|
|
|
|
function WCharUpper(lpsz: PWideChar): PWideChar;
|
|
function WCharUpperBuff(lpsz: PWideChar; cchLength: DWORD): DWORD;
|
|
function WCharLower(lpsz: PWideChar): PWideChar;
|
|
function WCharLowerBuff(lpsz: PWideChar; cchLength: DWORD): DWORD;
|
|
{$ENDIF}
|
|
function SynWideUpperCase(const S: UnicodeString): UnicodeString;
|
|
function SynWideLowerCase(const S: UnicodeString): UnicodeString;
|
|
function SynIsCharAlpha(const C: WideChar): Boolean;
|
|
function SynIsCharAlphaNumeric(const C: WideChar): Boolean;
|
|
{$IFNDEF UNICODE}
|
|
function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
|
|
function CharInSet(C: WideChar; const CharSet: TSysCharSet): Boolean; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function WideLastDelimiter(const Delimiters, S: UnicodeString): Integer;
|
|
function UnicodeStringReplace(const S, OldPattern, NewPattern: UnicodeString;
|
|
Flags: TReplaceFlags): UnicodeString;
|
|
|
|
{ functions taken from JCLUnicode.pas }
|
|
function WStrComp(Str1, Str2: PWideChar): Integer;
|
|
function WStrLComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
|
|
procedure StrSwapByteOrder(Str: PWideChar);
|
|
function WideQuotedStr(const S: UnicodeString; Quote: WideChar): UnicodeString;
|
|
function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): UnicodeString;
|
|
function UnicodeStringOfChar(C: WideChar; Count: Cardinal): UnicodeString;
|
|
function WideTrim(const S: UnicodeString): UnicodeString;
|
|
function WideTrimLeft(const S: UnicodeString): UnicodeString;
|
|
function WideTrimRight(const S: UnicodeString): UnicodeString;
|
|
{$IFDEF MSWINDOWS}
|
|
function CharSetFromLocale(Language: LCID): TFontCharSet;
|
|
function CodePageFromLocale(Language: LCID): Integer;
|
|
function KeyboardCodePage: Word;
|
|
function KeyUnicode(C: AnsiChar): WideChar;
|
|
function StringToUnicodeStringEx(const S: AnsiString; CodePage: Word): UnicodeString;
|
|
function UnicodeStringToStringEx(const WS: UnicodeString; CodePage: Word): AnsiString;
|
|
{$ENDIF}
|
|
|
|
{ functions providing same behavior on Win9x and WinNT based systems}
|
|
function GetTextSize(DC: HDC; Str: PWideChar; Count: Integer): TSize;
|
|
|
|
{ Unicode versions of TCanvas-methods }
|
|
function TextExtent(ACanvas: TCanvas; const Text: UnicodeString): TSize;
|
|
function TextWidth(ACanvas: TCanvas; const Text: UnicodeString): Integer;
|
|
function TextHeight(ACanvas: TCanvas; const Text: UnicodeString): Integer;
|
|
procedure TextOut(ACanvas: TCanvas; X, Y: Integer; const Text: UnicodeString);
|
|
procedure TextRect(ACanvas: TCanvas; Rect: TRect; X, Y: Integer;
|
|
const Text: UnicodeString);
|
|
|
|
{ Unicode streaming-support }
|
|
type
|
|
TSynEncoding = (seUTF8, seUTF16LE, seUTF16BE, seAnsi);
|
|
TSynEncodings = set of TSynEncoding;
|
|
|
|
{$IFDEF UNICODE}
|
|
TWideFileStream = TFileStream;
|
|
{$ELSE}
|
|
TWideFileStream = class(THandleStream)
|
|
public
|
|
constructor Create(const FileName: UnicodeString; Mode: Word); overload;
|
|
constructor Create(const FileName: UnicodeString; Mode: Word; Rights: Cardinal); overload;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
function WideFileOpen(const FileName: UnicodeString; Mode: LongWord): Integer;
|
|
function WideFileCreate(const FileName: UnicodeString): Integer; overload;
|
|
function WideFileCreate(const FileName: UnicodeString; Rights: Integer): Integer; overload;
|
|
{$ENDIF}
|
|
|
|
function IsAnsiOnly(const WS: UnicodeString): Boolean;
|
|
function IsUTF8(Stream: TStream; out WithBOM: Boolean): Boolean; overload;
|
|
function IsUTF8(const FileName: UnicodeString; out WithBOM: Boolean): Boolean; overload;
|
|
function GetEncoding(const FileName: UnicodeString; out WithBOM: Boolean): TSynEncoding; overload;
|
|
function GetEncoding(Stream: TStream; out WithBOM: Boolean): TSynEncoding; overload;
|
|
procedure SaveToFile(const WS: UnicodeString; const FileName: UnicodeString;
|
|
Encoding: TSynEncoding; WithBom: Boolean = True); overload;
|
|
procedure SaveToFile(UnicodeStrings: TUnicodeStrings; const FileName: UnicodeString;
|
|
Encoding: TSynEncoding; WithBom: Boolean = True); overload;
|
|
function LoadFromFile(UnicodeStrings: TUnicodeStrings; const FileName: UnicodeString;
|
|
out WithBOM: Boolean): TSynEncoding; overload;
|
|
function LoadFromFile(UnicodeStrings: TUnicodeStrings; const FileName: UnicodeString;
|
|
Encoding: TSynEncoding; out WithBOM: Boolean): TSynEncoding; overload;
|
|
procedure SaveToStream(const WS: UnicodeString; Stream: TStream;
|
|
Encoding: TSynEncoding; WithBom: Boolean = True); overload;
|
|
procedure SaveToStream(UnicodeStrings: TUnicodeStrings; Stream: TStream;
|
|
Encoding: TSynEncoding; WithBom: Boolean = True); overload;
|
|
function LoadFromStream(UnicodeStrings: TUnicodeStrings; Stream: TStream;
|
|
out WithBOM: Boolean): TSynEncoding; overload;
|
|
function LoadFromStream(UnicodeStrings: TUnicodeStrings; Stream: TStream;
|
|
Encoding: TSynEncoding; out WithBOM: Boolean): TSynEncoding; overload;
|
|
function LoadFromStream(UnicodeStrings: TUnicodeStrings; Stream: TStream;
|
|
Encoding: TSynEncoding): TSynEncoding; overload;
|
|
|
|
function ClipboardProvidesText: Boolean;
|
|
function GetClipboardText: UnicodeString;
|
|
procedure SetClipboardText(const Text: UnicodeString);
|
|
|
|
{ misc functions }
|
|
{$IFNDEF UNICODE}
|
|
{$IFNDEF SYN_COMPILER_6_UP}
|
|
function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): UnicodeString;
|
|
procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: UnicodeString);
|
|
{$ENDIF}
|
|
procedure UnicodeDefineProperties(Filer: TFiler; Instance: TPersistent);
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
|
|
function IsUnicodeStringMappableToAnsi(const WS: UnicodeString): Boolean;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
var
|
|
Win32PlatformIsUnicode: Boolean;
|
|
{$ENDIF}
|
|
|
|
implementation
|
|
|
|
uses
|
|
SynEditTextBuffer,
|
|
{$IFDEF SYN_UNISCRIBE}
|
|
SynUsp10,
|
|
{$ENDIF}
|
|
Math,
|
|
{$IFDEF SYN_LINUX}
|
|
Libc,
|
|
{$ENDIF}
|
|
{$IFDEF USE_TNT_RUNTIME_SUPPORT}
|
|
TntSysUtils, TntClasses,
|
|
{$ENDIF}
|
|
SysConst,
|
|
{$IFDEF SYN_COMPILER_6_UP}
|
|
RTLConsts;
|
|
{$ELSE}
|
|
Consts;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF UNICODE}
|
|
{ TUnicodeStrings }
|
|
|
|
constructor TUnicodeStrings.Create;
|
|
begin
|
|
inherited;
|
|
FSaveFormat := sfUnicodeLSB;
|
|
end;
|
|
|
|
function TUnicodeStrings.GetSaveUnicode: Boolean;
|
|
begin
|
|
Result := SaveFormat in [sfUTF16LSB, sfUTF16MSB, sfUTF8];
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetSaveUnicode(const Value: Boolean);
|
|
begin
|
|
if Value then
|
|
SaveFormat := sfUnicodeLSB
|
|
else
|
|
SaveFormat := sfAnsi;
|
|
end;
|
|
|
|
function TUnicodeStrings.Add(const S: UnicodeString): Integer;
|
|
begin
|
|
Result := GetCount;
|
|
Insert(Result, S);
|
|
end;
|
|
|
|
function TUnicodeStrings.AddObject(const S: UnicodeString; AObject: TObject): Integer;
|
|
begin
|
|
Result := Add(S);
|
|
PutObject(Result, AObject);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Append(const S: UnicodeString);
|
|
begin
|
|
Add(S);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.AddStrings(Strings: TStrings);
|
|
var
|
|
I: Integer;
|
|
{$IFDEF MSWINDOWS}
|
|
S: UnicodeString;
|
|
CP: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
{$IFDEF MSWINDOWS}
|
|
CP := CodePageFromLocale(GetThreadLocale);
|
|
for I := 0 to Strings.Count - 1 do
|
|
begin
|
|
S := StringToUnicodeStringEx(Strings[I], CP);
|
|
AddObject(S, Strings.Objects[I]);
|
|
end;
|
|
{$ELSE}
|
|
for I := 0 to Strings.Count - 1 do
|
|
AddObject(Strings[I], Strings.Objects[I]);
|
|
{$ENDIF}
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.AddStrings(Strings: TUnicodeStrings);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Assert(Strings <> nil);
|
|
|
|
BeginUpdate;
|
|
try
|
|
for I := 0 to Strings.Count - 1 do
|
|
AddObject(Strings[I], Strings.Objects[I]);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Assign(Source: TPersistent);
|
|
// usual assignment routine, but able to assign wide and small strings
|
|
begin
|
|
if Source is TUnicodeStrings then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
AddStrings(TUnicodeStrings(Source));
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if Source is TStrings then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
AddStrings(TStrings(Source));
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.AssignTo(Dest: TPersistent);
|
|
// need to do also assignment to old style TStrings, but this class doesn't know
|
|
// TUnicodeStrings, so we need to do it from here
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Dest is TStrings then
|
|
begin
|
|
with Dest as TStrings do
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
for I := 0 to Self.Count - 1 do
|
|
AddObject(Self[I], Self.Objects[I]);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if Dest is TUnicodeStrings then
|
|
begin
|
|
with Dest as TUnicodeStrings do
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
AddStrings(Self);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.BeginUpdate;
|
|
begin
|
|
if FUpdateCount = 0 then
|
|
SetUpdateState(True);
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.DefineProperties(Filer: TFiler);
|
|
// Defines a private property for the content of the list.
|
|
// There's a bug in the handling of text DFMs in Classes.pas which prevents
|
|
// UnicodeStrings from loading under some circumstances. Zbysek Hlinka
|
|
// (zhlinka att login dott cz) brought this to my attention and supplied also a solution.
|
|
// See ReadData and WriteData methods for implementation details.
|
|
|
|
function DoWrite: Boolean;
|
|
begin
|
|
if Filer.Ancestor <> nil then
|
|
begin
|
|
Result := True;
|
|
if Filer.Ancestor is TUnicodeStrings then
|
|
Result := not Equals(TUnicodeStrings(Filer.Ancestor))
|
|
end
|
|
else
|
|
Result := Count > 0;
|
|
end;
|
|
|
|
begin
|
|
Filer.DefineProperty('UnicodeStrings', ReadData, WriteData, DoWrite);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.DoConfirmConversion(var Allowed: Boolean);
|
|
begin
|
|
if Assigned(FOnConfirmConversion) then
|
|
FOnConfirmConversion(Self, Allowed);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.EndUpdate;
|
|
begin
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount = 0 then
|
|
SetUpdateState(False);
|
|
end;
|
|
|
|
function TUnicodeStrings.Equals(Strings: TUnicodeStrings): Boolean;
|
|
var
|
|
I, Count: Integer;
|
|
begin
|
|
Assert(Strings <> nil);
|
|
|
|
Result := False;
|
|
Count := GetCount;
|
|
if Count <> Strings.GetCount then
|
|
Exit;
|
|
for I := 0 to Count - 1 do
|
|
if Get(I) <> Strings.Get(I) then
|
|
Exit;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Error(const Msg: string; Data: Integer);
|
|
|
|
function ReturnAddr: Pointer;
|
|
asm
|
|
MOV EAX, [EBP + 4]
|
|
end;
|
|
|
|
begin
|
|
raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Exchange(Index1, Index2: Integer);
|
|
var
|
|
TempObject: TObject;
|
|
TempString: UnicodeString;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
TempString := Strings[Index1];
|
|
TempObject := Objects[Index1];
|
|
Strings[Index1] := Strings[Index2];
|
|
Objects[Index1] := Objects[Index2];
|
|
Strings[Index2] := TempString;
|
|
Objects[Index2] := TempObject;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TUnicodeStrings.GetCapacity: Integer;
|
|
// Descendants may optionally override/replace this default implementation.
|
|
begin
|
|
Result := Count;
|
|
end;
|
|
|
|
function TUnicodeStrings.GetCommaText: UnicodeString;
|
|
var
|
|
S: UnicodeString;
|
|
P: PWideChar;
|
|
I, Count: Integer;
|
|
begin
|
|
Count := GetCount;
|
|
if (Count = 1) and (Get(0) = '') then
|
|
Result := '""'
|
|
else
|
|
begin
|
|
Result := '';
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
S := Get(I);
|
|
P := PWideChar(S);
|
|
while not (P^ in [WideNull..WideSpace, WideChar('"'), WideChar(',')]) do
|
|
Inc(P);
|
|
if P^ <> WideNull then
|
|
S := WideQuotedStr(S, '"');
|
|
Result := Result + S + ',';
|
|
end;
|
|
System.Delete(Result, Length(Result), 1);
|
|
end;
|
|
end;
|
|
|
|
function TUnicodeStrings.GetName(Index: Integer): UnicodeString;
|
|
var
|
|
P: Integer;
|
|
begin
|
|
Result := Get(Index);
|
|
P := Pos('=', Result);
|
|
if P > 0 then
|
|
SetLength(Result, P - 1)
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TUnicodeStrings.GetObject(Index: Integer): TObject;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TUnicodeStrings.GetSeparatedText(Separators: UnicodeString): UnicodeString;
|
|
// Same as GetText but with customizable separator characters.
|
|
var
|
|
I, L,
|
|
Size,
|
|
Count,
|
|
SepSize: Integer;
|
|
P: PWideChar;
|
|
S: UnicodeString;
|
|
begin
|
|
Count := GetCount;
|
|
SepSize := Length(Separators);
|
|
Size := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Size, Length(Get(I)) + SepSize);
|
|
|
|
// set one separator less, the last line does not need a trailing separator
|
|
SetLength(Result, Size - SepSize);
|
|
if Size > 0 then
|
|
begin
|
|
P := Pointer(Result);
|
|
I := 0;
|
|
while True do
|
|
begin
|
|
S := Get(I);
|
|
L := Length(S);
|
|
if L <> 0 then
|
|
begin
|
|
// add current string
|
|
System.Move(Pointer(S)^, P^, 2 * L);
|
|
Inc(P, L);
|
|
end;
|
|
Inc(I);
|
|
if I = Count then
|
|
Break;
|
|
|
|
// add separators
|
|
System.Move(Pointer(Separators)^, P^, SizeOf(WideChar) * SepSize);
|
|
Inc(P, SepSize);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TUnicodeStrings.GetTextStr: UnicodeString;
|
|
begin
|
|
Result := GetSeparatedText(WideCRLF);
|
|
end;
|
|
|
|
function TUnicodeStrings.GetText: PWideChar;
|
|
begin
|
|
Result := WStrNew(PWideChar(GetTextStr));
|
|
end;
|
|
|
|
function TUnicodeStrings.GetValue(const Name: UnicodeString): UnicodeString;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := IndexOfName(Name);
|
|
if I >= 0 then
|
|
Result := Copy(Get(I), Length(Name) + 2, MaxInt)
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TUnicodeStrings.IndexOf(const S: UnicodeString): Integer;
|
|
begin
|
|
for Result := 0 to GetCount - 1 do
|
|
if WideCompareText(Get(Result), S) = 0 then
|
|
Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TUnicodeStrings.IndexOfName(const Name: UnicodeString): Integer;
|
|
var
|
|
P: Integer;
|
|
S: UnicodeString;
|
|
begin
|
|
for Result := 0 to GetCount - 1 do
|
|
begin
|
|
S := Get(Result);
|
|
P := Pos('=', S);
|
|
if (P > 0) and (WideCompareText(Copy(S, 1, P - 1), Name) = 0) then
|
|
Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TUnicodeStrings.IndexOfObject(AObject: TObject): Integer;
|
|
begin
|
|
for Result := 0 to GetCount - 1 do
|
|
if GetObject(Result) = AObject then
|
|
Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.InsertObject(Index: Integer; const S: UnicodeString; AObject: TObject);
|
|
begin
|
|
Insert(Index, S);
|
|
PutObject(Index, AObject);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.LoadFromFile(const FileName: TFileName);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
|
|
try
|
|
LoadFromStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.LoadFromStream(Stream: TStream);
|
|
// usual loader routine, but enhanced to handle byte order marks in stream
|
|
var
|
|
Size,
|
|
BytesRead: Integer;
|
|
ByteOrderMask: array[0..5] of Byte; // BOM size is max 5 bytes (cf: wikipedia)
|
|
// but it is easier to implement with a multiple of 2
|
|
Loaded: Boolean;
|
|
SW: UnicodeString;
|
|
SA: AnsiString;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Loaded := False;
|
|
|
|
Size := Stream.Size - Stream.Position;
|
|
BytesRead := Stream.Read(ByteOrderMask[0], SizeOf(ByteOrderMask));
|
|
|
|
// UTF16 LSB = Unicode LSB/LE
|
|
if (BytesRead >= 2) and (ByteOrderMask[0] = UTF16BOMLE[0])
|
|
and (ByteOrderMask[1] = UTF16BOMLE[1]) then
|
|
begin
|
|
FSaveFormat := sfUTF16LSB;
|
|
SetLength(SW, (Size - 2) div SizeOf(WideChar));
|
|
Assert((Size and 1) <> 1, 'Number of chars must be a multiple of 2');
|
|
if BytesRead > 2 then
|
|
begin
|
|
System.Move(ByteOrderMask[2], SW[1], BytesRead - 2); // max 4 bytes = 2 widechars
|
|
if Size > BytesRead then
|
|
// first 2 chars (maximum) were copied by System.Move
|
|
Stream.Read(SW[3], Size - BytesRead);
|
|
end;
|
|
SetTextStr(SW);
|
|
Loaded := True;
|
|
end;
|
|
|
|
// UTF16 MSB = Unicode MSB/BE
|
|
if (BytesRead >= 2) and (ByteOrderMask[0] = UTF16BOMBE[0])
|
|
and (ByteOrderMask[1] = UTF16BOMBE[1]) then
|
|
begin
|
|
FSaveFormat := sfUTF16MSB;
|
|
SetLength(SW, (Size - 2) div SizeOf(WideChar));
|
|
Assert((Size and 1) <> 1, 'Number of chars must be a multiple of 2');
|
|
if BytesRead > 2 then
|
|
begin
|
|
System.Move(ByteOrderMask[2], SW[1] ,BytesRead - 2); // max 4 bytes = 2 widechars
|
|
if Size > BytesRead then
|
|
// first 2 chars (maximum) were copied by System.Move
|
|
Stream.Read(SW[3], Size - BytesRead);
|
|
StrSwapByteOrder(PWideChar(SW));
|
|
end;
|
|
SetTextStr(SW);
|
|
Loaded := True;
|
|
end;
|
|
|
|
// UTF8
|
|
if (BytesRead >= 3) and (ByteOrderMask[0] = UTF8BOM[0])
|
|
and (ByteOrderMask[1] = UTF8BOM[1]) and (ByteOrderMask[2] = UTF8BOM[2]) then
|
|
begin
|
|
FSaveFormat := sfUTF8;
|
|
SetLength(SA, (Size - 3) div SizeOf(AnsiChar));
|
|
if BytesRead > 3 then
|
|
begin
|
|
System.Move(ByteOrderMask[3], SA[1], BytesRead - 3); // max 3 bytes = 3 chars
|
|
if Size > BytesRead then
|
|
// first 3 chars were copied by System.Move
|
|
Stream.Read(SA[4], Size - BytesRead);
|
|
SW := UTF8Decode(SA);
|
|
end;
|
|
SetTextStr(SW);
|
|
Loaded := True;
|
|
end;
|
|
|
|
// default case (Ansi)
|
|
if not Loaded then
|
|
begin
|
|
FSaveFormat := sfAnsi;
|
|
SetLength(SA, Size div SizeOf(AnsiChar));
|
|
if BytesRead > 0 then
|
|
begin
|
|
System.Move(ByteOrderMask[0], SA[1], BytesRead); // max 6 bytes = 6 chars
|
|
if Size > BytesRead then
|
|
Stream.Read(SA[7], Size - BytesRead); // first 6 chars were copied by System.Move
|
|
SW := UTF8Decode(SA);
|
|
if SW <> '' then
|
|
begin
|
|
FSaveFormat := sfUTF8;
|
|
SetTextStr(SW);
|
|
Loaded := True;
|
|
end;
|
|
end;
|
|
if not Loaded then
|
|
SetTextStr(SA);
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Move(CurIndex, NewIndex: Integer);
|
|
var
|
|
TempObject: TObject;
|
|
TempString: UnicodeString;
|
|
begin
|
|
if CurIndex <> NewIndex then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
TempString := Get(CurIndex);
|
|
TempObject := GetObject(CurIndex);
|
|
Delete(CurIndex);
|
|
InsertObject(NewIndex, TempString, TempObject);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.ReadData(Reader: TReader);
|
|
begin
|
|
case Reader.NextValue of
|
|
vaLString, vaString:
|
|
SetTextStr(Reader.ReadString);
|
|
else
|
|
SetTextStr(Reader.ReadWideString);
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SaveToFile(const FileName: TFileName);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SaveToFile(const FileName: TFileName; WithBOM: Boolean);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(Stream, WithBOM);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SaveToStream(Stream: TStream; WithBOM: Boolean = True);
|
|
// Saves the currently loaded text into the given stream. WithBOM determines whether to write a
|
|
// byte order mark or not. Note: when saved as ANSI text there will never be a BOM.
|
|
var
|
|
SW: UnicodeString;
|
|
SA: AnsiString;
|
|
Allowed: Boolean;
|
|
Run: PWideChar;
|
|
begin
|
|
// The application can decide in which format to save the content.
|
|
// If FSaveUnicode is False then all strings are saved in standard ANSI format
|
|
// which is also loadable by TStrings but you should be aware that all Unicode
|
|
// strings are then converted to ANSI based on the current system locale.
|
|
// An extra event is supplied to ask the user about the potential loss of
|
|
// information when converting Unicode to ANSI strings.
|
|
SW := GetTextStr;
|
|
Allowed := True;
|
|
FSaved := False; // be pessimistic
|
|
// A check for potential information loss makes only sense if the application has
|
|
// set an event to be used as call back to ask about the conversion.
|
|
if not SaveUnicode and Assigned(FOnConfirmConversion) then
|
|
begin
|
|
// application requests to save only ANSI characters, so check the text and
|
|
// call back in case information could be lost
|
|
Run := PWideChar(SW);
|
|
// only ask if there's at least one Unicode character in the text
|
|
while Run^ in [WideChar(#1)..WideChar(#255)] do
|
|
Inc(Run);
|
|
// Note: The application can still set FSaveUnicode to True in the callback.
|
|
if Run^ <> WideNull then
|
|
DoConfirmConversion(Allowed);
|
|
end;
|
|
|
|
if Allowed then
|
|
begin
|
|
// only save if allowed
|
|
case SaveFormat of
|
|
sfUTF16LSB:
|
|
begin
|
|
if WithBOM then
|
|
Stream.WriteBuffer(UTF16BOMLE[0], SizeOf(UTF16BOMLE));
|
|
Stream.WriteBuffer(SW[1], Length(SW) * SizeOf(WideChar));
|
|
FSaved := True;
|
|
end;
|
|
sfUTF16MSB:
|
|
begin
|
|
if WithBOM then
|
|
Stream.WriteBuffer(UTF16BOMBE[0], SizeOf(UTF16BOMBE));
|
|
StrSwapByteOrder(PWideChar(SW));
|
|
Stream.WriteBuffer(SW[1], Length(SW) * SizeOf(WideChar));
|
|
FSaved := True;
|
|
end;
|
|
sfUTF8:
|
|
begin
|
|
if WithBOM then
|
|
Stream.WriteBuffer(UTF8BOM[0], SizeOf(UTF8BOM));
|
|
SA := UTF8Encode(SW);
|
|
Stream.WriteBuffer(SA[1], Length(SA) * SizeOf(AnsiChar));
|
|
FSaved := True;
|
|
end;
|
|
sfAnsi:
|
|
begin
|
|
SA := SW;
|
|
Stream.WriteBuffer(SA[1], Length(SA) * SizeOf(AnsiChar));
|
|
FSaved := True;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetCapacity(NewCapacity: Integer);
|
|
begin
|
|
// do nothing - descendants may optionally implement this method
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetCommaText(const Value: UnicodeString);
|
|
var
|
|
P, P1: PWideChar;
|
|
S: UnicodeString;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
P := PWideChar(Value);
|
|
while P^ in [WideChar(#1)..WideSpace] do
|
|
Inc(P);
|
|
while P^ <> WideNull do
|
|
begin
|
|
if P^ = '"' then
|
|
S := WideExtractQuotedStr(P, '"')
|
|
else
|
|
begin
|
|
P1 := P;
|
|
while (P^ > WideSpace) and (P^ <> ',') do
|
|
Inc(P);
|
|
SetString(S, P1, P - P1);
|
|
end;
|
|
Add(S);
|
|
|
|
while P^ in [WideChar(#1)..WideSpace] do
|
|
Inc(P);
|
|
if P^ = ',' then
|
|
begin
|
|
repeat
|
|
Inc(P);
|
|
until not (P^ in [WideChar(#1)..WideSpace]);
|
|
end;
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetTextStr(const Value: UnicodeString);
|
|
var
|
|
Head,
|
|
Tail: PWideChar;
|
|
S: UnicodeString;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
Head := PWideChar(Value);
|
|
while Head^ <> WideNull do
|
|
begin
|
|
Tail := Head;
|
|
while not (Tail^ in [WideNull, WideLineFeed, WideCarriageReturn, WideVerticalTab, WideFormFeed]) and
|
|
(Tail^ <> WideLineSeparator) and (Tail^ <> WideParagraphSeparator) do
|
|
Inc(Tail);
|
|
SetString(S, Head, Tail - Head);
|
|
Add(S);
|
|
Head := Tail;
|
|
if Head^ <> WideNull then
|
|
begin
|
|
Inc(Head);
|
|
if (Tail^ = WideCarriageReturn) and (Head^ = WideLineFeed) then
|
|
Inc(Head);
|
|
end;
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetUpdateState(Updating: Boolean);
|
|
begin
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetValue(const Name, Value: UnicodeString);
|
|
var
|
|
I : Integer;
|
|
begin
|
|
I := IndexOfName(Name);
|
|
if Value <> '' then
|
|
begin
|
|
if I < 0 then
|
|
I := Add('');
|
|
Put(I, Name + '=' + Value);
|
|
end
|
|
else
|
|
begin
|
|
if I >= 0 then
|
|
Delete(I);
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.WriteData(Writer: TWriter);
|
|
begin
|
|
Writer.WriteWideString(GetTextStr);
|
|
end;
|
|
|
|
|
|
{ TUnicodeStringList }
|
|
|
|
destructor TUnicodeStringList.Destroy;
|
|
begin
|
|
FOnChange := nil;
|
|
FOnChanging := nil;
|
|
Clear;
|
|
inherited;
|
|
end;
|
|
|
|
function TUnicodeStringList.Add(const S: UnicodeString): Integer;
|
|
begin
|
|
if not Sorted then
|
|
Result := FCount
|
|
else
|
|
begin
|
|
if Find(S, Result) then
|
|
begin
|
|
case Duplicates of
|
|
dupIgnore:
|
|
Exit;
|
|
dupError:
|
|
Error(SDuplicateString, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
InsertItem(Result, S);
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Changed;
|
|
begin
|
|
if (FUpdateCount = 0) and Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Changing;
|
|
begin
|
|
if (FUpdateCount = 0) and Assigned(FOnChanging) then
|
|
FOnChanging(Self);
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Clear;
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
var
|
|
I: Integer;
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
begin
|
|
if FCount <> 0 then
|
|
begin
|
|
Changing;
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
for I := 0 to FCount - 1 do
|
|
with FList[I] do
|
|
if TDynWideCharArray(FString) <> nil then
|
|
TDynWideCharArray(FString) := nil;
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
// this will automatically finalize the array
|
|
FList := nil;
|
|
FCount := 0;
|
|
SetCapacity(0);
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Delete(Index: Integer);
|
|
begin
|
|
if Cardinal(Index) >= Cardinal(FCount) then
|
|
Error(SListIndexError, Index);
|
|
Changing;
|
|
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
SetListString(Index, '');
|
|
{$ELSE}
|
|
FList[Index].FString := '';
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
Dec(FCount);
|
|
if Index < FCount then
|
|
begin
|
|
System.Move(FList[Index + 1], FList[Index], (FCount - Index) * SizeOf(TUnicodeStringItem));
|
|
Pointer(FList[FCount].FString) := nil; // avoid freeing the string, the address is now used in another element
|
|
end;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Exchange(Index1, Index2: Integer);
|
|
begin
|
|
if Cardinal(Index1) >= Cardinal(FCount) then
|
|
Error(SListIndexError, Index1);
|
|
if Cardinal(Index2) >= Cardinal(FCount) then
|
|
Error(SListIndexError, Index2);
|
|
Changing;
|
|
ExchangeItems(Index1, Index2);
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.ExchangeItems(Index1, Index2: Integer);
|
|
var
|
|
Temp: TUnicodeStringItem;
|
|
begin
|
|
Temp := FList[Index1];
|
|
FList[Index1] := FList[Index2];
|
|
FList[Index2] := Temp;
|
|
end;
|
|
|
|
function TUnicodeStringList.Find(const S: UnicodeString; var Index: Integer): Boolean;
|
|
var
|
|
L, H, I, C: Integer;
|
|
begin
|
|
Result := False;
|
|
L := 0;
|
|
H := FCount - 1;
|
|
while L <= H do
|
|
begin
|
|
I := (L + H) shr 1;
|
|
C := WideCompareText(FList[I].FString, S);
|
|
if C < 0 then
|
|
L := I+1
|
|
else
|
|
begin
|
|
H := I - 1;
|
|
if C = 0 then
|
|
begin
|
|
Result := True;
|
|
if Duplicates <> dupAccept then
|
|
L := I;
|
|
end;
|
|
end;
|
|
end;
|
|
Index := L;
|
|
end;
|
|
|
|
function TUnicodeStringList.Get(Index: Integer): UnicodeString;
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
var
|
|
Len: Integer;
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
begin
|
|
if Cardinal(Index) >= Cardinal(FCount) then
|
|
Error(SListIndexError, Index);
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
with FList[Index] do
|
|
begin
|
|
Len := Length(TDynWideCharArray(FString));
|
|
if Len > 0 then
|
|
begin
|
|
SetLength(Result, Len - 1); // exclude #0
|
|
if Result <> '' then
|
|
System.Move(FString^, Result[1], Len * SizeOf(WideChar));
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
{$ELSE}
|
|
Result := FList[Index].FString;
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
end;
|
|
|
|
function TUnicodeStringList.GetCapacity: Integer;
|
|
begin
|
|
Result := Length(FList);
|
|
end;
|
|
|
|
function TUnicodeStringList.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
function TUnicodeStringList.GetObject(Index: Integer): TObject;
|
|
begin
|
|
if Cardinal(Index) >= Cardinal(FCount) then
|
|
Error(SListIndexError, Index);
|
|
Result := FList[Index].FObject;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Grow;
|
|
var
|
|
Delta,
|
|
Len: Integer;
|
|
begin
|
|
Len := Length(FList);
|
|
if Len > 64 then
|
|
Delta := Len div 4
|
|
else
|
|
begin
|
|
if Len > 8 then
|
|
Delta := 16
|
|
else
|
|
Delta := 4;
|
|
end;
|
|
SetCapacity(Len + Delta);
|
|
end;
|
|
|
|
function TUnicodeStringList.IndexOf(const S: UnicodeString): Integer;
|
|
begin
|
|
if not Sorted then
|
|
Result := inherited IndexOf(S)
|
|
else
|
|
if not Find(S, Result) then
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Insert(Index: Integer; const S: UnicodeString);
|
|
begin
|
|
if Sorted then
|
|
Error(SSortedListError, 0);
|
|
if Cardinal(Index) > Cardinal(FCount) then
|
|
Error(SListIndexError, Index);
|
|
InsertItem(Index, S);
|
|
end;
|
|
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
procedure TUnicodeStringList.SetListString(Index: Integer; const S: UnicodeString);
|
|
var
|
|
Len: Integer;
|
|
A: TDynWideCharArray;
|
|
begin
|
|
with FList[Index] do
|
|
begin
|
|
Pointer(A) := TDynWideCharArray(FString);
|
|
if A <> nil then
|
|
A := nil; // free memory
|
|
|
|
Len := Length(S);
|
|
if Len > 0 then
|
|
begin
|
|
SetLength(A, Len + 1); // include #0
|
|
System.Move(S[1], A[0], Len * SizeOf(WideChar));
|
|
A[Len] := #0;
|
|
end;
|
|
|
|
FString := PWideChar(A);
|
|
Pointer(A) := nil; // do not release the array on procedure exit
|
|
end;
|
|
end;
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
|
|
procedure TUnicodeStringList.InsertItem(Index: Integer; const S: UnicodeString);
|
|
begin
|
|
Changing;
|
|
if FCount = Length(FList) then
|
|
Grow;
|
|
if Index < FCount then
|
|
System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(TUnicodeStringItem));
|
|
with FList[Index] do
|
|
begin
|
|
Pointer(FString) := nil; // avoid freeing the string, the address is now used in another element
|
|
FObject := nil;
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
SetListString(Index, S);
|
|
{$ELSE}
|
|
FString := S;
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
end;
|
|
Inc(FCount);
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Put(Index: Integer; const S: UnicodeString);
|
|
begin
|
|
if Sorted then
|
|
Error(SSortedListError, 0);
|
|
if Cardinal(Index) >= Cardinal(FCount) then
|
|
Error(SListIndexError, Index);
|
|
Changing;
|
|
|
|
{$IFDEF OWN_UnicodeString_MEMMGR}
|
|
SetListString(Index, S);
|
|
{$ELSE}
|
|
FList[Index].FString := S;
|
|
{$ENDIF OWN_UnicodeString_MEMMGR}
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.PutObject(Index: Integer; AObject: TObject);
|
|
begin
|
|
if Cardinal(Index) >= Cardinal(FCount) then
|
|
Error(SListIndexError, Index);
|
|
Changing;
|
|
FList[Index].FObject := AObject;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.QuickSort(L, R: Integer);
|
|
var
|
|
I, J: Integer;
|
|
P: UnicodeString;
|
|
begin
|
|
repeat
|
|
I := L;
|
|
J := R;
|
|
P := FList[(L + R) shr 1].FString;
|
|
repeat
|
|
while WideCompareText(FList[I].FString, P) < 0 do
|
|
Inc(I);
|
|
while WideCompareText(FList[J].FString, P) > 0 do
|
|
Dec(J);
|
|
if I <= J then
|
|
begin
|
|
ExchangeItems(I, J);
|
|
Inc(I);
|
|
Dec(J);
|
|
end;
|
|
until I > J;
|
|
if L < J then
|
|
QuickSort(L, J);
|
|
L := I;
|
|
until I >= R;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.QuickSort(L, R: Integer; SCompare: TUnicodeStringListSortCompare);
|
|
var
|
|
I, J: Integer;
|
|
P: UnicodeString;
|
|
begin
|
|
repeat
|
|
I := L;
|
|
J := R;
|
|
P := FList[(L + R) shr 1].FString;
|
|
repeat
|
|
while SCompare(FList[I].FString, P) < 0 do
|
|
Inc(I);
|
|
while SCompare(FList[J].FString, P) > 0 do
|
|
Dec(J);
|
|
if I <= J then
|
|
begin
|
|
ExchangeItems(I, J);
|
|
Inc(I);
|
|
Dec(J);
|
|
end;
|
|
until I > J;
|
|
if L < J then
|
|
QuickSort(L, J);
|
|
L := I;
|
|
until I >= R;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.CustomSort(Compare: TUnicodeStringListSortCompare);
|
|
begin
|
|
if not Sorted and (FCount > 1) then
|
|
begin
|
|
Changing;
|
|
QuickSort(0, FCount - 1, Compare);
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.SetCapacity(NewCapacity: Integer);
|
|
begin
|
|
SetLength(FList, NewCapacity);
|
|
if NewCapacity < FCount then
|
|
FCount := NewCapacity;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.SetSorted(Value: Boolean);
|
|
begin
|
|
if FSorted <> Value then
|
|
begin
|
|
if Value then
|
|
Sort;
|
|
FSorted := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.SetUpdateState(Updating: Boolean);
|
|
begin
|
|
if Updating then
|
|
Changing
|
|
else
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Sort;
|
|
begin
|
|
if not Sorted and (FCount > 1) then
|
|
begin
|
|
Changing;
|
|
QuickSort(0, FCount - 1);
|
|
Changed;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function WStrLen(const Str: PWideChar): Cardinal;
|
|
asm
|
|
MOV EDX,EDI
|
|
MOV EDI,EAX
|
|
MOV ECX,0FFFFFFFFH
|
|
XOR AX,AX
|
|
REPNE SCASW
|
|
MOV EAX,0FFFFFFFEH
|
|
SUB EAX,ECX
|
|
MOV EDI,EDX
|
|
end;
|
|
|
|
function WStrEnd(const Str: PWideChar): PWideChar;
|
|
asm
|
|
MOV EDX,EDI
|
|
MOV EDI,EAX
|
|
MOV ECX,0FFFFFFFFH
|
|
XOR AX,AX
|
|
REPNE SCASW
|
|
LEA EAX,[EDI-2]
|
|
MOV EDI,EDX
|
|
end;
|
|
|
|
function WStrMove(Dest: PWideChar; const Source: PWideChar; Count: Integer): PWideChar;
|
|
begin
|
|
Result := Dest;
|
|
System.Move(Source^, Dest^, Count * SizeOf(WideChar));
|
|
end;
|
|
|
|
function WStrCopy(Dest: PWideChar; const Source: PWideChar): PWideChar;
|
|
{$IFDEF SYN_COMPILER_16_UP}
|
|
begin
|
|
Result := SysUtils.StrCopy(Dest, Source)
|
|
{$ELSE}
|
|
asm
|
|
PUSH EDI
|
|
PUSH ESI
|
|
MOV ESI,EAX
|
|
MOV EDI,EDX
|
|
MOV ECX,0FFFFFFFFH
|
|
XOR AX,AX
|
|
REPNE SCASW
|
|
NOT ECX
|
|
MOV EDI,ESI
|
|
MOV ESI,EDX
|
|
MOV EDX,ECX
|
|
MOV EAX,EDI
|
|
SHR ECX,1
|
|
REP MOVSD
|
|
MOV ECX,EDX
|
|
AND ECX,1
|
|
REP MOVSW
|
|
POP ESI
|
|
POP EDI
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function WStrLCopy(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
|
|
{$IFDEF SYN_COMPILER_16_UP}
|
|
begin
|
|
Result := SysUtils.StrLCopy(Dest, Source, MaxLen)
|
|
{$ELSE}
|
|
asm
|
|
PUSH EDI
|
|
PUSH ESI
|
|
PUSH EBX
|
|
MOV ESI,EAX
|
|
MOV EDI,EDX
|
|
MOV EBX,ECX
|
|
XOR AX,AX
|
|
TEST ECX,ECX
|
|
JZ @@1
|
|
REPNE SCASW
|
|
JNE @@1
|
|
Inc ECX
|
|
@@1: SUB EBX,ECX
|
|
MOV EDI,ESI
|
|
MOV ESI,EDX
|
|
MOV EDX,EDI
|
|
MOV ECX,EBX
|
|
SHR ECX,1
|
|
REP MOVSD
|
|
MOV ECX,EBX
|
|
AND ECX,1
|
|
REP MOVSW
|
|
STOSW
|
|
MOV EAX,EDX
|
|
POP EBX
|
|
POP ESI
|
|
POP EDI
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function WStrCat(Dest: PWideChar; const Source: PWideChar): PWideChar;
|
|
begin
|
|
WStrCopy(WStrEnd(Dest), Source);
|
|
Result := Dest;
|
|
end;
|
|
|
|
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 WStrAlloc(Size: Cardinal): PWideChar;
|
|
begin
|
|
Size := SizeOf(WideChar) * Size + SizeOf(Cardinal);
|
|
GetMem(Result, Size);
|
|
Cardinal(Pointer(Result)^) := Size;
|
|
Inc(PByte(Result), SizeOf(Cardinal));
|
|
end;
|
|
|
|
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(PByte(Str), SizeOf(Cardinal));
|
|
FreeMem(Str, Cardinal(Pointer(Str)^));
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF SYN_COMPILER_6_UP}
|
|
{$IFDEF MSWINDOWS}
|
|
function UnicodeToUtf8(Dest: PAnsiChar; MaxDestBytes: Cardinal;
|
|
Source: PWideChar; SourceChars: Cardinal): Cardinal;
|
|
var
|
|
i, count: Cardinal;
|
|
c: Cardinal;
|
|
begin
|
|
Result := 0;
|
|
if Source = nil then Exit;
|
|
count := 0;
|
|
i := 0;
|
|
if Dest <> nil then
|
|
begin
|
|
while (i < SourceChars) and (count < MaxDestBytes) do
|
|
begin
|
|
c := Cardinal(Source[i]);
|
|
Inc(i);
|
|
if c <= $7F then
|
|
begin
|
|
Dest[count] := Char(c);
|
|
Inc(count);
|
|
end
|
|
else if c > $7FF then
|
|
begin
|
|
if count + 3 > MaxDestBytes then
|
|
Break;
|
|
Dest[count] := Char($E0 or (c shr 12));
|
|
Dest[count+1] := Char($80 or ((c shr 6) and $3F));
|
|
Dest[count+2] := Char($80 or (c and $3F));
|
|
Inc(count,3);
|
|
end
|
|
else // $7F < Source[i] <= $7FF
|
|
begin
|
|
if count + 2 > MaxDestBytes then
|
|
Break;
|
|
Dest[count] := Char($C0 or (c shr 6));
|
|
Dest[count+1] := Char($80 or (c and $3F));
|
|
Inc(count,2);
|
|
end;
|
|
end;
|
|
if count >= MaxDestBytes then count := MaxDestBytes-1;
|
|
Dest[count] := #0;
|
|
end
|
|
else
|
|
begin
|
|
while i < SourceChars do
|
|
begin
|
|
c := Integer(Source[i]);
|
|
Inc(i);
|
|
if c > $7F then
|
|
begin
|
|
if c > $7FF then
|
|
Inc(count);
|
|
Inc(count);
|
|
end;
|
|
Inc(count);
|
|
end;
|
|
end;
|
|
Result := count+1; // convert zero based index to byte count
|
|
end;
|
|
|
|
function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal;
|
|
Source: PAnsiChar; SourceBytes: Cardinal): Cardinal;
|
|
var
|
|
i, count: Cardinal;
|
|
c: Byte;
|
|
wc: Cardinal;
|
|
begin
|
|
if Source = nil then
|
|
begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
Result := Cardinal(-1);
|
|
count := 0;
|
|
i := 0;
|
|
if Dest <> nil then
|
|
begin
|
|
while (i < SourceBytes) and (count < MaxDestChars) do
|
|
begin
|
|
wc := Cardinal(Source[i]);
|
|
Inc(i);
|
|
if (wc and $80) <> 0 then
|
|
begin
|
|
if i >= SourceBytes then Exit; // incomplete multibyte char
|
|
wc := wc and $3F;
|
|
if (wc and $20) <> 0 then
|
|
begin
|
|
c := Byte(Source[i]);
|
|
Inc(i);
|
|
if (c and $C0) <> $80 then Exit; // malformed trail byte or out of range char
|
|
if i >= SourceBytes then Exit; // incomplete multibyte char
|
|
wc := (wc shl 6) or (c and $3F);
|
|
end;
|
|
c := Byte(Source[i]);
|
|
Inc(i);
|
|
if (c and $C0) <> $80 then Exit; // malformed trail byte
|
|
|
|
Dest[count] := WideChar((wc shl 6) or (c and $3F));
|
|
end
|
|
else
|
|
Dest[count] := WideChar(wc);
|
|
Inc(count);
|
|
end;
|
|
if count >= MaxDestChars then count := MaxDestChars-1;
|
|
Dest[count] := #0;
|
|
end
|
|
else
|
|
begin
|
|
while (i < SourceBytes) do
|
|
begin
|
|
c := Byte(Source[i]);
|
|
Inc(i);
|
|
if (c and $80) <> 0 then
|
|
begin
|
|
if i >= SourceBytes then Exit; // incomplete multibyte char
|
|
c := c and $3F;
|
|
if (c and $20) <> 0 then
|
|
begin
|
|
c := Byte(Source[i]);
|
|
Inc(i);
|
|
if (c and $C0) <> $80 then Exit; // malformed trail byte or out of range char
|
|
if i >= SourceBytes then Exit; // incomplete multibyte char
|
|
end;
|
|
c := Byte(Source[i]);
|
|
Inc(i);
|
|
if (c and $C0) <> $80 then Exit; // malformed trail byte
|
|
end;
|
|
Inc(count);
|
|
end;
|
|
end;
|
|
Result := count+1;
|
|
end;
|
|
|
|
function Utf8Encode(const WS: UnicodeString): UTF8String;
|
|
var
|
|
L: Integer;
|
|
Temp: UTF8String;
|
|
begin
|
|
Result := '';
|
|
if WS = '' then Exit;
|
|
SetLength(Temp, Length(WS) * 3); // SetLength includes space for null terminator
|
|
|
|
L := UnicodeToUtf8(PAnsiChar(Temp), Length(Temp)+1, PWideChar(WS), Length(WS));
|
|
if L > 0 then
|
|
SetLength(Temp, L-1)
|
|
else
|
|
Temp := '';
|
|
Result := Temp;
|
|
end;
|
|
|
|
function Utf8Decode(const S: UTF8String): UnicodeString;
|
|
var
|
|
L: Integer;
|
|
Temp: UnicodeString;
|
|
begin
|
|
Result := '';
|
|
if S = '' then Exit;
|
|
SetLength(Temp, Length(S));
|
|
|
|
L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PAnsiChar(S), Length(S));
|
|
if L > 0 then
|
|
SetLength(Temp, L-1)
|
|
else
|
|
Temp := '';
|
|
Result := Temp;
|
|
end;
|
|
|
|
function AnsiToUtf8(const S: string): UTF8String;
|
|
begin
|
|
Result := Utf8Encode(S);
|
|
end;
|
|
|
|
function Utf8ToAnsi(const S: UTF8String): string;
|
|
begin
|
|
Result := Utf8Decode(S);
|
|
end;
|
|
|
|
function DumbItDownFor95(const S1, S2: UnicodeString; CmpFlags: Integer): Integer;
|
|
var
|
|
a1, a2: AnsiString;
|
|
begin
|
|
a1 := s1;
|
|
a2 := s2;
|
|
Result := CompareStringA(LOCALE_USER_DEFAULT, CmpFlags, PAnsiChar(a1),
|
|
Length(a1), PAnsiChar(a2), Length(a2)) - 2;
|
|
end;
|
|
|
|
function WideCompareStr(const S1, S2: UnicodeString): 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
|
|
RaiseLastWin32Error;
|
|
end;
|
|
end;
|
|
|
|
function WideCompareText(const S1, S2: UnicodeString): 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
|
|
RaiseLastWin32Error;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
// The Win9X fix for SynWideUpperCase and SynWideLowerCase was taken
|
|
// from Troy Wolbrinks, TntUnicode-package.
|
|
|
|
function WCharUpper(lpsz: PWideChar): PWideChar;
|
|
var
|
|
AStr: AnsiString;
|
|
WStr: UnicodeString;
|
|
begin
|
|
if Win32PlatformIsUnicode then
|
|
Result := Windows.CharUpperW(lpsz)
|
|
else
|
|
begin
|
|
if HiWord(Cardinal(lpsz)) = 0 then
|
|
begin
|
|
// literal char mode
|
|
Result := lpsz;
|
|
if IsWideCharMappableToAnsi(WideChar(lpsz)) then
|
|
begin
|
|
AStr := AnsiString(WideChar(lpsz)); // single character may be more than one byte
|
|
Windows.CharUpperA(PAnsiChar(AStr));
|
|
WStr := UnicodeString(AStr); // should always be single wide char
|
|
if Length(WStr) = 1 then
|
|
Result := PWideChar(WStr[1]);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
// null-terminated string mode
|
|
Result := lpsz;
|
|
while lpsz^ <> #0 do
|
|
begin
|
|
lpsz^ := WideChar(SynUnicode.WCharUpper(PWideChar(lpsz^)));
|
|
Inc(lpsz);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function WCharUpperBuff(lpsz: PWideChar; cchLength: DWORD): DWORD;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Win32PlatformIsUnicode then
|
|
Result := Windows.CharUpperBuffW(lpsz, cchLength)
|
|
else
|
|
begin
|
|
Result := cchLength;
|
|
for i := 1 to cchLength do
|
|
begin
|
|
lpsz^ := WideChar(SynUnicode.WCharUpper(PWideChar(lpsz^)));
|
|
Inc(lpsz);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function WCharLower(lpsz: PWideChar): PWideChar;
|
|
var
|
|
AStr: AnsiString;
|
|
WStr: UnicodeString;
|
|
begin
|
|
if Win32PlatformIsUnicode then
|
|
Result := Windows.CharLowerW(lpsz)
|
|
else
|
|
begin
|
|
if HiWord(Cardinal(lpsz)) = 0 then
|
|
begin
|
|
// literal char mode
|
|
Result := lpsz;
|
|
if IsWideCharMappableToAnsi(WideChar(lpsz)) then
|
|
begin
|
|
AStr := AnsiString(WideChar(lpsz)); // single character may be more than one byte
|
|
Windows.CharLowerA(PAnsiChar(AStr));
|
|
WStr := UnicodeString(AStr); // should always be single wide char
|
|
if Length(WStr) = 1 then
|
|
Result := PWideChar(WStr[1]);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
// null-terminated string mode
|
|
Result := lpsz;
|
|
while lpsz^ <> #0 do
|
|
begin
|
|
lpsz^ := WideChar(SynUnicode.WCharLower(PWideChar(lpsz^)));
|
|
Inc(lpsz);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function WCharLowerBuff(lpsz: PWideChar; cchLength: DWORD): DWORD;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Win32PlatformIsUnicode then
|
|
Result := Windows.CharLowerBuffW(lpsz, cchLength)
|
|
else
|
|
begin
|
|
Result := cchLength;
|
|
for i := 1 to cchLength do
|
|
begin
|
|
lpsz^ := WideChar(SynUnicode.WCharLower(PWideChar(lpsz^)));
|
|
Inc(lpsz);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function SynWideUpperCase(const S: UnicodeString): UnicodeString;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Len := Length(S);
|
|
SetString(Result, PWideChar(S), Len);
|
|
if Len > 0 then
|
|
SynUnicode.WCharUpperBuff(Pointer(Result), Len);
|
|
end;
|
|
|
|
function SynWideLowerCase(const S: UnicodeString): UnicodeString;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Len := Length(S);
|
|
SetString(Result, PWideChar(S), Len);
|
|
if Len > 0 then
|
|
SynUnicode.WCharLowerBuff(Pointer(Result), Len);
|
|
end;
|
|
{$ELSE}
|
|
function SynWideUpperCase(const S: UnicodeString): UnicodeString;
|
|
begin
|
|
Result := WideUpperCase(S);
|
|
end;
|
|
|
|
function SynWideLowerCase(const S: UnicodeString): UnicodeString;
|
|
begin
|
|
Result := WideLowerCase(S);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function SynIsCharAlpha(const C: WideChar): Boolean;
|
|
begin
|
|
if Win32PlatformIsUnicode then
|
|
Result := IsCharAlphaW(C)
|
|
else
|
|
// returns false if C is not mappable to ANSI
|
|
Result := IsCharAlphaA(AnsiChar(C));
|
|
end;
|
|
|
|
function SynIsCharAlphaNumeric(const C: WideChar): Boolean;
|
|
begin
|
|
if Win32PlatformIsUnicode then
|
|
Result := IsCharAlphaNumericW(C)
|
|
else
|
|
// returns false if C is not mappable to ANSI
|
|
Result := IsCharAlphaNumericA(AnsiChar(C));
|
|
end;
|
|
{$ELSE}
|
|
function SynIsCharAlpha(const C: WideChar): Boolean;
|
|
begin
|
|
Result := IsAlpha(Integer(ch)) <> 0;
|
|
end;
|
|
|
|
function SynIsCharAlphaNumeric(const C: WideChar): Boolean;
|
|
begin
|
|
Result := IsAlNum(Integer(ch)) <> 0;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF UNICODE}
|
|
function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean;
|
|
begin
|
|
Result := C in CharSet;
|
|
end;
|
|
|
|
function CharInSet(C: WideChar; const CharSet: TSysCharSet): Boolean;
|
|
begin
|
|
Result := (C < #$0100) and (AnsiChar(C) in CharSet);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function WideLastDelimiter(const Delimiters, S: UnicodeString): Integer;
|
|
var
|
|
P: PWideChar;
|
|
begin
|
|
Result := Length(S);
|
|
P := PWideChar(Delimiters);
|
|
while Result > 0 do
|
|
begin
|
|
if (S[Result] <> #0) and (WStrScan(P, S[Result]) <> nil) then
|
|
Exit;
|
|
Dec(Result);
|
|
end;
|
|
end;
|
|
|
|
function UnicodeStringReplace(const S, OldPattern, NewPattern: UnicodeString;
|
|
Flags: TReplaceFlags): UnicodeString;
|
|
var
|
|
SearchStr, Patt, NewStr: UnicodeString;
|
|
Offset: Integer;
|
|
begin
|
|
if rfIgnoreCase in Flags then
|
|
begin
|
|
SearchStr := SynWideUpperCase(S);
|
|
Patt := SynWideUpperCase(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;
|
|
|
|
const
|
|
// data used to bring UTF-16 coded strings into correct UTF-32 order for correct comparation
|
|
UTF16Fixup: array[0..31] of Word = (
|
|
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
$2000, $F800, $F800, $F800, $F800
|
|
);
|
|
|
|
// Binary comparation of Str1 and Str2 with surrogate fix-up.
|
|
// Returns < 0 if Str1 is smaller in binary order than Str2, = 0 if both strings are
|
|
// equal and > 0 if Str1 is larger than Str2.
|
|
//
|
|
// This code is based on an idea of Markus W. Scherer (IBM).
|
|
// Note: The surrogate fix-up is necessary because some single value code points have
|
|
// larger values than surrogates which are in UTF-32 actually larger.
|
|
function WStrComp(Str1, Str2: PWideChar): Integer;
|
|
var
|
|
C1, C2: Word;
|
|
Run1, Run2: PWideChar;
|
|
begin
|
|
Run1 := Str1;
|
|
Run2 := Str2;
|
|
repeat
|
|
C1 := Word(Run1^);
|
|
C1 := Word(C1 + UTF16Fixup[C1 shr 11]);
|
|
C2 := Word(Run2^);
|
|
C2 := Word(C2 + UTF16Fixup[C2 shr 11]);
|
|
|
|
// now C1 and C2 are in UTF-32-compatible order
|
|
Result := Integer(C1) - Integer(C2);
|
|
if(Result <> 0) or (C1 = 0) or (C2 = 0) then
|
|
Break;
|
|
Inc(Run1);
|
|
Inc(Run2);
|
|
until False;
|
|
|
|
// If the strings have different lengths but the comparation returned equity so far
|
|
// then adjust the result so that the longer string is marked as the larger one.
|
|
if Result = 0 then
|
|
Result := (Run1 - Str1) - (Run2 - Str2);
|
|
end;
|
|
|
|
// compares strings up to MaxLen code points
|
|
// see also StrCompW
|
|
function WStrLComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
|
|
var
|
|
C1, C2: Word;
|
|
begin
|
|
if MaxLen > 0 then
|
|
begin
|
|
repeat
|
|
C1 := Word(Str1^);
|
|
C1 := Word(C1 + UTF16Fixup[C1 shr 11]);
|
|
C2 := Word(Str2^);
|
|
C2 := Word(C2 + UTF16Fixup[C2 shr 11]);
|
|
|
|
// now C1 and C2 are in UTF-32-compatible order
|
|
{ TODO : surrogates take up 2 words and are counted twice here, count them only once }
|
|
Result := Integer(C1) - Integer(C2);
|
|
Dec(MaxLen);
|
|
if(Result <> 0) or (C1 = 0) or (C2 = 0) or (MaxLen = 0) then
|
|
Break;
|
|
Inc(Str1);
|
|
Inc(Str2);
|
|
until False;
|
|
end
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
// exchanges in each character of the given string the low order and high order
|
|
// byte to go from LSB to MSB and vice versa.
|
|
// EAX contains address of string
|
|
procedure StrSwapByteOrder(Str: PWideChar);
|
|
{$IFDEF SYN_COMPILER_16_UP}
|
|
var
|
|
P: PWord;
|
|
begin
|
|
P := PWord(Str);
|
|
while P^ <> 0 do
|
|
begin
|
|
P^ := MakeWord(HiByte(P^), LoByte(P^));
|
|
Inc(P);
|
|
end;
|
|
{$ELSE}
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
MOV ESI, EAX
|
|
MOV EDI, ESI
|
|
XOR EAX, EAX // clear high order byte to be able to use 32bit operand below
|
|
@@1:
|
|
LODSW
|
|
OR EAX, EAX
|
|
JZ @@2
|
|
XCHG AL, AH
|
|
STOSW
|
|
JMP @@1
|
|
|
|
|
|
@@2:
|
|
POP EDI
|
|
POP ESI
|
|
{$ENDIF}
|
|
end;
|
|
|
|
// works like QuotedStr from SysUtils.pas but can insert any quotation character
|
|
function WideQuotedStr(const S: UnicodeString; Quote: WideChar): UnicodeString;
|
|
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;
|
|
|
|
// extracts a string enclosed in quote characters given by Quote
|
|
function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): UnicodeString;
|
|
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 // count adjacent pairs of quote chars
|
|
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^, 2 * (Src - P));
|
|
Inc(Dest, Src - P);
|
|
Inc(Src);
|
|
P := Src;
|
|
Src := WStrScan(Src, Quote);
|
|
end;
|
|
if Src = nil then
|
|
Src := WStrEnd(P);
|
|
Move(P^, Dest^, 2 * (Src - P - 1));
|
|
end;
|
|
end;
|
|
|
|
// returns a string of Count characters filled with C
|
|
function UnicodeStringOfChar(C: WideChar; Count: Cardinal): UnicodeString;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
SetLength(Result, Count);
|
|
for I := 1 to Count do
|
|
Result[I] := C;
|
|
end;
|
|
|
|
function WideTrim(const S: UnicodeString): UnicodeString;
|
|
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 WideTrimLeft(const S: UnicodeString): UnicodeString;
|
|
var
|
|
I, L: Integer;
|
|
begin
|
|
L := Length(S);
|
|
I := 1;
|
|
while (I <= L) and (S[I] <= ' ') do Inc(I);
|
|
Result := Copy(S, I, Maxint);
|
|
end;
|
|
|
|
function WideTrimRight(const S: UnicodeString): UnicodeString;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := Length(S);
|
|
while (I > 0) and (S[I] <= ' ') do Dec(I);
|
|
Result := Copy(S, 1, I);
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function TranslateCharsetInfoEx(lpSrc: PDWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall;
|
|
external 'gdi32.dll' name 'TranslateCharsetInfo';
|
|
|
|
function CharSetFromLocale(Language: LCID): TFontCharSet;
|
|
var
|
|
CP: Cardinal;
|
|
CSI: TCharsetInfo;
|
|
begin
|
|
CP:= CodePageFromLocale(Language);
|
|
TranslateCharsetInfoEx(Pointer(CP), CSI, TCI_SRCCODEPAGE);
|
|
Result:= CSI.ciCharset;
|
|
end;
|
|
|
|
// determines the code page for a given locale
|
|
function CodePageFromLocale(Language: LCID): Integer;
|
|
var
|
|
Buf: array[0..6] of Char;
|
|
begin
|
|
GetLocaleInfo(Language, LOCALE_IDefaultAnsiCodePage, Buf, 6);
|
|
Result := StrToIntDef(Buf, GetACP);
|
|
end;
|
|
|
|
function KeyboardCodePage: Word;
|
|
begin
|
|
Result := CodePageFromLocale(GetKeyboardLayout(0) and $FFFF);
|
|
end;
|
|
|
|
// converts the given character (as it comes with a WM_CHAR message) into its
|
|
// corresponding Unicode character depending on the active keyboard layout
|
|
function KeyUnicode(C: AnsiChar): WideChar;
|
|
begin
|
|
MultiByteToWideChar(KeyboardCodePage, MB_USEGLYPHCHARS, @C, 1, @Result, 1);
|
|
end;
|
|
|
|
function StringToUnicodeStringEx(const S: AnsiString; CodePage: Word): UnicodeString;
|
|
var
|
|
InputLength,
|
|
OutputLength: Integer;
|
|
begin
|
|
InputLength := Length(S);
|
|
OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength,
|
|
nil, 0);
|
|
SetLength(Result, OutputLength);
|
|
MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result),
|
|
OutputLength);
|
|
end;
|
|
|
|
function UnicodeStringToStringEx(const WS: UnicodeString; CodePage: Word): AnsiString;
|
|
var
|
|
InputLength,
|
|
OutputLength: Integer;
|
|
begin
|
|
InputLength := Length(WS);
|
|
OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength,
|
|
nil, 0, nil, nil);
|
|
SetLength(Result, OutputLength);
|
|
WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result),
|
|
OutputLength, nil, nil);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function GetTextSize(DC: HDC; Str: PWideChar; Count: Integer): TSize;
|
|
{$IFDEF SYN_UNISCRIBE}
|
|
const
|
|
SSAnalyseFlags = SSA_GLYPHS or SSA_FALLBACK or SSA_LINK;
|
|
{$ENDIF}
|
|
var
|
|
tm: TTextMetricA;
|
|
{$IFDEF SYN_UNISCRIBE}
|
|
GlyphBufferSize: Integer;
|
|
saa: TScriptStringAnalysis;
|
|
lpSize: PSize;
|
|
{$ENDIF}
|
|
begin
|
|
Result.cx := 0;
|
|
Result.cy := 0;
|
|
|
|
{$IFDEF SYN_UNISCRIBE}
|
|
if Usp10IsInstalled then
|
|
begin
|
|
if Count <= 0 then Exit;
|
|
|
|
// According to the MS Windows SDK (1.5 * Count + 16) is the recommended
|
|
// value for GlyphBufferSize (see documentation of cGlyphs parameter of
|
|
// ScriptStringAnalyse function)
|
|
GlyphBufferSize := (3 * Count) div 2 + 16;
|
|
|
|
if Succeeded(ScriptStringAnalyse(DC, Str, Count, GlyphBufferSize, -1,
|
|
SSAnalyseFlags, 0, nil, nil, nil, nil, nil, @saa)) then
|
|
begin
|
|
lpSize := ScriptString_pSize(saa);
|
|
if lpSize <> nil then
|
|
begin
|
|
Result := lpSize^;
|
|
if Result.cx = 0 then
|
|
begin
|
|
GetTextMetricsA(DC, tm);
|
|
Result.cx := tm.tmAveCharWidth;
|
|
end;
|
|
end;
|
|
ScriptStringFree(@saa);
|
|
end;
|
|
end
|
|
else
|
|
{$ENDIF}
|
|
begin
|
|
GetTextExtentPoint32W(DC, Str, Count, Result);
|
|
if not Win32PlatformIsUnicode then
|
|
begin
|
|
GetTextMetricsA(DC, tm);
|
|
if tm.tmPitchAndFamily and TMPF_TRUETYPE <> 0 then
|
|
Result.cx := Result.cx - tm.tmOverhang
|
|
else
|
|
Result.cx := tm.tmAveCharWidth * Count;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
type
|
|
TAccessCanvas = class(TCanvas)
|
|
end;
|
|
|
|
function TextExtent(ACanvas: TCanvas; const Text: UnicodeString): TSize;
|
|
begin
|
|
with TAccessCanvas(ACanvas) do
|
|
begin
|
|
RequiredState([csHandleValid, csFontValid]);
|
|
Result := GetTextSize(Handle, PWideChar(Text), Length(Text));
|
|
end;
|
|
end;
|
|
|
|
function TextWidth(ACanvas: TCanvas; const Text: UnicodeString): Integer;
|
|
begin
|
|
Result := TextExtent(ACanvas, Text).cX;
|
|
end;
|
|
|
|
function TextHeight(ACanvas: TCanvas; const Text: UnicodeString): Integer;
|
|
begin
|
|
Result := TextExtent(ACanvas, Text).cY;
|
|
end;
|
|
|
|
procedure TextOut(ACanvas: TCanvas; X, Y: Integer; const Text: UnicodeString);
|
|
begin
|
|
with TAccessCanvas(ACanvas) do
|
|
begin
|
|
Changing;
|
|
RequiredState([csHandleValid, csFontValid, csBrushValid]);
|
|
if CanvasOrientation = coRightToLeft then
|
|
Inc(X, SynUnicode.TextWidth(ACanvas, Text) + 1);
|
|
Windows.ExtTextOutW(Handle, X, Y, TextFlags, nil, PWideChar(Text),
|
|
Length(Text), nil);
|
|
MoveTo(X + SynUnicode.TextWidth(ACanvas, Text), Y);
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TextRect(ACanvas: TCanvas; Rect: TRect; X, Y: Integer;
|
|
const Text: UnicodeString);
|
|
var
|
|
Options: Longint;
|
|
begin
|
|
with TAccessCanvas(ACanvas) do
|
|
begin
|
|
Changing;
|
|
RequiredState([csHandleValid, csFontValid, csBrushValid]);
|
|
Options := ETO_CLIPPED or TextFlags;
|
|
if Brush.Style <> bsClear then
|
|
Options := Options or ETO_OPAQUE;
|
|
if ((TextFlags and ETO_RTLREADING) <> 0) and
|
|
(CanvasOrientation = coRightToLeft)
|
|
then
|
|
Inc(X, SynUnicode.TextWidth(ACanvas, Text) + 1);
|
|
Windows.ExtTextOutW(Handle, X, Y, Options, @Rect, PWideChar(Text),
|
|
Length(Text), nil);
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF UNICODE}
|
|
{ TWideFileStream }
|
|
|
|
constructor TWideFileStream.Create(const FileName: UnicodeString; Mode: Word);
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Create(Filename, Mode, 0);
|
|
{$ELSE}
|
|
Create(Filename, Mode, FileAccessRights);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
constructor TWideFileStream.Create(const FileName: UnicodeString; Mode: Word;
|
|
Rights: Cardinal);
|
|
{$IFDEF USE_TNT_RUNTIME_SUPPORT}
|
|
var
|
|
ErrorMessage: UnicodeString;
|
|
{$ENDIF}
|
|
begin
|
|
if ((Mode and fmCreate) = fmCreate) then
|
|
begin
|
|
inherited Create(WideFileCreate(FileName, Rights));
|
|
if Handle < 0 then
|
|
begin
|
|
{$IFDEF USE_TNT_RUNTIME_SUPPORT}
|
|
{$IFDEF SYN_COMPILER_7_UP}
|
|
ErrorMessage := WideSysErrorMessage(GetLastError);
|
|
raise EWideFCreateError.CreateResFmt(PResStringRec(@SFCreateErrorEx),
|
|
[WideExpandFileName(FileName), ErrorMessage]);
|
|
{$ELSE}
|
|
raise EWideFCreateError.CreateResFmt(@SFCreateError, [FileName]);
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF SYN_COMPILER_7_UP}
|
|
raise EFCreateError.CreateResFmt(PResStringRec(@SFCreateErrorEx),
|
|
[ExpandFileName(FileName), SysErrorMessage(GetLastError)]);
|
|
{$ELSE}
|
|
raise EFCreateError.CreateResFmt(PResStringRec(@SFCreateError), [FileName]);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
inherited Create(WideFileOpen(FileName, Mode));
|
|
if Handle < 0 then
|
|
begin
|
|
{$IFDEF USE_TNT_RUNTIME_SUPPORT}
|
|
{$IFDEF SYN_COMPILER_7_UP}
|
|
ErrorMessage := WideSysErrorMessage(GetLastError);
|
|
raise EWideFOpenError.CreateResFmt(PResStringRec(@SFOpenErrorEx),
|
|
[WideExpandFileName(FileName), ErrorMessage]);
|
|
{$ELSE}
|
|
raise EWideFOpenError.CreateResFmt(@SFOpenError, [FileName]);
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF SYN_COMPILER_7_UP}
|
|
raise EFOpenError.CreateResFmt(PResStringRec(@SFOpenErrorEx),
|
|
[ExpandFileName(FileName), SysErrorMessage(GetLastError)]);
|
|
{$ELSE}
|
|
raise EFOpenError.CreateResFmt(PResStringRec(@SFOpenError), [FileName]);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
destructor TWideFileStream.Destroy;
|
|
begin
|
|
if Handle >= 0 then FileClose(Handle);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function WideFileOpen(const FileName: UnicodeString; Mode: LongWord): Integer;
|
|
{$IFDEF MSWINDOWS}
|
|
const
|
|
AccessMode: array[0..2] of LongWord = (
|
|
GENERIC_READ,
|
|
GENERIC_WRITE,
|
|
GENERIC_READ or GENERIC_WRITE);
|
|
ShareMode: array[0..4] of LongWord = (
|
|
0,
|
|
0,
|
|
FILE_SHARE_READ,
|
|
FILE_SHARE_WRITE,
|
|
FILE_SHARE_READ or FILE_SHARE_WRITE);
|
|
begin
|
|
Result := -1;
|
|
if ((Mode and 3) <= fmOpenReadWrite) and
|
|
((Mode and $F0) <= fmShareDenyNone) then
|
|
begin
|
|
if Win32PlatformIsUnicode then
|
|
Result := Integer(CreateFileW(PWideChar(FileName), AccessMode[Mode and 3],
|
|
ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
|
|
FILE_ATTRIBUTE_NORMAL, 0))
|
|
else
|
|
Result := Integer(CreateFileA(PAnsiChar(AnsiString(FileName)), AccessMode[Mode and 3],
|
|
ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
|
|
FILE_ATTRIBUTE_NORMAL, 0));
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LINUX}
|
|
const
|
|
ShareMode: array[0..fmShareDenyNone shr 4] of Byte = (
|
|
0, //No share mode specified
|
|
F_WRLCK, //fmShareExclusive
|
|
F_RDLCK, //fmShareDenyWrite
|
|
0); //fmShareDenyNone
|
|
var
|
|
FileHandle, Tvar: Integer;
|
|
LockVar: TFlock;
|
|
smode: Byte;
|
|
begin
|
|
Result := -1;
|
|
if FileExists(FileName) and
|
|
((Mode and 3) <= fmOpenReadWrite) and
|
|
((Mode and $F0) <= fmShareDenyNone) then
|
|
begin
|
|
FileHandle := open(PChar(AnsiString(FileName)), (Mode and 3), FileAccessRights);
|
|
|
|
if FileHandle = -1 then Exit;
|
|
|
|
smode := Mode and $F0 shr 4;
|
|
if ShareMode[smode] <> 0 then
|
|
begin
|
|
with LockVar do
|
|
begin
|
|
l_whence := SEEK_SET;
|
|
l_start := 0;
|
|
l_len := 0;
|
|
l_type := ShareMode[smode];
|
|
end;
|
|
Tvar := fcntl(FileHandle, F_SETLK, LockVar);
|
|
if Tvar = -1 then
|
|
begin
|
|
__close(FileHandle);
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := FileHandle;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function WideFileCreate(const FileName: UnicodeString): Integer;
|
|
{$IFDEF MSWINDOWS}
|
|
begin
|
|
if Win32PlatformIsUnicode then
|
|
Result := Integer(CreateFileW(PWideChar(FileName), GENERIC_READ or GENERIC_WRITE,
|
|
0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0))
|
|
else
|
|
Result := Integer(CreateFileA(PAnsiChar(AnsiString(FileName)), GENERIC_READ or GENERIC_WRITE,
|
|
0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LINUX}
|
|
begin
|
|
Result := FileCreate(FileName, FileAccessRights);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function WideFileCreate(const FileName: UnicodeString; Rights: Integer): Integer;
|
|
{$IFDEF MSWINDOWS}
|
|
begin
|
|
Result := WideFileCreate(FileName);
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LINUX}
|
|
begin
|
|
Result := Integer(open(PChar(AnsiString(FileName)), O_RDWR or O_CREAT or O_TRUNC, Rights));
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function IsAnsiOnly(const WS: UnicodeString): Boolean;
|
|
{$IFDEF MSWINDOWS}
|
|
begin
|
|
Result := IsUnicodeStringMappableToAnsi(WS);
|
|
end;
|
|
{$ELSE}
|
|
var
|
|
Run: PWideChar;
|
|
begin
|
|
Run := PWideChar(WS);
|
|
while Run^ in [WideChar(#1)..WideChar(#255)] do
|
|
Inc(Run);
|
|
Result := Run^ = WideNull;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function IsUTF8(const FileName: UnicodeString; out WithBOM: Boolean): Boolean;
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TWideFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
Result := IsUTF8(Stream, WithBOM);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
// checks for a BOM in UTF-8 format or searches the first 4096 bytes for
|
|
// typical UTF-8 octet sequences
|
|
function IsUTF8(Stream: TStream; out WithBOM: Boolean): Boolean;
|
|
const
|
|
MinimumCountOfUTF8Strings = 1;
|
|
MaxBufferSize = $4000;
|
|
var
|
|
Buffer: array of Byte;
|
|
BufferSize, i, FoundUTF8Strings: Integer;
|
|
|
|
// 3 trailing bytes are the maximum in valid UTF-8 streams,
|
|
// so a count of 4 trailing bytes is enough to detect invalid UTF-8 streams
|
|
function CountOfTrailingBytes: Integer;
|
|
begin
|
|
Result := 0;
|
|
Inc(i);
|
|
while (i < BufferSize) and (Result < 4) do
|
|
begin
|
|
if Buffer[i] in [$80..$BF] then
|
|
Inc(Result)
|
|
else
|
|
Break;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
// if Stream is nil, let Delphi raise the exception, by accessing Stream,
|
|
// to signal an invalid result
|
|
|
|
// start analysis at actual Stream.Position
|
|
BufferSize := Min(MaxBufferSize, Stream.Size - Stream.Position);
|
|
|
|
// if no special characteristics are found it is not UTF-8
|
|
Result := False;
|
|
WithBOM := False;
|
|
|
|
if BufferSize > 0 then
|
|
begin
|
|
SetLength(Buffer, BufferSize);
|
|
Stream.ReadBuffer(Buffer[0], BufferSize);
|
|
Stream.Seek(-BufferSize, soFromCurrent);
|
|
|
|
{ first search for BOM }
|
|
|
|
if (BufferSize >= Length(UTF8BOM)) and CompareMem(@Buffer[0], @UTF8BOM[0], Length(UTF8BOM)) then
|
|
begin
|
|
WithBOM := True;
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
|
|
{ If no BOM was found, check for leading/trailing byte sequences,
|
|
which are uncommon in usual non UTF-8 encoded text.
|
|
|
|
NOTE: There is no 100% save way to detect UTF-8 streams. The bigger
|
|
MinimumCountOfUTF8Strings, the lower is the probability of
|
|
a false positive. On the other hand, a big MinimumCountOfUTF8Strings
|
|
makes it unlikely to detect files with only little usage of non
|
|
US-ASCII chars, like usual in European languages. }
|
|
|
|
FoundUTF8Strings := 0;
|
|
i := 0;
|
|
while i < BufferSize do
|
|
begin
|
|
case Buffer[i] of
|
|
$00..$7F: // skip US-ASCII characters as they could belong to various charsets
|
|
;
|
|
$C2..$DF:
|
|
if CountOfTrailingBytes = 1 then
|
|
Inc(FoundUTF8Strings)
|
|
else
|
|
Break;
|
|
$E0:
|
|
begin
|
|
Inc(i);
|
|
if (i < BufferSize) and (Buffer[i] in [$A0..$BF]) and (CountOfTrailingBytes = 1) then
|
|
Inc(FoundUTF8Strings)
|
|
else
|
|
Break;
|
|
end;
|
|
$E1..$EC, $EE..$EF:
|
|
if CountOfTrailingBytes = 2 then
|
|
Inc(FoundUTF8Strings)
|
|
else
|
|
Break;
|
|
$ED:
|
|
begin
|
|
Inc(i);
|
|
if (i < BufferSize) and (Buffer[i] in [$80..$9F]) and (CountOfTrailingBytes = 1) then
|
|
Inc(FoundUTF8Strings)
|
|
else
|
|
Break;
|
|
end;
|
|
$F0:
|
|
begin
|
|
Inc(i);
|
|
if (i < BufferSize) and (Buffer[i] in [$90..$BF]) and (CountOfTrailingBytes = 2) then
|
|
Inc(FoundUTF8Strings)
|
|
else
|
|
Break;
|
|
end;
|
|
$F1..$F3:
|
|
if CountOfTrailingBytes = 3 then
|
|
Inc(FoundUTF8Strings)
|
|
else
|
|
Break;
|
|
$F4:
|
|
begin
|
|
Inc(i);
|
|
if (i < BufferSize) and (Buffer[i] in [$80..$8F]) and (CountOfTrailingBytes = 2) then
|
|
Inc(FoundUTF8Strings)
|
|
else
|
|
Break;
|
|
end;
|
|
$C0, $C1, $F5..$FF: // invalid UTF-8 bytes
|
|
Break;
|
|
$80..$BF: // trailing bytes are consumed when handling leading bytes,
|
|
// any occurence of "orphaned" trailing bytes is invalid UTF-8
|
|
Break;
|
|
end;
|
|
|
|
if FoundUTF8Strings = MinimumCountOfUTF8Strings then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetEncoding(const FileName: UnicodeString; out WithBOM: Boolean): TSynEncoding;
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TWideFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
Result := GetEncoding(Stream, WithBOM);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
function GetEncoding(Stream: TStream; out WithBOM: Boolean): TSynEncoding;
|
|
var
|
|
BOM: WideChar;
|
|
Size: Integer;
|
|
begin
|
|
// if Stream is nil, let Delphi raise the exception, by accessing Stream,
|
|
// to signal an invalid result
|
|
|
|
// start analysis at actual Stream.Position
|
|
Size := Stream.Size - Stream.Position;
|
|
|
|
// if no special characteristics are found it is probably ANSI
|
|
Result := seAnsi;
|
|
|
|
if IsUTF8(Stream, WithBOM) then
|
|
begin
|
|
Result := seUTF8;
|
|
Exit;
|
|
end;
|
|
|
|
{ try to detect UTF-16 by finding a BOM in UTF-16 format }
|
|
|
|
if Size >= 2 then
|
|
begin
|
|
Stream.ReadBuffer(BOM, sizeof(BOM));
|
|
Stream.Seek(-sizeof(BOM), soFromCurrent);
|
|
if BOM = WideChar(UTF16BOMLE) then
|
|
begin
|
|
Result := seUTF16LE;
|
|
WithBOM := True;
|
|
Exit;
|
|
end
|
|
else if BOM = WideChar(UTF16BOMBE) then
|
|
begin
|
|
Result := seUTF16BE;
|
|
WithBOM := True;
|
|
Exit;
|
|
end
|
|
end;
|
|
end;
|
|
|
|
procedure SaveToFile(const WS: UnicodeString; const FileName: UnicodeString;
|
|
Encoding: TSynEncoding; WithBom: Boolean = True);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TWideFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(WS, Stream, Encoding, WithBom);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveToFile(UnicodeStrings: TUnicodeStrings; const FileName: UnicodeString;
|
|
Encoding: TSynEncoding; WithBom: Boolean = True);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TWideFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(UnicodeStrings, Stream, Encoding, WithBom);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
function LoadFromFile(UnicodeStrings: TUnicodeStrings; const FileName: UnicodeString;
|
|
out WithBOM: Boolean): TSynEncoding;
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TWideFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
Result := LoadFromStream(UnicodeStrings, Stream, WithBOM);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
function LoadFromFile(UnicodeStrings: TUnicodeStrings; const FileName: UnicodeString;
|
|
Encoding: TSynEncoding; out WithBOM: Boolean): TSynEncoding;
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TWideFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
Result := LoadFromStream(UnicodeStrings, Stream, Encoding, WithBOM);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveToStream(const WS: UnicodeString; Stream: TStream; Encoding: TSynEncoding;
|
|
WithBom: Boolean = True);
|
|
var
|
|
UTF16BOM: UnicodeString;
|
|
|
|
UTF8Str: UTF8String;
|
|
AnsiStr: AnsiString;
|
|
begin
|
|
if WithBom then
|
|
case Encoding of
|
|
seUTF8:
|
|
Stream.WriteBuffer(UTF8BOM, 3);
|
|
seUTF16LE:
|
|
begin
|
|
UTF16BOM := BOM_LSB_FIRST;
|
|
Stream.WriteBuffer(PWideChar(UTF16BOM)^, 2);
|
|
end;
|
|
seUTF16BE:
|
|
begin
|
|
UTF16BOM := BOM_MSB_FIRST;
|
|
Stream.WriteBuffer(PWideChar(UTF16BOM)^, 2);
|
|
end;
|
|
end;
|
|
|
|
case Encoding of
|
|
seUTF8:
|
|
begin
|
|
UTF8Str := UTF8Encode(WS);
|
|
Stream.WriteBuffer(UTF8Str[1], Length(UTF8Str));
|
|
end;
|
|
seUTF16LE:
|
|
Stream.WriteBuffer(WS[1], Length(WS) * sizeof(WideChar));
|
|
seUTF16BE:
|
|
begin
|
|
StrSwapByteOrder(PWideChar(WS));
|
|
Stream.WriteBuffer(WS[1], Length(WS) * sizeof(WideChar));
|
|
end;
|
|
seAnsi:
|
|
begin
|
|
AnsiStr := AnsiString(PWideChar(WS));
|
|
Stream.WriteBuffer(AnsiStr[1], Length(AnsiStr));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
type
|
|
TSynEditStringListAccess = class(TSynEditStringList);
|
|
|
|
procedure SaveToStream(UnicodeStrings: TUnicodeStrings; Stream: TStream;
|
|
Encoding: TSynEncoding; WithBom: Boolean = True);
|
|
var
|
|
SText: UnicodeString;
|
|
SaveFStreaming: Boolean;
|
|
begin
|
|
// if UnicodeStrings or Stream is nil, let Delphi raise the exception to flag the error
|
|
|
|
if UnicodeStrings is TSynEditStringList then
|
|
begin
|
|
SaveFStreaming := TSynEditStringListAccess(UnicodeStrings).FStreaming;
|
|
TSynEditStringListAccess(UnicodeStrings).FStreaming := True;
|
|
SText := UnicodeStrings.Text;
|
|
TSynEditStringListAccess(UnicodeStrings).FStreaming := SaveFStreaming;
|
|
end
|
|
else
|
|
SText := UnicodeStrings.Text;
|
|
SaveToStream(SText, Stream, Encoding, WithBom);
|
|
end;
|
|
|
|
function LoadFromStream(UnicodeStrings: TUnicodeStrings; Stream: TStream;
|
|
out WithBOM: Boolean): TSynEncoding;
|
|
var
|
|
Dummy: Boolean;
|
|
begin
|
|
Result := LoadFromStream(UnicodeStrings, Stream, GetEncoding(Stream, WithBOM),
|
|
Dummy);
|
|
end;
|
|
|
|
function LoadFromStream(UnicodeStrings: TUnicodeStrings; Stream: TStream;
|
|
Encoding: TSynEncoding): TSynEncoding; overload;
|
|
var
|
|
Dummy: Boolean;
|
|
begin
|
|
Result := LoadFromStream(UnicodeStrings, Stream, Encoding, Dummy);
|
|
end;
|
|
|
|
function LoadFromStream(UnicodeStrings: TUnicodeStrings; Stream: TStream;
|
|
Encoding: TSynEncoding; out WithBOM: Boolean): TSynEncoding;
|
|
var
|
|
WideStr: UnicodeString;
|
|
UTF8Str: UTF8String;
|
|
AnsiStr: AnsiString;
|
|
Size: Integer;
|
|
|
|
function SkipBOM: Boolean;
|
|
var
|
|
BOM: array of Byte;
|
|
begin
|
|
Result := False;
|
|
case Encoding of
|
|
seUTF8:
|
|
begin
|
|
SetLength(BOM, Min(Length(UTF8BOM), Size));
|
|
Stream.ReadBuffer(BOM[0], Length(BOM));
|
|
if (Length(BOM) <> Length(UTF8BOM)) or
|
|
not CompareMem(@BOM[0], @UTF8BOM[0], Length(UTF8BOM))
|
|
then
|
|
Stream.Seek(-Length(BOM), {$IFDEF SYN_DELPHI_XE4_UP}soCurrent{$ELSE}soFromCurrent{$ENDIF})
|
|
else
|
|
Result := True;
|
|
end;
|
|
seUTF16LE:
|
|
begin
|
|
SetLength(BOM, Min(Length(UTF16BOMLE), Size));
|
|
Stream.ReadBuffer(BOM[0], Length(BOM));
|
|
if (Length(BOM) <> Length(UTF16BOMLE)) or
|
|
not CompareMem(@BOM[0], @UTF16BOMLE[0], Length(UTF16BOMLE))
|
|
then
|
|
Stream.Seek(-Length(BOM), {$IFDEF SYN_DELPHI_XE4_UP}soCurrent{$ELSE}soFromCurrent{$ENDIF})
|
|
else
|
|
Result := True;
|
|
end;
|
|
seUTF16BE:
|
|
begin
|
|
SetLength(BOM, Min(Length(UTF16BOMBE), Size));
|
|
Stream.ReadBuffer(BOM[0], Length(BOM));
|
|
if (Length(BOM) <> Length(UTF16BOMBE)) or
|
|
not CompareMem(@BOM[0], @UTF16BOMBE[0], Length(UTF16BOMBE))
|
|
then
|
|
Stream.Seek(-Length(BOM), {$IFDEF SYN_DELPHI_XE4_UP}soCurrent{$ELSE}soFromCurrent{$ENDIF})
|
|
else
|
|
Result := True;
|
|
end;
|
|
end;
|
|
Size := Stream.Size - Stream.Position;
|
|
end;
|
|
|
|
begin
|
|
// if UnicodeStrings or Stream is nil, let Delphi raise the exception to
|
|
// signal an invalid result
|
|
UnicodeStrings.BeginUpdate;
|
|
try
|
|
Result := Encoding;
|
|
// start decoding at actual Stream.Position
|
|
Size := Stream.Size - Stream.Position;
|
|
|
|
// skip BOM, if it exists
|
|
WithBOM := SkipBOM;
|
|
|
|
case Result of
|
|
seUTF8:
|
|
begin
|
|
SetLength(UTF8Str, Size);
|
|
Stream.ReadBuffer(UTF8Str[1], Size);
|
|
{$IFDEF UNICODE}
|
|
UnicodeStrings.Text := UTF8ToUnicodeString(UTF8Str);
|
|
{$ELSE}
|
|
UnicodeStrings.Text := UTF8Decode(UTF8Str);
|
|
UnicodeStrings.SaveFormat := sfUTF8;
|
|
{$ENDIF}
|
|
end;
|
|
seUTF16LE:
|
|
begin
|
|
SetLength(WideStr, Size div 2);
|
|
Stream.ReadBuffer(WideStr[1], Size);
|
|
UnicodeStrings.Text := WideStr;
|
|
{$IFNDEF UNICODE}
|
|
UnicodeStrings.SaveFormat := sfUTF16LSB;
|
|
{$ENDIF}
|
|
end;
|
|
seUTF16BE:
|
|
begin
|
|
SetLength(WideStr, Size div 2);
|
|
Stream.ReadBuffer(WideStr[1], Size);
|
|
StrSwapByteOrder(PWideChar(WideStr));
|
|
UnicodeStrings.Text := WideStr;
|
|
{$IFNDEF UNICODE}
|
|
UnicodeStrings.SaveFormat := sfUTF16MSB;
|
|
{$ENDIF}
|
|
end;
|
|
seAnsi:
|
|
begin
|
|
SetLength(AnsiStr, Size);
|
|
Stream.ReadBuffer(AnsiStr[1], Size);
|
|
UnicodeStrings.Text := UnicodeString(AnsiStr);
|
|
{$IFNDEF UNICODE}
|
|
UnicodeStrings.SaveFormat := sfAnsi;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
finally
|
|
UnicodeStrings.EndUpdate
|
|
end
|
|
end;
|
|
|
|
function ClipboardProvidesText: Boolean;
|
|
begin
|
|
Result := IsClipboardFormatAvailable(CF_TEXT) or IsClipboardFormatAvailable(CF_UNICODETEXT);
|
|
end;
|
|
|
|
function GetClipboardText: UnicodeString;
|
|
var
|
|
Mem: HGLOBAL;
|
|
LocaleID: LCID;
|
|
P: PByte;
|
|
begin
|
|
Result := '';
|
|
Clipboard.Open;
|
|
try
|
|
if Clipboard.HasFormat(CF_UNICODETEXT) then
|
|
begin
|
|
Mem := Clipboard.GetAsHandle(CF_UNICODETEXT);
|
|
try
|
|
if Mem <> 0 then
|
|
Result := PWideChar(GlobalLock(Mem));
|
|
finally
|
|
if Mem <> 0 then GlobalUnlock(Mem);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
LocaleID := 0;
|
|
Mem := Clipboard.GetAsHandle(CF_LOCALE);
|
|
try
|
|
if Mem <> 0 then LocaleID := PInteger(GlobalLock(Mem))^;
|
|
finally
|
|
if Mem <> 0 then GlobalUnlock(Mem);
|
|
end;
|
|
|
|
Mem := Clipboard.GetAsHandle(CF_TEXT);
|
|
try
|
|
if Mem <> 0 then
|
|
begin
|
|
P := GlobalLock(Mem);
|
|
Result := StringToUnicodeStringEx(PAnsiChar(P), CodePageFromLocale(LocaleID));
|
|
end
|
|
finally
|
|
if Mem <> 0 then GlobalUnlock(Mem);
|
|
end;
|
|
end;
|
|
finally
|
|
Clipboard.Close;
|
|
end;
|
|
end;
|
|
|
|
procedure SetClipboardText(const Text: UnicodeString);
|
|
var
|
|
Mem: HGLOBAL;
|
|
P: PByte;
|
|
SLen: Integer;
|
|
begin
|
|
if Text = '' then Exit;
|
|
SLen := Length(Text);
|
|
Clipboard.Open;
|
|
try
|
|
Clipboard.Clear;
|
|
|
|
// set ANSI text only on Win9X, WinNT automatically creates ANSI from Unicode
|
|
if Win32Platform <> VER_PLATFORM_WIN32_NT then
|
|
begin
|
|
Mem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, SLen + 1);
|
|
if Mem <> 0 then
|
|
begin
|
|
P := GlobalLock(Mem);
|
|
try
|
|
if P <> nil then
|
|
begin
|
|
Move(PAnsiChar(AnsiString(Text))^, P^, SLen + 1);
|
|
Clipboard.SetAsHandle(CF_TEXT, Mem);
|
|
end;
|
|
finally
|
|
GlobalUnlock(Mem);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// set unicode text, this also works on Win9X, even if the clipboard-viewer
|
|
// can't show it, Word 2000+ can paste it including the unicode only characters
|
|
Mem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,
|
|
(SLen + 1) * sizeof(WideChar));
|
|
if Mem <> 0 then
|
|
begin
|
|
P := GlobalLock(Mem);
|
|
try
|
|
if P <> nil then
|
|
begin
|
|
Move(PWideChar(Text)^, P^, (SLen + 1) * sizeof(WideChar));
|
|
Clipboard.SetAsHandle(CF_UNICODETEXT, Mem);
|
|
end;
|
|
finally
|
|
GlobalUnlock(Mem);
|
|
end;
|
|
end;
|
|
// Don't free Mem! It belongs to the clipboard now, and it will free it
|
|
// when it is done with it.
|
|
finally
|
|
Clipboard.Close;
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF UNICODE}
|
|
{$IFNDEF SYN_COMPILER_6_UP}
|
|
procedure AssignWideStr(var Dest: UnicodeString; const Source: UnicodeString);
|
|
begin
|
|
Dest := Source;
|
|
end;
|
|
|
|
procedure IntGetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
|
|
var Value: UnicodeString); assembler;
|
|
asm
|
|
{ -> EAX Pointer to instance }
|
|
{ EDX Pointer to property info }
|
|
{ ECX Pointer to result string }
|
|
|
|
PUSH ESI
|
|
PUSH EDI
|
|
MOV EDI,EDX
|
|
|
|
MOV EDX,[EDI].TPropInfo.Index { pass index in EDX }
|
|
CMP EDX,$80000000
|
|
JNE @@hasIndex
|
|
MOV EDX,ECX { pass value in EDX }
|
|
@@hasIndex:
|
|
MOV ESI,[EDI].TPropInfo.GetProc
|
|
CMP [EDI].TPropInfo.GetProc.Byte[3],$FE
|
|
JA @@isField
|
|
JB @@isStaticMethod
|
|
|
|
@@isVirtualMethod:
|
|
MOVSX ESI,SI { sign extend slot offset }
|
|
ADD ESI,[EAX] { vmt + slot offset }
|
|
CALL DWORD PTR [ESI]
|
|
JMP @@exit
|
|
|
|
@@isStaticMethod:
|
|
CALL ESI
|
|
JMP @@exit
|
|
|
|
@@isField:
|
|
AND ESI,$00FFFFFF
|
|
MOV EDX,[EAX+ESI]
|
|
MOV EAX,ECX
|
|
CALL AssignWideStr
|
|
|
|
@@exit:
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
|
|
function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): UnicodeString;
|
|
begin
|
|
IntGetWideStrProp(Instance, PropInfo, Result);
|
|
end;
|
|
|
|
procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
|
|
const Value: UnicodeString); assembler;
|
|
asm
|
|
{ -> EAX Pointer to instance }
|
|
{ EDX Pointer to property info }
|
|
{ ECX Pointer to string value }
|
|
|
|
PUSH ESI
|
|
PUSH EDI
|
|
MOV ESI,EDX
|
|
|
|
MOV EDX,[ESI].TPropInfo.Index { pass index in EDX }
|
|
CMP EDX,$80000000
|
|
JNE @@hasIndex
|
|
MOV EDX,ECX { pass value in EDX }
|
|
@@hasIndex:
|
|
MOV EDI,[ESI].TPropInfo.SetProc
|
|
CMP [ESI].TPropInfo.SetProc.Byte[3],$FE
|
|
JA @@isField
|
|
JB @@isStaticMethod
|
|
|
|
@@isVirtualMethod:
|
|
MOVSX EDI,DI
|
|
ADD EDI,[EAX]
|
|
CALL DWORD PTR [EDI]
|
|
JMP @@exit
|
|
|
|
@@isStaticMethod:
|
|
CALL EDI
|
|
JMP @@exit
|
|
|
|
@@isField:
|
|
AND EDI,$00FFFFFF
|
|
ADD EAX,EDI
|
|
MOV EDX,ECX
|
|
CALL AssignWideStr
|
|
|
|
@@exit:
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ENDIF}
|
|
|
|
type
|
|
TUnicodeStringPropertyFiler = class
|
|
private
|
|
FInstance: TPersistent;
|
|
FPropInfo: PPropInfo;
|
|
procedure ReadData(Reader: TReader);
|
|
procedure WriteData(Writer: TWriter);
|
|
public
|
|
procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
|
|
end;
|
|
|
|
TWideCharPropertyFiler = class
|
|
private
|
|
FInstance: TPersistent;
|
|
FPropInfo: PPropInfo;
|
|
FWriter: TWriter;
|
|
procedure GetLookupInfo(var Ancestor: TPersistent;
|
|
var Root, LookupRoot, RootAncestor: TComponent);
|
|
procedure ReadData(Reader: TReader);
|
|
procedure WriteData(Writer: TWriter);
|
|
function ReadChar(Reader: TReader): WideChar;
|
|
public
|
|
procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
|
|
end;
|
|
|
|
type
|
|
TGetLookupInfoEvent = procedure(var Ancestor: TPersistent;
|
|
var Root, LookupRoot, RootAncestor: TComponent) of object;
|
|
|
|
function AncestorIsValid(Ancestor: TPersistent; Root, RootAncestor: TComponent): Boolean;
|
|
begin
|
|
Result := (Ancestor <> nil) and (RootAncestor <> nil) and
|
|
Root.InheritsFrom(RootAncestor.ClassType);
|
|
end;
|
|
|
|
function IsDefaultOrdPropertyValue(Instance: TObject; PropInfo: PPropInfo;
|
|
OnGetLookupInfo: TGetLookupInfoEvent): Boolean;
|
|
var
|
|
Ancestor: TPersistent;
|
|
LookupRoot: TComponent;
|
|
RootAncestor: TComponent;
|
|
Root: TComponent;
|
|
AncestorValid: Boolean;
|
|
Value: Longint;
|
|
Default: LongInt;
|
|
begin
|
|
Ancestor := nil;
|
|
Root := nil;
|
|
LookupRoot := nil;
|
|
RootAncestor := nil;
|
|
|
|
if Assigned(OnGetLookupInfo) then
|
|
OnGetLookupInfo(Ancestor, Root, LookupRoot, RootAncestor);
|
|
|
|
AncestorValid := AncestorIsValid(Ancestor, Root, RootAncestor);
|
|
|
|
Result := True;
|
|
if (PropInfo^.GetProc <> nil) and (PropInfo^.SetProc <> nil) then
|
|
begin
|
|
Value := GetOrdProp(Instance, PropInfo);
|
|
if AncestorValid then
|
|
Result := Value = GetOrdProp(Ancestor, PropInfo)
|
|
else
|
|
begin
|
|
Default := PPropInfo(PropInfo)^.Default;
|
|
Result := (Default <> LongInt($80000000)) and (Value = Default);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ReadError(S: string);
|
|
begin
|
|
raise EReadError.Create(S);
|
|
end;
|
|
|
|
procedure PropValueError;
|
|
begin
|
|
ReadError(SInvalidPropertyValue);
|
|
end;
|
|
|
|
{ TUnicodeStringPropertyFiler }
|
|
|
|
procedure TUnicodeStringPropertyFiler.DefineProperties(Filer: TFiler; Instance: TPersistent;
|
|
PropName: AnsiString);
|
|
|
|
function HasData: Boolean;
|
|
var
|
|
CurrPropValue: UnicodeString;
|
|
begin
|
|
// must be stored
|
|
Result := IsStoredProp(Instance, FPropInfo);
|
|
if Result
|
|
and (Filer.Ancestor <> nil)
|
|
and (GetPropInfo(Filer.Ancestor, PropName, [tkWString]) <> nil) then
|
|
begin
|
|
// must be different than ancestor
|
|
CurrPropValue := GetWideStrProp(Instance, FPropInfo);
|
|
Result := CurrPropValue <> GetWideStrProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
|
|
end;
|
|
if Result then
|
|
Result := GetWideStrProp(Instance, FPropInfo) <> '';
|
|
end;
|
|
|
|
begin
|
|
FInstance := Instance;
|
|
FPropInfo := GetPropInfo(Instance, PropName, [tkWString]);
|
|
if FPropInfo <> nil then
|
|
// must be published (and of type UnicodeString)
|
|
Filer.DefineProperty(PropName + 'W', ReadData, WriteData, HasData);
|
|
FInstance := nil;
|
|
FPropInfo := nil;
|
|
end;
|
|
|
|
procedure TUnicodeStringPropertyFiler.ReadData(Reader: TReader);
|
|
begin
|
|
case Reader.NextValue of
|
|
vaLString, vaString:
|
|
SetWideStrProp(FInstance, FPropInfo, Reader.ReadString);
|
|
else
|
|
SetWideStrProp(FInstance, FPropInfo, Reader.ReadWideString);
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStringPropertyFiler.WriteData(Writer: TWriter);
|
|
begin
|
|
Writer.WriteWideString(GetWideStrProp(FInstance, FPropInfo));
|
|
end;
|
|
|
|
{ TWideCharPropertyFiler }
|
|
|
|
procedure TWideCharPropertyFiler.GetLookupInfo(var Ancestor: TPersistent;
|
|
var Root, LookupRoot, RootAncestor: TComponent);
|
|
begin
|
|
Ancestor := FWriter.Ancestor;
|
|
Root := FWriter.Root;
|
|
LookupRoot := FWriter.LookupRoot;
|
|
RootAncestor := FWriter.RootAncestor;
|
|
end;
|
|
|
|
function TWideCharPropertyFiler.ReadChar(Reader: TReader): WideChar;
|
|
var
|
|
Temp: UnicodeString;
|
|
begin
|
|
case Reader.NextValue of
|
|
vaWString:
|
|
Temp := Reader.ReadWideString;
|
|
vaString:
|
|
Temp := Reader.ReadString;
|
|
else
|
|
PropValueError;
|
|
end;
|
|
|
|
if Length(Temp) > 1 then
|
|
PropValueError;
|
|
Result := Temp[1];
|
|
end;
|
|
|
|
procedure TWideCharPropertyFiler.ReadData(Reader: TReader);
|
|
begin
|
|
SetOrdProp(FInstance, FPropInfo, Ord(ReadChar(Reader)));
|
|
end;
|
|
|
|
type
|
|
TAccessWriter = class(TWriter)
|
|
end;
|
|
|
|
procedure TWideCharPropertyFiler.WriteData(Writer: TWriter);
|
|
var
|
|
L: Integer;
|
|
Temp: UnicodeString;
|
|
begin
|
|
Temp := WideChar(GetOrdProp(FInstance, FPropInfo));
|
|
|
|
TAccessWriter(Writer).WriteValue(vaWString);
|
|
L := Length(Temp);
|
|
Writer.Write(L, SizeOf(Integer));
|
|
Writer.Write(Pointer(@Temp[1])^, L * 2);
|
|
end;
|
|
|
|
procedure TWideCharPropertyFiler.DefineProperties(Filer: TFiler;
|
|
Instance: TPersistent; PropName: AnsiString);
|
|
|
|
function HasData: Boolean;
|
|
var
|
|
CurrPropValue: Integer;
|
|
begin
|
|
// must be stored
|
|
Result := IsStoredProp(Instance, FPropInfo);
|
|
if Result and (Filer.Ancestor <> nil) and
|
|
(GetPropInfo(Filer.Ancestor, PropName, [tkWChar]) <> nil) then
|
|
begin
|
|
// must be different than ancestor
|
|
CurrPropValue := GetOrdProp(Instance, FPropInfo);
|
|
Result := CurrPropValue <> GetOrdProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
|
|
end;
|
|
|
|
if Result and (Filer is TWriter) then
|
|
begin
|
|
FWriter := TWriter(Filer);
|
|
Result := not IsDefaultOrdPropertyValue(Instance, FPropInfo, GetLookupInfo);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FInstance := Instance;
|
|
FPropInfo := GetPropInfo(Instance, PropName, [tkWChar]);
|
|
if FPropInfo <> nil then // must be published (and of type WideChar)
|
|
begin
|
|
// W suffix causes Delphi's native streaming system to ignore the property
|
|
// and let us do the reading.
|
|
Filer.DefineProperty(PropName + 'W', ReadData, WriteData, HasData);
|
|
end;
|
|
FInstance := nil;
|
|
FPropInfo := nil;
|
|
end;
|
|
|
|
procedure UnicodeDefineProperties(Filer: TFiler; Instance: TPersistent);
|
|
var
|
|
I, Count: Integer;
|
|
PropInfo: PPropInfo;
|
|
PropList: PPropList;
|
|
UnicodeStringFiler: TUnicodeStringPropertyFiler;
|
|
WideCharFiler: TWideCharPropertyFiler;
|
|
begin
|
|
Count := GetTypeData(Instance.ClassInfo)^.PropCount;
|
|
if Count > 0 then
|
|
begin
|
|
UnicodeStringFiler := TUnicodeStringPropertyFiler.Create;
|
|
try
|
|
WideCharFiler := TWideCharPropertyFiler.Create;
|
|
try
|
|
GetMem(PropList, Count * SizeOf(Pointer));
|
|
try
|
|
GetPropInfos(Instance.ClassInfo, PropList);
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
PropInfo := PropList^[I];
|
|
if (PropInfo = nil) then
|
|
Break;
|
|
if (PropInfo.PropType^.Kind = tkWString) then
|
|
UnicodeStringFiler.DefineProperties(Filer, Instance, PropInfo.Name)
|
|
else if (PropInfo.PropType^.Kind = tkWChar) then
|
|
WideCharFiler.DefineProperties(Filer, Instance, PropInfo.Name)
|
|
end;
|
|
finally
|
|
FreeMem(PropList, Count * SizeOf(Pointer));
|
|
end;
|
|
finally
|
|
WideCharFiler.Free;
|
|
end;
|
|
finally
|
|
UnicodeStringFiler.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
|
|
var
|
|
UsedDefaultChar: BOOL;
|
|
begin
|
|
WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(@WC), 1, nil, 0, nil,
|
|
@UsedDefaultChar);
|
|
Result := not UsedDefaultChar;
|
|
end;
|
|
|
|
function IsUnicodeStringMappableToAnsi(const WS: UnicodeString): Boolean;
|
|
var
|
|
UsedDefaultChar: BOOL;
|
|
begin
|
|
WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(WS), Length(WS), nil, 0,
|
|
nil, @UsedDefaultChar);
|
|
Result := not UsedDefaultChar;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
initialization
|
|
{$IFDEF MSWINDOWS}
|
|
Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT);
|
|
{$IFNDEF UNICODE}
|
|
DefaultSystemCodePage := GetACP;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
end.
|