12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526 |
- {
- $Id$
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2005 by Florian Klaempfl,
- member of the Free Pascal development team.
- This file implements support routines for WideStrings/Unicode with FPC
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- {
- This file contains the implementation of the WideString type,
- and all things that are needed for it.
- WideString is defined as a 'silent' pwidechar :
- a pwidechar that points to :
- @-8 : SizeInt for reference count;
- @-4 : SizeInt for size;
- @ : String + Terminating #0;
- Pwidechar(Widestring) is a valid typecast.
- So WS[i] is converted to the address @WS+i-1.
- Constants should be assigned a reference count of -1
- Meaning that they can't be disposed of.
- }
- Type
- PWideRec = ^TWideRec;
- TWideRec = Packed Record
- Ref,
- Len : SizeInt;
- First : WideChar;
- end;
- Const
- WideRecLen = SizeOf(TWideRec);
- WideFirstOff = SizeOf(TWideRec)-sizeof(WideChar);
- {
- Default WideChar <-> Char conversion is to only convert the
- lower 127 chars, all others are translated to spaces.
- These routines can be overwritten for the Current Locale
- }
- procedure Wide2AnsiMove(source:pwidechar;dest:pchar;len:SizeInt);
- var
- i : SizeInt;
- begin
- for i:=1 to len do
- begin
- if word(source^)<128 then
- dest^:=char(word(source^))
- else
- dest^:=' ';
- inc(dest);
- inc(source);
- end;
- end;
- procedure Ansi2WideMove(source:pchar;dest:pwidechar;len:SizeInt);
- var
- i : SizeInt;
- begin
- for i:=1 to len do
- begin
- if byte(source^)<128 then
- dest^:=widechar(byte(source^))
- else
- dest^:=' ';
- inc(dest);
- inc(source);
- end;
- end;
- Procedure GetWideStringManager (Var Manager : TWideStringManager);
- begin
- manager:=widestringmanager;
- end;
- Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
- begin
- Old:=widestringmanager;
- widestringmanager:=New;
- end;
- Procedure SetWideStringManager (Const New : TWideStringManager);
- begin
- widestringmanager:=New;
- end;
- (*
- Procedure UniqueWideString(Var S : WideString); [Public,Alias : 'FPC_WIDESTR_UNIQUE'];
- {
- Make sure reference count of S is 1,
- using copy-on-write semantics.
- }
- begin
- end;
- *)
- {****************************************************************************
- Internal functions, not in interface.
- ****************************************************************************}
- {$ifdef WideStrDebug}
- Procedure DumpWideRec(S : Pointer);
- begin
- If S=Nil then
- Writeln ('String is nil')
- Else
- Begin
- With PWideRec(S-WideFirstOff)^ do
- begin
- Write ('(Maxlen: ',maxlen);
- Write (' Len:',len);
- Writeln (' Ref: ',ref,')');
- end;
- end;
- end;
- {$endif}
- Function NewWideString(Len : SizeInt) : Pointer;
- {
- Allocate a new WideString on the heap.
- initialize it to zero length and reference count 1.
- }
- Var
- P : Pointer;
- begin
- GetMem(P,Len*sizeof(WideChar)+WideRecLen);
- If P<>Nil then
- begin
- PWideRec(P)^.Len:=0; { Initial length }
- PWideRec(P)^.Ref:=1; { Set reference count }
- PWideRec(P)^.First:=#0; { Terminating #0 }
- inc(p,WideFirstOff); { Points to string now }
- end;
- NewWideString:=P;
- end;
- Procedure DisposeWideString(Var S : Pointer);
- {
- Deallocates a WideString From the heap.
- }
- begin
- If S=Nil then
- exit;
- Dec (S,WideFirstOff);
- FreeMem (S);
- S:=Nil;
- end;
- Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_WIDESTR_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
- {
- Decreases the ReferenceCount of a non constant widestring;
- If the reference count is zero, deallocate the string;
- }
- Type
- pSizeInt = ^SizeInt;
- Var
- l : pSizeInt;
- Begin
- { Zero string }
- If S=Nil then exit;
- { check for constant strings ...}
- l:=@PWIDEREC(S-WideFirstOff)^.Ref;
- If l^<0 then exit;
- { declocked does a MT safe dec and returns true, if the counter is 0 }
- If declocked(l^) then
- { Ref count dropped to zero }
- DisposeWideString (S); { Remove...}
- {$ifndef decrrefnotnil}
- s:=nil;
- {$endif}
- end;
- {$ifdef hascompilerproc}
- { alias for internal use }
- Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_WIDESTR_DECR_REF'];
- {$endif compilerproc}
- {$ifdef hascompilerproc}
- Procedure fpc_WideStr_Incr_Ref (S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_WIDESTR_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
- {$else}
- Procedure fpc_WideStr_Incr_Ref (Var S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_WIDESTR_INCR_REF'];
- {$endif compilerproc}
- Begin
- If S=Nil then
- exit;
- { Let's be paranoid : Constant string ??}
- If PWideRec(S-WideFirstOff)^.Ref<0 then exit;
- inclocked(PWideRec(S-WideFirstOff)^.Ref);
- end;
- {$ifdef hascompilerproc}
- { alias for internal use }
- Procedure fpc_WideStr_Incr_Ref (S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_WIDESTR_INCR_REF'];
- {$endif compilerproc}
- function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring;[Public, alias: 'FPC_WIDESTR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- {
- Converts a WideString to a ShortString;
- }
- Var
- Size : SizeInt;
- begin
- if S2='' then
- fpc_WideStr_To_ShortStr:=''
- else
- begin
- Size:=Length(S2);
- If Size>high_of_res then
- Size:=high_of_res;
- widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),PChar(@fpc_WideStr_To_ShortStr[1]),Size);
- byte(fpc_WideStr_To_ShortStr[0]):=byte(Size);
- end;
- end;
- Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
- {
- Converts a ShortString to a WideString;
- }
- Var
- Size : SizeInt;
- begin
- Size:=Length(S2);
- Setlength (fpc_ShortStr_To_WideStr,Size);
- if Size>0 then
- begin
- widestringmanager.Ansi2WideMoveProc(PChar(@S2[1]),PWideChar(Pointer(fpc_ShortStr_To_WideStr)),Size);
- { Terminating Zero }
- PWideChar(Pointer(fpc_ShortStr_To_WideStr)+Size*sizeof(WideChar))^:=#0;
- end;
- end;
- { old style helper }
- {$ifndef hascompilerproc}
- Procedure fpc_ShortStr_To_WideStr (Var S1 : Pointer; Const S2 : ShortString);[Public, alias: 'FPC_SHORTSTR_TO_WIDESTR'];
- begin
- s1 := pointer(fpc_ShortStr_To_WideStr(s2));
- end;
- {$endif hascompilerproc}
- Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; {$ifdef hascompilerproc} compilerproc; {$endif}
- {
- Converts a WideString to an AnsiString
- }
- Var
- Size : SizeInt;
- begin
- if s2='' then
- exit;
- Size:=Length(WideString(S2));
- Setlength (fpc_WideStr_To_AnsiStr,Size);
- if Size>0 then
- begin
- widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),PChar(Pointer(fpc_WideStr_To_AnsiStr)),Size);
- { Terminating Zero }
- PChar(Pointer(fpc_WideStr_To_AnsiStr)+Size)^:=#0;
- end;
- end;
- { old style helper }
- {$ifndef hascompilerproc}
- Procedure fpc_WideStr_To_AnsiStr (Var S1 : Pointer;const S2 : WideString);[Public, alias: 'FPC_WIDESTR_TO_ANSISTR'];
- begin
- s1 := pointer(fpc_WideStr_To_AnsiStr(s2));
- end;
- {$endif hascompilerproc}
- Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
- {
- Converts an AnsiString to a WideString;
- }
- Var
- Size : SizeInt;
- begin
- if s2='' then
- exit;
- Size:=Length(S2);
- Setlength (result,Size);
- if Size>0 then
- begin
- widestringmanager.Ansi2WideMoveProc(PChar(S2),PWideChar(Pointer(result)),Size);
- { Terminating Zero }
- PWideChar(Pointer(result)+Size*sizeof(WideChar))^:=#0;
- end;
- end;
- { compilers with widestrings should have compiler procs }
- Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
- var
- Size : SizeInt;
- begin
- if p=nil then
- exit;
- Size := IndexWord(p^, -1, 0);
- Setlength (result,Size);
- if Size>0 then
- begin
- widestringmanager.Wide2AnsiMoveProc(P,PChar(Pointer(result)),Size);
- { Terminating Zero }
- PChar(Pointer(result)+Size)^:=#0;
- end;
- end;
- Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;
- var
- Size : SizeInt;
- begin
- if p=nil then
- exit;
- Size := IndexWord(p^, -1, 0);
- Setlength (result,Size);
- if Size>0 then
- begin
- Move(p^,PWideChar(Pointer(result))^,Size*sizeof(WideChar));
- { Terminating Zero }
- PWideChar(Pointer(result)+Size*sizeof(WideChar))^:=#0;
- end;
- end;
- Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
- var
- Size : SizeInt;
- begin
- if p=nil then
- begin
- fpc_PWideChar_To_ShortStr:='';
- exit;
- end;
- Size := IndexWord(p^, $7fffffff, 0);
- Setlength (result,Size+1);
- if Size>0 then
- begin
- If Size>255 then
- Size:=255;
- widestringmanager.Wide2AnsiMoveProc(p,PChar(@result[1]),Size);
- byte(result[0]):=byte(Size);
- end;
- end;
- { old style helper }
- {$ifndef hascompilerproc}
- Procedure fpc_AnsiStr_To_WideStr (Var S1 : Pointer; Const S2 : AnsiString);[Public, alias: 'FPC_ANSISTR_TO_WIDESTR'];
- begin
- s1 := pointer(fpc_AnsiStr_To_WideStr(s2));
- end;
- {$endif hascompilerproc}
- { checked against the ansistring routine, 2001-05-27 (FK) }
- Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_WIDESTR_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif}
- {
- Assigns S2 to S1 (S1:=S2), taking in account reference counts.
- }
- begin
- If S2<>nil then
- If PWideRec(S2-WideFirstOff)^.Ref>0 then
- Inc(PWideRec(S2-WideFirstOff)^.ref);
- { Decrease the reference count on the old S1 }
- fpc_widestr_decr_ref (S1);
- { And finally, have S1 pointing to S2 (or its copy) }
- S1:=S2;
- end;
- {$ifdef hascompilerproc}
- { alias for internal use }
- Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_WIDESTR_ASSIGN'];
- {$endif hascompilerproc}
- { checked against the ansistring routine, 2001-05-27 (FK) }
- {$ifdef hascompilerproc}
- function fpc_WideStr_Concat (const S1,S2 : WideString): WideString; compilerproc;
- var
- S3: WideString absolute result;
- {$else hascompilerproc}
- Procedure fpc_WideStr_Concat (S1,S2 : WideString;var S3 : WideString);[Public, alias: 'FPC_WIDESTR_CONCAT'];
- {$endif hascompilerproc}
- {
- Concatenates 2 WideStrings : S1+S2.
- Result Goes to S3;
- }
- Var
- Size,Location : SizeInt;
- begin
- { only assign if s1 or s2 is empty }
- if (S1='') then
- S3 := S2
- else
- if (S2='') then
- S3 := S1
- else
- begin
- { create new result }
- Size:=Length(S2);
- Location:=Length(S1);
- SetLength (S3,Size+Location);
- Move (S1[1],S3[1],Location*sizeof(WideChar));
- Move (S2[1],S3[location+1],(Size+1)*sizeof(WideChar));
- end;
- end;
- Function fpc_Char_To_WideStr(const c : WideChar): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
- {
- Converts a Char to a WideString;
- }
- begin
- if c = #0 then
- { result is automatically set to '' }
- exit;
- Setlength (fpc_Char_To_WideStr,1);
- fpc_Char_To_WideStr[1]:=c;
- { Terminating Zero }
- PWideChar(Pointer(fpc_Char_To_WideStr)+sizeof(WideChar))^:=#0;
- end;
- { old style helper }
- {$ifndef hascompilerproc}
- Procedure fpc_Char_To_WideStr(var S1 : Pointer; c : WideChar);[Public, alias: 'FPC_CHAR_TO_WIDESTR'];
- begin
- s1 := pointer(fpc_Char_To_WideStr(c));
- end;
- {$endif hascompilerproc}
- Function fpc_PChar_To_WideStr(const p : pchar): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
- Var
- L : SizeInt;
- begin
- if (not assigned(p)) or (p[0]=#0) Then
- { result is automatically set to '' }
- exit;
- l:=IndexChar(p^,-1,#0);
- SetLength(fpc_PChar_To_WideStr,L);
- widestringmanager.Ansi2WideMoveProc(P,PWideChar(Pointer(fpc_PChar_To_WideStr)),l);
- end;
- { old style helper }
- {$ifndef hascompilerproc}
- Procedure fpc_PChar_To_WideStr(var a : WideString;p : pchar);[Public,Alias : 'FPC_PCHAR_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- begin
- pointer(a) := pointer(fpc_PChar_To_WideStr(p));
- end;
- {$endif hascompilerproc}
- Function fpc_CharArray_To_WideStr(const arr: array of char): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
- var
- i : SizeInt;
- begin
- if arr[0]=#0 Then
- { result is automatically set to '' }
- exit;
- i:=IndexChar(arr,high(arr)+1,#0);
- if i = -1 then
- i := high(arr)+1;
- SetLength(fpc_CharArray_To_WideStr,i);
- widestringmanager.Ansi2WideMoveProc (pchar(@arr),PWideChar(Pointer(fpc_CharArray_To_WideStr)),i);
- end;
- { old style helper }
- {$ifndef hascompilerproc}
- Procedure fpc_CharArray_To_WideStr(var a : WideString; p: pointer; len: SizeInt); [Public,Alias : 'FPC_CHARARRAY_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- var
- src: pchar;
- i: SizeInt;
- begin
- src := pchar(p);
- if src[0]=#0 Then
- begin
- pointer(a) := nil;
- exit;
- end;
- i:=IndexChar(src^,len,#0);
- if i = -1 then
- i := len;
- pointer(a) := NewWideString(i);
- Ansi2WideMoveProc (src,PWideChar(Pointer(@a[1])),i);
- end;
- {$endif not hascompilerproc}
- {$ifdef hascompilerproc}
- function fpc_WideCharArray_To_ShortStr(const arr: array of widechar): shortstring;[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
- var
- l: longint;
- {$else hascompilerproc}
- function fpc_WideCharArray_To_ShortStr(arr:pwidechar; l : longint):shortstring;[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR'];
- var
- {$endif hascompilerproc}
- index: longint;
- len: byte;
- begin
- {$ifdef hascompilerproc}
- l := high(arr)+1;
- {$endif hascompilerproc}
- if l>=256 then
- l:=255
- else if l<0 then
- l:=0;
- index:=IndexWord(arr[0],l,0);
- if (index < 0) then
- len := l
- else
- len := index;
- {$ifdef hascompilerproc}
- widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),PAnsiChar(@(fpc_WideCharArray_To_ShortStr[1])),len);
- {$else}
- widestringmanager.Wide2AnsiMoveProc (arr, PAnsiChar(@(fpc_WideCharArray_To_ShortStr[1])),len);
- {$endif}
- fpc_WideCharArray_To_ShortStr[0]:=chr(len);
- end;
- Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar): AnsiString; {$ifdef hascompilerproc} compilerproc; {$endif}
- var
- i : SizeInt;
- begin
- if arr[0]=#0 Then
- { result is automatically set to '' }
- exit;
- i:=IndexWord(arr,high(arr)+1,0);
- if i = -1 then
- i := high(arr)+1;
- SetLength(fpc_WideCharArray_To_AnsiStr,i);
- widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),PAnsiChar(Pointer(fpc_WideCharArray_To_AnsiStr)),i);
- end;
- { old style helper }
- {$ifndef hascompilerproc}
- Procedure fpc_WideCharArray_To_AnsiStr(var a : AnsiString; p: pointer; len: SizeInt); [Public,Alias : 'FPC_WIDECHARARRAY_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- var
- src: pwidechar;
- i: SizeInt;
- begin
- src := pwidechar(p);
- if src[0]=#0 Then
- begin
- pointer(a) := nil;
- exit;
- end;
- i:=IndexWord(src^,len,0);
- if i = -1 then
- i := len;
- pointer(a) := NewAnsiString(i);
- Wide2AnsiMoveProc (src,PAnsiChar(Pointer(@a[1])),i);
- end;
- {$endif not hascompilerproc}
- Function fpc_WideCharArray_To_WideStr(const arr: array of widechar): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
- var
- i : SizeInt;
- begin
- if arr[0]=#0 Then
- { result is automatically set to '' }
- exit;
- i:=IndexWord(arr,high(arr)+1,0);
- if i = -1 then
- i := high(arr)+1;
- SetLength(fpc_WideCharArray_To_WideStr,i);
- Move(pwidechar(@arr)^, PWideChar(Pointer(@fpc_WideCharArray_To_WideStr[1]))^,i*sizeof(WideChar));
- { Terminating Zero }
- PWideChar(Pointer(@fpc_WideCharArray_To_WideStr[1])+i*sizeof(WideChar))^:=#0;
- end;
- { old style helper }
- {$ifndef hascompilerproc}
- Procedure fpc_WideCharArray_To_WideStr(var a : WideString; p: pointer; len: SizeInt); [Public,Alias : 'FPC_WIDECHARARRAY_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- var
- src: pwidechar;
- i: SizeInt;
- begin
- src := pwidechar(p);
- if src[0]=#0 Then
- begin
- pointer(a) := nil;
- exit;
- end;
- i:=IndexWord(src^,len,#0);
- if i = -1 then
- i := len;
- pointer(a) := NewWideString(i);
- Move(p^, PWideChar(Pointer(@a[1]))^,i*sizeof(WideChar));
- { Terminating Zero }
- PWideChar(Pointer(@a[1])+i*sizeof(WideChar))^:=#0;
- end;
- {$endif not hascompilerproc}
- {$ifdef hascompilerproc}
- { inside the compiler, the resulttype is modified to that of the actual }
- { chararray we're converting to (JM) }
- function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
- var
- len: SizeInt;
- begin
- len := length(src);
- if len > arraysize then
- len := arraysize;
- { make sure we don't dereference src if it can be nil (JM) }
- if len > 0 then
- widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),pchar(@fpc_widestr_to_chararray[0]),len);
- fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
- end;
- {$endif hascompilerproc}
- {$ifdef hascompilerproc}
- { inside the compiler, the resulttype is modified to that of the actual }
- { widechararray we're converting to (JM) }
- function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray;[public,alias: 'FPC_WIDESTR_TO_WIDECHARARRAY']; compilerproc;
- var
- len: SizeInt;
- begin
- len := length(src);
- if len > arraysize then
- len := arraysize;
- { make sure we don't try to access element 1 of the ansistring if it's nil }
- if len > 0 then
- move(src[1],fpc_widestr_to_widechararray[0],len*SizeOf(WideChar));
- fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
- end;
- {$endif hascompilerproc}
- {$ifdef hascompilerproc}
- { inside the compiler, the resulttype is modified to that of the actual }
- { chararray we're converting to (JM) }
- function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray;[public,alias: 'FPC_ANSISTR_TO_WIDECHARARRAY']; compilerproc;
- var
- len: SizeInt;
- begin
- len := length(src);
- if len > arraysize then
- len := arraysize;
- { make sure we don't dereference src if it can be nil (JM) }
- if len > 0 then
- widestringmanager.ansi2widemoveproc(pchar(@src[1]),pwidechar(@fpc_ansistr_to_widechararray[0]),len);
- fillchar(fpc_ansistr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
- end;
- {$endif hascompilerproc}
- {$ifdef hascompilerproc}
- function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray;[public,alias: 'FPC_SHORTSTR_TO_WIDECHARARRAY']; compilerproc;
- var
- len: longint;
- begin
- len := length(src);
- if len > arraysize then
- len := arraysize;
- { make sure we don't access char 1 if length is 0 (JM) }
- if len > 0 then
- widestringmanager.ansi2widemoveproc(pchar(@src[1]),pwidechar(@fpc_shortstr_to_widechararray[0]),len);
- fillchar(fpc_shortstr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
- end;
- {$endif hascompilerproc}
- Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif}
- {
- Compares 2 WideStrings;
- The result is
- <0 if S1<S2
- 0 if S1=S2
- >0 if S1>S2
- }
- Var
- MaxI,Temp : SizeInt;
- begin
- if pointer(S1)=pointer(S2) then
- begin
- fpc_WideStr_Compare:=0;
- exit;
- end;
- Maxi:=Length(S1);
- temp:=Length(S2);
- If MaxI>Temp then
- MaxI:=Temp;
- Temp:=CompareWord(S1[1],S2[1],MaxI);
- if temp=0 then
- temp:=Length(S1)-Length(S2);
- fpc_WideStr_Compare:=Temp;
- end;
- Procedure fpc_WideStr_CheckZero(p : pointer);[Public,Alias : 'FPC_WIDESTR_CHECKZERO']; {$ifdef hascompilerproc} compilerproc; {$endif}
- begin
- if p=nil then
- HandleErrorFrame(201,get_frame);
- end;
- Procedure fpc_WideStr_CheckRange(len,index : SizeInt);[Public,Alias : 'FPC_WIDESTR_RANGECHECK']; {$ifdef hascompilerproc} compilerproc; {$endif}
- begin
- if (index>len) or (Index<1) then
- HandleErrorFrame(201,get_frame);
- end;
- {$ifndef INTERNSETLENGTH}
- Procedure SetLength (Var S : WideString; l : SizeInt);
- {$else INTERNSETLENGTH}
- Procedure fpc_WideStr_SetLength (Var S : WideString; l : SizeInt);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
- {$endif INTERNSETLENGTH}
- {
- Sets The length of string S to L.
- Makes sure S is unique, and contains enough room.
- }
- Var
- Temp : Pointer;
- movelen: SizeInt;
- begin
- if (l>0) then
- begin
- if Pointer(S)=nil then
- begin
- { Need a complete new string...}
- Pointer(s):=NewWideString(l);
- end
- else if (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
- begin
- Dec(Pointer(S),WideFirstOff);
- if L*sizeof(WideChar)+WideRecLen>MemSize(Pointer(S)) then
- reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
- Inc(Pointer(S), WideFirstOff);
- end
- else
- begin
- { Reallocation is needed... }
- Temp:=Pointer(NewWideString(L));
- if Length(S)>0 then
- begin
- if l < succ(length(s)) then
- movelen := l
- { also move terminating null }
- else movelen := succ(length(s));
- Move(Pointer(S)^,Temp^,movelen * Sizeof(WideChar));
- end;
- fpc_widestr_decr_ref(Pointer(S));
- Pointer(S):=Temp;
- end;
- { Force nil termination in case it gets shorter }
- PWord(Pointer(S)+l*sizeof(WideChar))^:=0;
- PWideRec(Pointer(S)-FirstOff)^.Len:=l;
- end
- else
- begin
- { Length=0 }
- if Pointer(S)<>nil then
- fpc_widestr_decr_ref (Pointer(S));
- Pointer(S):=Nil;
- end;
- end;
- {*****************************************************************************
- Public functions, In interface.
- *****************************************************************************}
- function WideCharToString(S : PWideChar) : AnsiString;
- begin
- result:=WideCharLenToString(s,Length(WideString(s)));
- end;
- function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
- begin
- if Length(Src)<DestSize then
- widestringmanager.Ansi2WideMoveProc(PChar(Src),Dest,Length(Src))
- else
- widestringmanager.Ansi2WideMoveProc(PChar(Src),Dest,DestSize);
- result:=Dest;
- end;
- function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
- begin
- SetLength(result,Len);
- Wide2AnsiMove(S,PChar(result),Len);
- end;
- procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;var Dest : AnsiString);
- begin
- Dest:=WideCharLenToString(Src,Len);
- end;
- procedure WideCharToStrVar(S : PWideChar;var Dest : AnsiString);
- begin
- Dest:=WideCharToString(S);
- end;
- {$ifndef INTERNLENGTH}
- Function Length (Const S : WideString) : SizeInt;
- {
- Returns the length of an WideString.
- Takes in acount that zero strings are NIL;
- }
- begin
- If Pointer(S)=Nil then
- Length:=0
- else
- Length:=PWideRec(Pointer(S)-WideFirstOff)^.Len;
- end;
- {$endif INTERNLENGTH}
- Function fpc_widestr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_WIDESTR_UNIQUE']; {$ifdef hascompilerproc} compilerproc; {$endif}
- {
- Make sure reference count of S is 1,
- using copy-on-write semantics.
- }
- Var
- SNew : Pointer;
- L : SizeInt;
- begin
- pointer(result) := pointer(s);
- If Pointer(S)=Nil then
- exit;
- if PWideRec(Pointer(S)-WideFirstOff)^.Ref<>1 then
- begin
- L:=PWideRec(Pointer(S)-WideFirstOff)^.len;
- SNew:=NewWideString (L);
- Move (PWideChar(S)^,SNew^,(L+1)*sizeof(WideChar));
- PWideRec(SNew-WideFirstOff)^.len:=L;
- fpc_widestr_decr_ref (Pointer(S)); { Thread safe }
- pointer(S):=SNew;
- pointer(result):=SNew;
- end;
- end;
- {$ifdef interncopy}
- Function Fpc_WideStr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc;
- {$else}
- Function Copy (Const S : WideString; Index,Size : SizeInt) : WideString;
- {$endif}
- var
- ResultAddress : Pointer;
- begin
- ResultAddress:=Nil;
- dec(index);
- if Index < 0 then
- Index := 0;
- { Check Size. Accounts for Zero-length S, the double check is needed because
- Size can be maxint and will get <0 when adding index }
- if (Size>Length(S)) or
- (Index+Size>Length(S)) then
- Size:=Length(S)-Index;
- If Size>0 then
- begin
- If Index<0 Then
- Index:=0;
- ResultAddress:=Pointer(NewWideString (Size));
- if ResultAddress<>Nil then
- begin
- Move (PWideChar(S)[Index],ResultAddress^,Size*sizeof(WideChar));
- PWideRec(ResultAddress-WideFirstOff)^.Len:=Size;
- PWideChar(ResultAddress+Size*sizeof(WideChar))^:=#0;
- end;
- end;
- {$ifdef interncopy}
- Pointer(fpc_widestr_Copy):=ResultAddress;
- {$else}
- Pointer(Copy):=ResultAddress;
- {$endif}
- end;
- Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
- var
- i,MaxLen : SizeInt;
- pc : pwidechar;
- begin
- Pos:=0;
- if Length(SubStr)>0 then
- begin
- MaxLen:=Length(source)-Length(SubStr);
- i:=0;
- pc:=@source[1];
- while (i<=MaxLen) do
- begin
- inc(i);
- if (SubStr[1]=pc^) and
- (CompareWord(Substr[1],pc^,Length(SubStr))=0) then
- begin
- Pos:=i;
- exit;
- end;
- inc(pc);
- end;
- end;
- end;
- { Faster version for a widechar alone }
- Function Pos (c : WideChar; Const s : WideString) : SizeInt;
- var
- i: SizeInt;
- pc : pwidechar;
- begin
- pc:=@s[1];
- for i:=1 to length(s) do
- begin
- if pc^=c then
- begin
- pos:=i;
- exit;
- end;
- inc(pc);
- end;
- pos:=0;
- end;
- { Faster version for a char alone. Must be implemented because }
- { pos(c: char; const s: shortstring) also exists, so otherwise }
- { using pos(char,pchar) will always call the shortstring version }
- { (exact match for first argument), also with $h+ (JM) }
- Function Pos (c : Char; Const s : WideString) : SizeInt;
- var
- i: SizeInt;
- wc : widechar;
- pc : pwidechar;
- begin
- wc:=c;
- pc:=@s[1];
- for i:=1 to length(s) do
- begin
- if pc^=wc then
- begin
- pos:=i;
- exit;
- end;
- inc(pc);
- end;
- pos:=0;
- end;
- Procedure Delete (Var S : WideString; Index,Size: SizeInt);
- Var
- LS : SizeInt;
- begin
- If Length(S)=0 then
- exit;
- if index<=0 then
- exit;
- LS:=PWideRec(Pointer(S)-WideFirstOff)^.Len;
- if (Index<=LS) and (Size>0) then
- begin
- UniqueString (S);
- if Size+Index>LS then
- Size:=LS-Index+1;
- if Index+Size<=LS then
- begin
- Dec(Index);
- Move(PWideChar(S)[Index+Size],PWideChar(S)[Index],(LS-Index+1)*sizeof(WideChar));
- end;
- Setlength(s,LS-Size);
- end;
- end;
- Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt);
- var
- Temp : WideString;
- LS : SizeInt;
- begin
- If Length(Source)=0 then
- exit;
- if index <= 0 then
- index := 1;
- Ls:=Length(S);
- if index > LS then
- index := LS+1;
- Dec(Index);
- Pointer(Temp) := NewWideString(Length(Source)+LS);
- SetLength(Temp,Length(Source)+LS);
- If Index>0 then
- move (PWideChar(S)^,PWideChar(Temp)^,Index*sizeof(WideChar));
- Move (PWideChar(Source)^,PWideChar(Temp)[Index],Length(Source)*sizeof(WideChar));
- If (LS-Index)>0 then
- Move(PWideChar(S)[Index],PWideChar(temp)[Length(Source)+index],(LS-Index)*sizeof(WideChar));
- S:=Temp;
- end;
- Procedure SetString (Var S : WideString; Buf : PWideChar; Len : SizeInt);
- var
- BufLen: SizeInt;
- begin
- SetLength(S,Len);
- If (Buf<>Nil) and (Len>0) then
- begin
- BufLen := IndexWord(Buf^, Len+1, 0);
- If (BufLen>0) and (BufLen < Len) then
- Len := BufLen;
- Move (Buf[0],S[1],Len*sizeof(WideChar));
- PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
- end;
- end;
- Procedure SetString (Var S : WideString; Buf : PChar; Len : SizeInt);
- var
- BufLen: SizeInt;
- begin
- SetLength(S,Len);
- If (Buf<>Nil) and (Len>0) then
- begin
- BufLen := IndexByte(Buf^, Len+1, 0);
- If (BufLen>0) and (BufLen < Len) then
- Len := BufLen;
- widestringmanager.Ansi2WideMoveProc(Buf,PWideChar(S),Len);
- PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
- end;
- end;
- Function fpc_Val_Real_WideStr(Const S : WideString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- Var
- SS : String;
- begin
- fpc_Val_Real_WideStr := 0;
- if length(S) > 255 then
- code := 256
- else
- begin
- SS := S;
- Val(SS,fpc_Val_Real_WideStr,code);
- end;
- end;
- Function fpc_Val_UInt_WideStr (Const S : WideString; Var Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- Var
- SS : ShortString;
- begin
- fpc_Val_UInt_WideStr := 0;
- if length(S) > 255 then
- code := 256
- else
- begin
- SS := S;
- Val(SS,fpc_Val_UInt_WideStr,code);
- end;
- end;
- Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; Var Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- Var
- SS : ShortString;
- begin
- fpc_Val_SInt_WideStr:=0;
- if length(S)>255 then
- code:=256
- else
- begin
- SS := S;
- fpc_Val_SInt_WideStr := int_Val_SInt_ShortStr(DestSize,SS,Code);
- end;
- end;
- {$ifndef CPU64}
- Function fpc_Val_qword_WideStr (Const S : WideString; Var Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- Var
- SS : ShortString;
- begin
- fpc_Val_qword_WideStr:=0;
- if length(S)>255 then
- code:=256
- else
- begin
- SS := S;
- Val(SS,fpc_Val_qword_WideStr,Code);
- end;
- end;
- Function fpc_Val_int64_WideStr (Const S : WideString; Var Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- Var
- SS : ShortString;
- begin
- fpc_Val_int64_WideStr:=0;
- if length(S)>255 then
- code:=256
- else
- begin
- SS := S;
- Val(SS,fpc_Val_int64_WideStr,Code);
- end;
- end;
- {$endif CPU64}
- procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;var s : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
- var
- ss : shortstring;
- begin
- str_real(len,fr,d,treal_type(rt),ss);
- s:=ss;
- end;
- {$ifdef STR_USES_VALINT}
- Procedure fpc_WideStr_SInt(v : ValSint; Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
- {$else}
- Procedure fpc_WideStr_Longint(v : Longint; Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
- {$endif}
- Var
- SS : ShortString;
- begin
- Str (v:Len,SS);
- S:=SS;
- end;
- {$ifdef STR_USES_VALINT}
- Procedure fpc_WideStr_UInt(v : ValUInt;Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
- {$else}
- Procedure fpc_WideStr_Longword(v : Longword;Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
- {$endif}
- Var
- SS : ShortString;
- begin
- str(v:Len,SS);
- S:=SS;
- end;
- {$ifndef CPU64}
- Procedure fpc_WideStr_Int64(v : Int64; Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
- Var
- SS : ShortString;
- begin
- Str (v:Len,SS);
- S:=SS;
- end;
- Procedure fpc_WideStr_Qword(v : Qword;Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
- Var
- SS : ShortString;
- begin
- str(v:Len,SS);
- S:=SS;
- end;
- {$endif CPU64}
- function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
- begin
- if assigned(Source) then
- Result:=UnicodeToUtf8(Dest,MaxBytes,Source,IndexWord(Source^,-1,0))
- else
- Result:=0;
- end;
- function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PWideChar; SourceChars: SizeUInt): SizeUInt;
- var
- i,j : SizeUInt;
- w : word;
- begin
- result:=0;
- if source=nil then
- exit;
- i:=0;
- j:=0;
- if assigned(Dest) then
- begin
- while (i<SourceChars) and (j<MaxDestBytes) do
- begin
- w:=word(Source[i]);
- case w of
- 0..$7f:
- begin
- Dest[j]:=char(w);
- inc(j);
- end;
- $80..$7ff:
- begin
- if j+1>=MaxDestBytes then
- break;
- Dest[j]:=char($c0 or (w shr 6));
- Dest[j+1]:=char($80 or (w and $3f));
- inc(j,2);
- end;
- else
- begin
- if j+2>=MaxDestBytes then
- break;
- Dest[j]:=char($e0 or (w shr 12));
- Dest[j+1]:=char($80 or ((w shr 6)and $3f));
- Dest[j+2]:=char($80 or (w and $3f));
- inc(j,3);
- end;
- end;
- inc(i);
- end;
- if j>MaxDestBytes-1 then
- j:=MaxDestBytes-1;
- Dest[j]:=#0;
- end
- else
- begin
- while i<SourceChars do
- begin
- case word(Source[i]) of
- $0..$7f:
- inc(j);
- $80..$7ff:
- inc(j,2);
- else
- inc(j,3);
- end;
- end;
- end;
- result:=j+1;
- end;
- function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
- begin
- if assigned(Source) then
- Result:=Utf8ToUnicode(Dest,MaxChars,Source,strlen(Source))
- else
- Result:=0;
- end;
- function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
- var
- i,j : SizeUInt;
- w : word;
- b : byte;
- begin
- result:=0;
- i:=0;
- j:=0;
- if assigned(Dest) then
- begin
- while (j<MaxDestChars) and (i<SourceBytes) do
- begin
- b:=byte(Source[i]);
- inc(i);
- // 2 or 3 bytes?
- if b>=$80 then
- begin
- w:=b and $3c;
- if i>=SourceBytes then
- exit;
- // 3 bytes?
- if (b and $20)<>0 then
- begin
- b:=byte(Source[i]);
- inc(i);
- if i>=SourceBytes then
- exit;
- if (b and $c0)<>$80 then
- exit;
- w:=(w shl 6) or (b and $3c);
- end;
- b:=byte(Source[i]);
- w:=(w shl 6) or (b and $3c);
- if (b and $c0)<>$80 then
- exit;
- inc(i);
- end;
- Dest[j]:=WideChar(w);
- inc(j);
- end;
- end
- else
- begin
- while i<SourceBytes do
- begin
- b:=byte(Source[i]);
- inc(i);
- // 2 or 3 bytes?
- if b>=$80 then
- begin
- if i>=SourceBytes then
- exit;
- // 3 bytes?
- if (b and $20)<>0 then
- begin
- b:=byte(Source[i]);
- inc(i);
- if i>=SourceBytes then
- exit;
- if (b and $c0)<>$80 then
- exit;
- end;
- if (byte(Source[i]) and $c0)<>$80 then
- exit;
- inc(i);
- end;
- inc(j);
- end;
- end;
- result:=j+1;
- end;
- function UTF8Encode(const s : WideString) : UTF8String;
- var
- i : SizeInt;
- hs : UTF8String;
- begin
- result:='';
- if s='' then
- exit;
- SetLength(hs,length(s)*3);
- i:=UnicodeToUtf8(pchar(hs),length(hs)+1,PWideChar(s),length(s));
- if i>0 then
- begin
- SetLength(hs,i-1);
- result:=hs;
- end;
- end;
- function UTF8Decode(const s : UTF8String): WideString;
- var
- i : SizeInt;
- hs : WideString;
- begin
- result:='';
- if s='' then
- exit;
- SetLength(hs,length(s));
- i:=Utf8ToUnicode(PWideChar(hs),length(hs)+1,pchar(s),length(s));
- if i>0 then
- begin
- SetLength(hs,i-1);
- result:=hs;
- end;
- end;
- function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
- begin
- Result:=Utf8Encode(s);
- end;
- function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
- begin
- Result:=Utf8Decode(s);
- end;
- procedure unimplementedwidestring;
- begin
- HandleErrorFrame(215,get_frame);
- end;
- function GenericWideCase(const s : WideString) : WideString;
- begin
- unimplementedwidestring;
- end;
- function CompareWideString(const s1, s2 : WideString) : PtrInt;
- begin
- unimplementedwidestring;
- end;
- function SameWideString(const s1, s2 : WideString) : Boolean;
- begin
- unimplementedwidestring;
- end;
- procedure initwidestringmanager;
- begin
- fillchar(widestringmanager,sizeof(widestringmanager),0);
- widestringmanager.Wide2AnsiMoveProc:=@Wide2AnsiMove;
- widestringmanager.Ansi2WideMoveProc:=@Ansi2WideMove;
- widestringmanager.UpperWideStringProc:=@GenericWideCase;
- widestringmanager.CompareWideStringProc:=@CompareWideString;
- widestringmanager.SameWideStringProc:=@SameWideString;
- end;
- {
- $Log$
- Revision 1.48 2005-02-01 20:22:49 florian
- * improved widestring infrastructure manager
- Revision 1.47 2005/01/06 13:31:06 florian
- * widecharray patch from Peter
- Revision 1.46 2004/11/17 22:19:04 peter
- internconst, internproc and some external declarations moved to interface
- Revision 1.45 2004/10/24 20:01:42 peter
- * saveregisters calling convention is obsolete
- Revision 1.44 2004/09/29 14:55:49 mazen
- * widestring conversion routines takes a widechar so no
- information is lost
- Revision 1.43 2004/09/18 10:23:08 jonas
- - removed unused local variable
- * fixed bug in Utf8ToUnicode (use of uninitialised variable)
- Revision 1.42 2004/07/18 20:21:44 florian
- + several unicode (to/from utf-8 conversion) stuff added
- * some longint -> SizeInt changes
- Revision 1.41 2004/07/12 17:58:19 peter
- * remove maxlen field from ansistring/widestrings
- Revision 1.40 2004/07/02 21:21:09 peter
- * decr ref doesn't reset pointer
- * finalize resets pointer for astring,wstring
- Revision 1.39 2004/05/31 14:31:57 peter
- * remove comment warnings
- Revision 1.38 2004/05/29 15:39:08 florian
- * the decr functions set the data now to nil
- Revision 1.37 2004/05/01 23:55:18 peter
- * replace strlenint with sizeint
- Revision 1.36 2004/04/29 18:59:43 peter
- * str() helpers now also use valint/valuint
- * int64/qword helpers disabled for cpu64
- Revision 1.35 2004/01/22 22:09:05 peter
- * finalize needs to reset to nil after decr_ref
- Revision 1.34 2003/11/29 17:27:05 michael
- + Added overloaded version of SetWideStringManager without old parameter
- Revision 1.33 2003/11/28 20:36:13 michael
- + Added WideStringManager
- Revision 1.32 2003/11/05 15:33:51 florian
- * made Index* usage consistent with astrings.inc
- Revision 1.31 2003/06/17 19:24:08 jonas
- * fixed conversion of fpc_*str_unique to compilerproc
- Revision 1.30 2003/06/17 16:38:53 jonas
- * fpc_ansistr|widestr_unique is now a function so it can be used as
- compilerproc
- Revision 1.29 2003/05/01 08:05:23 florian
- * started to make the rtl 64 bit save by introducing SizeInt and SizeUInt (similar to size_t of C)
- Revision 1.28 2002/12/29 16:59:17 peter
- * implemented some more conversions
- Revision 1.27 2002/12/15 22:33:12 peter
- * SetString(WideString,[PChar|PWideChar],Len) added
- Revision 1.26 2002/12/14 19:16:45 sg
- * Ported improvements from the AnsiString equivalents to NewWideString and
- fpc_WideStr_SetLength
- Revision 1.25 2002/12/07 14:35:34 carl
- - avoid warnings (add typecast)
- Revision 1.24 2002/10/10 16:08:50 florian
- + several widestring/pwidechar related helpers added
- Revision 1.23 2002/10/02 18:21:52 peter
- * Copy() changed to internal function calling compilerprocs
- * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
- new copy functions
- Revision 1.22 2002/09/26 21:50:38 florian
- + some WideString<->AnsiString conversion functions added
- Revision 1.21 2002/09/14 11:20:50 carl
- * Delphi compatibility fix (with string routines)
- Revision 1.20 2002/09/07 21:16:45 carl
- * cardinal -> longword
- Revision 1.19 2002/09/07 15:07:46 peter
- * old logs removed and tabs fixed
- Revision 1.18 2002/07/29 21:28:17 florian
- * several fixes to get further with linux/ppc system unit compilation
- Revision 1.17 2002/04/26 15:19:05 peter
- * use saveregisters for incr routines, saves also problems with
- the optimizer
- Revision 1.16 2002/04/25 20:14:57 peter
- * updated compilerprocs
- * incr ref count has now a value argument instead of var
- }
|