astrings.inc 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Michael Van Canneyt,
  4. member of the Free Pascal development team.
  5. This file implements AnsiStrings for FPC
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. { This will release some functions for special shortstring support }
  13. { define EXTRAANSISHORT}
  14. constructor AnsistringClass.Create(const arr: array of ansichar; length: longint);
  15. begin
  16. { make explicit copy so that changing the array afterwards doesn't change
  17. the string }
  18. if length=0 then
  19. begin
  20. { terminating #0 }
  21. setlength(fdata,1);
  22. exit;
  23. end;
  24. setlength(fdata,length+1);
  25. JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(fdata),0,length);
  26. // last char is already #0 because of setlength
  27. end;
  28. constructor AnsistringClass.Create(const arr: array of unicodechar);
  29. begin
  30. if high(arr)=-1 then
  31. begin
  32. { terminating #0 }
  33. setlength(fdata,1);
  34. exit;
  35. end;
  36. fdata:=TAnsiCharArray(JLString.Create(arr).getBytes);
  37. setlength(fdata,system.length(fdata)+1);
  38. // last char is already #0 because of setlength
  39. end;
  40. constructor AnsistringClass.Create(const u: unicodestring);
  41. begin
  42. if system.length(u)=0 then
  43. begin
  44. { terminating #0 }
  45. setlength(fdata,1);
  46. exit;
  47. end;
  48. fdata:=TAnsiCharArray(JLString(u).getBytes);
  49. setlength(fdata,system.length(fdata)+1);
  50. // last char is already #0 because of setlength
  51. end;
  52. constructor AnsistringClass.Create(const a: ansistring);
  53. begin
  54. Create(AnsistringClass(a).fdata,system.length(AnsistringClass(a).fdata)-1);
  55. end;
  56. constructor AnsistringClass.Create(const s: shortstring);
  57. begin
  58. Create(ShortstringClass(@s).fdata,system.length(ShortstringClass(@s).fdata));
  59. end;
  60. constructor AnsistringClass.Create(ch: ansichar);
  61. begin
  62. setlength(fdata,2);
  63. fdata[0]:=ch;
  64. // last char is already #0 because of setlength
  65. end;
  66. constructor AnsistringClass.Create(ch: unicodechar);
  67. begin
  68. fdata:=TAnsiCharArray(JLString.Create(ch).getBytes);
  69. setlength(fdata,system.length(fdata)+1);
  70. // last char is already #0 because of setlength
  71. end;
  72. class function AnsistringClass.CreateFromLiteralStringBytes(const u: unicodestring): ansistring;
  73. var
  74. res: AnsistringClass;
  75. i: longint;
  76. begin
  77. { used to construct constant ansistrings from Java string constants }
  78. res:=AnsistringClass.Create;
  79. { +1 for terminating #0 }
  80. setlength(res.fdata,system.length(u)+1);
  81. for i:=1 to system.length(u) do
  82. res.fdata[i-1]:=ansichar(ord(u[i]));
  83. result:=ansistring(res);
  84. end;
  85. function AnsistringClass.charAt(index: jint): ansichar;
  86. begin
  87. { index is already decreased by one, because same calling code is used for
  88. JLString.charAt() }
  89. result:=fdata[index];
  90. end;
  91. function AnsistringClass.toUnicodeString: unicodestring;
  92. begin
  93. result:=UnicodeString(JLString.Create(TJByteArray(fdata),0,system.length(fdata)-1));
  94. end;
  95. function AnsistringClass.toShortstring(maxlen: byte): shortstring;
  96. begin
  97. result:=pshortstring(ShortstringClass.Create(ansistring(self),maxlen))^;
  98. end;
  99. function AnsistringClass.toString: JLString;
  100. begin
  101. result:=JLString.Create(TJByteArray(fdata),0,system.length(fdata)-1);
  102. end;
  103. (*
  104. function AnsistringClass.concat(const a: ansistring): ansistring;
  105. var
  106. newdata: array of ansichar;
  107. addlen: sizeint;
  108. begin
  109. addlen:=length(a);
  110. thislen:=this.length;
  111. setlength(newdata,addlen+thislen);
  112. if thislen>0 then
  113. JLSystem.ArrayCopy(JLObject(fdata),0,JLObject(newdata),0,thislen);
  114. if addlen>0 then
  115. JLSystem.ArrayCopy(JLObject(AnsistringClass(a).fdata),0,JLObject(newdata),thislen,addlen);
  116. end;
  117. procedure AnsistringClass.concatmultiple(const arr: array of ansistring): ansistring;
  118. Var
  119. i : longint;
  120. size, newsize : sizeint;
  121. curlen, addlen : sizeint
  122. newdata: array of ansichar;
  123. begin
  124. { First calculate size of the result so we can allocate an array of
  125. the right size }
  126. NewSize:=0;
  127. for i:=low(arr) to high(arr) do
  128. inc(newsize,length(arr[i]));
  129. setlength(newdata,newsize);
  130. curlen
  131. for i:=low(arr) to high(arr) do
  132. begin
  133. if length(arr[i])>0 then
  134. sb.append(arr[i]);
  135. end;
  136. DestS:=sb.toString;
  137. end;
  138. *)
  139. function AnsiStringClass.length: jint;
  140. begin
  141. result:=system.length(fdata)-1;
  142. end;
  143. {****************************************************************************
  144. Internal functions, not in interface.
  145. ****************************************************************************}
  146. function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): ansistring; compilerproc;
  147. var
  148. newdata: array of ansichar;
  149. thislen, addlen: sizeint;
  150. begin
  151. thislen:=length(s1);
  152. addlen:=length(s2);
  153. { +1 for terminating #0 }
  154. setlength(newdata,thislen+addlen+1);
  155. if thislen>0 then
  156. JLSystem.ArrayCopy(JLObject(AnsistringClass(s1).fdata),0,JLObject(newdata),0,thislen);
  157. if addlen>0 then
  158. JLSystem.ArrayCopy(JLObject(AnsistringClass(s2).fdata),0,JLObject(newdata),thislen,addlen);
  159. result:=Ansistring(AnsistringClass.Create);
  160. AnsistringClass(result).fdata:=newdata;
  161. end;
  162. procedure fpc_AnsiStr_Concat_multi (var DestS:Ansistring;const sarr:array of Ansistring); compilerproc;
  163. Var
  164. i : longint;
  165. size, newsize : sizeint;
  166. curlen, addlen, nextlen : sizeint;
  167. newdata: array of ansichar;
  168. res : AnsistringClass;
  169. begin
  170. { First calculate size of the result so we can allocate an array of
  171. the right size }
  172. NewSize:=0;
  173. for i:=low(sarr) to high(sarr) do
  174. inc(newsize,length(sarr[i]));
  175. { +1 for terminating #0 }
  176. setlength(newdata,newsize+1);
  177. curlen:=0;
  178. for i:=low(sarr) to high(sarr) do
  179. begin
  180. nextlen:=length(sarr[i]);
  181. if nextlen>0 then
  182. begin
  183. JLSystem.ArrayCopy(JLObject(AnsistringClass(sarr[i]).fdata),0,JLObject(newdata),curlen,nextlen);
  184. inc(curlen,nextlen);
  185. end;
  186. end;
  187. res:=AnsistringClass.Create;
  188. res.fdata:=newdata;
  189. dests:=Ansistring(res);
  190. end;
  191. procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : Ansistring); compilerproc;
  192. {
  193. Converts a AnsiString to a ShortString;
  194. }
  195. Var
  196. Size : SizeInt;
  197. begin
  198. if S2='' then
  199. res:=''
  200. else
  201. begin
  202. Size:=Length(S2);
  203. If Size>high(res) then
  204. Size:=high(res);
  205. JLSystem.ArrayCopy(JLObject(AnsistringClass(S2).fdata),0,JLObject(ShortstringClass(@res).fdata),0,Size);
  206. setlength(res,Size);
  207. end;
  208. end;
  209. Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
  210. {
  211. Converts a ShortString to a AnsiString;
  212. }
  213. Var
  214. Size : SizeInt;
  215. begin
  216. Size:=Length(S2);
  217. Setlength(result,Size);
  218. if Size>0 then
  219. JLSystem.ArrayCopy(JLObject(ShortstringClass(@S2).fdata),0,JLObject(AnsistringClass(result).fdata),0,Size);
  220. end;
  221. Function fpc_Char_To_AnsiStr(const c : AnsiChar): AnsiString; compilerproc;
  222. {
  223. Converts a Char to a AnsiString;
  224. }
  225. begin
  226. result:=ansistring(AnsistringClass.Create(c));
  227. end;
  228. Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
  229. var
  230. i, len: longint;
  231. arr: TAnsiCharArray;
  232. begin
  233. arr:=TAnsiCharArray(p);
  234. i:=0;
  235. while arr[i]<>#0 do
  236. inc(i);
  237. if i<>0 then
  238. result:=ansistring(AnsiStringClass.create(arr,i))
  239. else
  240. result:=''
  241. end;
  242. Function fpc_CharArray_To_AnsiStr(const arr: array of ansichar; zerobased: boolean = true): ansistring; compilerproc;
  243. var
  244. i,j : SizeInt;
  245. localarr: array of jbyte;
  246. foundnull: boolean;
  247. res: AnsistringClass;
  248. begin
  249. if (zerobased) then
  250. begin
  251. if (arr[0]=#0) Then
  252. begin
  253. fpc_CharArray_To_AnsiStr := '';
  254. exit;
  255. end;
  256. foundnull:=false;
  257. j:=0;
  258. for i:=low(arr) to high(arr) do
  259. if arr[i]=#0 then
  260. begin
  261. foundnull:=true;
  262. j:=i;
  263. break;
  264. end;
  265. if foundnull then
  266. begin
  267. res:=AnsistringClass.Create(arr,j);
  268. exit;
  269. end
  270. end
  271. else
  272. begin
  273. res:=AnsistringClass.Create(arr);
  274. exit;
  275. end;
  276. res:=AnsistringClass.Create;
  277. { +1 for terminating 0 }
  278. setlength(res.fdata,high(arr)+2);
  279. JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(res.fdata),0,high(arr)+1);
  280. result:=Ansistring(res);
  281. end;
  282. procedure fpc_ansistr_to_chararray(out res: array of ansichar; const src: ansistring); compilerproc;
  283. var
  284. len: longint;
  285. begin
  286. len:=length(src);
  287. if len>length(res) then
  288. len:=length(res);
  289. { make sure we don't try to access element 1 of the ansistring if it's nil }
  290. if len>0 then
  291. JLSystem.ArrayCopy(JLObject(AnsistringClass(src).fdata),0,JLObject(@res),0,len);
  292. if len<=high(res) then
  293. JUArrays.fill(TJByteArray(@res),len,high(res),0);
  294. end;
  295. function fpc_ansistr_setchar(const s: AnsiString; const index: longint; const ch: ansichar): AnsiString; compilerproc;
  296. var
  297. res: AnsistringClass;
  298. begin
  299. res:=AnsistringClass.Create(s);
  300. res.fdata[index-1]:=ch;
  301. result:=Ansistring(res);
  302. end;
  303. Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
  304. {
  305. Compares 2 AnsiStrings;
  306. The result is
  307. <0 if S1<S2
  308. 0 if S1=S2
  309. >0 if S1>S2
  310. }
  311. Var
  312. MaxI,Temp, i : SizeInt;
  313. begin
  314. if JLObject(S1)=JLObject(S2) then
  315. begin
  316. result:=0;
  317. exit;
  318. end;
  319. Maxi:=Length(S1);
  320. temp:=Length(S2);
  321. If MaxI>Temp then
  322. MaxI:=Temp;
  323. if MaxI>0 then
  324. begin
  325. for i:=0 to MaxI-1 do
  326. begin
  327. result:=ord(AnsistringClass(S1).fdata[i])-ord(AnsistringClass(S2).fdata[i]);
  328. if result<>0 then
  329. exit;
  330. end;
  331. result:=Length(S1)-Length(S2);
  332. end
  333. else
  334. result:=Length(S1)-Length(S2);
  335. end;
  336. Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc;
  337. {
  338. Compares 2 AnsiStrings for equality/inequality only;
  339. The result is
  340. 0 if S1=S2
  341. <>0 if S1<>S2
  342. }
  343. Var
  344. MaxI,Temp : SizeInt;
  345. begin
  346. if JLObject(S1)=JLObject(S2) then
  347. begin
  348. result:=0;
  349. exit;
  350. end;
  351. result:=ord(not JUArrays.equals(TJByteArray(AnsistringClass(S1).fdata),TJByteArray(AnsistringClass(S2).fdata)));
  352. end;
  353. function fpc_AnsiStr_SetLength (S : AnsiString; l : SizeInt): Ansistring; compilerproc;
  354. {
  355. Sets The length of string S to L.
  356. Makes sure S is unique, and contains enough room.
  357. }
  358. begin
  359. if not assigned(AnsistringClass(s)) then
  360. result:=ansistring(AnsistringClass.Create)
  361. else
  362. result:=s;
  363. { +1 for terminating #0 }
  364. setlength(AnsistringClass(result).fdata,l+1);
  365. end;
  366. {*****************************************************************************
  367. Public functions, In interface.
  368. *****************************************************************************}
  369. (*
  370. function fpc_truely_ansistr_unique(Var S : Pointer): Pointer;
  371. Var
  372. SNew : Pointer;
  373. L : SizeInt;
  374. begin
  375. L:=PAnsiRec(Pointer(S)-FirstOff)^.len;
  376. SNew:=NewAnsiString (L);
  377. Move (Pointer(S)^,SNew^,L+1);
  378. PAnsiRec(SNew-FirstOff)^.len:=L;
  379. fpc_ansistr_decr_ref (Pointer(S)); { Thread safe }
  380. pointer(S):=SNew;
  381. pointer(result):=SNew;
  382. end;
  383. *)
  384. (*
  385. {$ifndef FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
  386. // MV: inline the basic checks for case that S is already unique.
  387. // Rest is too complex to inline, so factor that out as a call.
  388. Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc;
  389. {
  390. Make sure reference count of S is 1,
  391. using copy-on-write semantics.
  392. }
  393. begin
  394. pointer(result) := pointer(s);
  395. If Pointer(S)=Nil then
  396. exit;
  397. if PAnsiRec(Pointer(S)-Firstoff)^.Ref<>1 then
  398. result:=fpc_truely_ansistr_unique(s);
  399. end;
  400. {$endif FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
  401. *)
  402. Procedure fpc_ansistr_append_char(Var S : AnsiString;c : ansichar); compilerproc;
  403. var
  404. curlen: sizeint;
  405. begin
  406. curlen:=length(s);
  407. SetLength(s,curlen+1);
  408. AnsistringClass(s).fdata[curlen]:=c;
  409. end;
  410. Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc;
  411. var
  412. ofs : SizeInt;
  413. begin
  414. if Str='' then
  415. exit;
  416. ofs:=Length(S);
  417. SetLength(S,ofs+length(Str));
  418. { the pbyte cast avoids an unique call which isn't necessary because SetLength was just called }
  419. JLSystem.ArrayCopy(JLObject(ShortstringClass(@Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,length(Str));
  420. end;
  421. Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;
  422. var
  423. ofs, strlength: longint;
  424. begin
  425. if Str='' then
  426. exit;
  427. strlength:=length(str);
  428. ofs:=Length(S);
  429. { no problem if s and str are the same string, because "var" parameters are
  430. copy-in/out for ansistring }
  431. SetLength(S,ofs+strlength);
  432. JLSystem.ArrayCopy(JLObject(AnsistringClass(Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,strlength);
  433. end;
  434. Function Fpc_Ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc;
  435. var
  436. res: AnsistringClass;
  437. begin
  438. dec(index);
  439. if Index < 0 then
  440. Index := 0;
  441. { Check Size. Accounts for Zero-length S, the double check is needed because
  442. Size can be maxint and will get <0 when adding index }
  443. if (Size>Length(S)) or
  444. (Index+Size>Length(S)) then
  445. Size:=Length(S)-Index;
  446. If Size>0 then
  447. begin
  448. res:=AnsistringClass.Create;
  449. { +1 for terminating #0 }
  450. setlength(res.fdata,size+1);
  451. JLSystem.ArrayCopy(JLObject(AnsistringClass(S).fdata),index,JLObject(res.fdata),0,size);
  452. result:=ansistring(res);
  453. end;
  454. { default function result is empty string }
  455. end;
  456. (*
  457. Function Pos (Const Substr : ShortString; Const Source : AnsiString) : SizeInt;
  458. var
  459. i,MaxLen : SizeInt;
  460. pc : pchar;
  461. begin
  462. Pos:=0;
  463. if Length(SubStr)>0 then
  464. begin
  465. MaxLen:=Length(source)-Length(SubStr);
  466. i:=0;
  467. pc:=@source[1];
  468. while (i<=MaxLen) do
  469. begin
  470. inc(i);
  471. if (SubStr[1]=pc^) and
  472. (CompareByte(Substr[1],pc^,Length(SubStr))=0) then
  473. begin
  474. Pos:=i;
  475. exit;
  476. end;
  477. inc(pc);
  478. end;
  479. end;
  480. end;
  481. *)
  482. Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt;
  483. var
  484. i,j,k,MaxLen, SubstrLen : SizeInt;
  485. begin
  486. Pos:=0;
  487. SubstrLen:=Length(SubStr);
  488. if SubstrLen>0 then
  489. begin
  490. MaxLen:=Length(source)-Length(SubStr);
  491. i:=0;
  492. while (i<=MaxLen) do
  493. begin
  494. inc(i);
  495. j:=0;
  496. k:=i-1;
  497. while (j<SubstrLen) and
  498. (AnsistringClass(SubStr).fdata[j]=AnsistringClass(Source).fdata[k]) do
  499. begin
  500. inc(j);
  501. inc(k);
  502. end;
  503. if (j=SubstrLen) then
  504. begin
  505. Pos:=i;
  506. exit;
  507. end;
  508. end;
  509. end;
  510. end;
  511. { Faster version for a char alone. Must be implemented because }
  512. { pos(c: char; const s: shortstring) also exists, so otherwise }
  513. { using pos(char,pchar) will always call the shortstring version }
  514. { (exact match for first argument), also with $h+ (JM) }
  515. Function Pos (c : AnsiChar; Const s : AnsiString) : SizeInt;
  516. var
  517. i: SizeInt;
  518. begin
  519. for i:=1 to length(s) do
  520. begin
  521. if AnsistringClass(s).fdata[i-1]=c then
  522. begin
  523. pos:=i;
  524. exit;
  525. end;
  526. end;
  527. pos:=0;
  528. end;
  529. (*
  530. {$ifndef FPUNONE}
  531. Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_ANSISTR']; compilerproc;
  532. Var
  533. SS : String;
  534. begin
  535. fpc_Val_Real_AnsiStr := 0;
  536. if length(S) > 255 then
  537. code := 256
  538. else
  539. begin
  540. SS := S;
  541. Val(SS,fpc_Val_Real_AnsiStr,code);
  542. end;
  543. end;
  544. {$endif}
  545. Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; [public, alias:'FPC_VAL_CURRENCY_ANSISTR']; compilerproc;
  546. Var
  547. SS : String;
  548. begin
  549. if length(S) > 255 then
  550. begin
  551. fpc_Val_Currency_AnsiStr := 0;
  552. code := 256;
  553. end
  554. else
  555. begin
  556. SS := S;
  557. Val(SS,fpc_Val_Currency_AnsiStr,code);
  558. end;
  559. end;
  560. Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; out Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_ANSISTR']; compilerproc;
  561. Var
  562. SS : ShortString;
  563. begin
  564. fpc_Val_UInt_AnsiStr := 0;
  565. if length(S) > 255 then
  566. code := 256
  567. else
  568. begin
  569. SS := S;
  570. Val(SS,fpc_Val_UInt_AnsiStr,code);
  571. end;
  572. end;
  573. Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; out Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_ANSISTR']; compilerproc;
  574. Var
  575. SS : ShortString;
  576. begin
  577. fpc_Val_SInt_AnsiStr:=0;
  578. if length(S)>255 then
  579. code:=256
  580. else
  581. begin
  582. SS := S;
  583. fpc_Val_SInt_AnsiStr := int_Val_SInt_ShortStr(DestSize,SS,Code);
  584. end;
  585. end;
  586. {$ifndef CPU64}
  587. Function fpc_Val_qword_AnsiStr (Const S : AnsiString; out Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_ANSISTR']; compilerproc;
  588. Var
  589. SS : ShortString;
  590. begin
  591. fpc_Val_qword_AnsiStr:=0;
  592. if length(S)>255 then
  593. code:=256
  594. else
  595. begin
  596. SS := S;
  597. Val(SS,fpc_Val_qword_AnsiStr,Code);
  598. end;
  599. end;
  600. Function fpc_Val_int64_AnsiStr (Const S : AnsiString; out Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_ANSISTR']; compilerproc;
  601. Var
  602. SS : ShortString;
  603. begin
  604. fpc_Val_int64_AnsiStr:=0;
  605. if length(S)>255 then
  606. code:=256
  607. else
  608. begin
  609. SS := s;
  610. Val(SS,fpc_Val_int64_AnsiStr,Code);
  611. end;
  612. end;
  613. {$endif CPU64}
  614. {$ifndef FPUNONE}
  615. procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
  616. var
  617. ss: ShortString;
  618. begin
  619. str_real(len,fr,d,treal_type(rt),ss);
  620. s:=ss;
  621. end;
  622. {$endif}
  623. procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:ansistring);[public,alias:'FPC_ANSISTR_ENUM'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
  624. var ss:shortstring;
  625. begin
  626. fpc_shortstr_enum(ordinal,len,typinfo,ord2strindex,ss);
  627. s:=ss;
  628. end;
  629. procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring);[public,alias:'FPC_ANSISTR_BOOL'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
  630. var
  631. ss:shortstring;
  632. begin
  633. fpc_shortstr_bool(b,len,ss);
  634. s:=ss;
  635. end;
  636. function fpc_val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; [public, alias:'FPC_VAL_ENUM_ANSISTR']; compilerproc;
  637. begin
  638. fpc_val_enum_ansistr:=fpc_val_enum_shortstr(str2ordindex,s,code);
  639. end;
  640. {$ifdef FPC_HAS_STR_CURRENCY}
  641. procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring);[public,alias:'FPC_ANSISTR_CURRENCY']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
  642. var
  643. ss: ShortString;
  644. begin
  645. str(c:len:fr,ss);
  646. s:=ss;
  647. end;
  648. {$endif FPC_HAS_STR_CURRENCY}
  649. Procedure fpc_AnsiStr_UInt(v : ValUInt;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALUINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
  650. Var
  651. SS : ShortString;
  652. begin
  653. str(v:Len,SS);
  654. S:=SS;
  655. end;
  656. Procedure fpc_AnsiStr_SInt(v : ValSInt;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALSINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
  657. Var
  658. SS : ShortString;
  659. begin
  660. str (v:Len,SS);
  661. S:=SS;
  662. end;
  663. {$ifndef CPU64}
  664. Procedure fpc_AnsiStr_QWord(v : QWord;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_QWORD']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
  665. Var
  666. SS : ShortString;
  667. begin
  668. str(v:Len,SS);
  669. S:=SS;
  670. end;
  671. Procedure fpc_AnsiStr_Int64(v : Int64; Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_INT64']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
  672. Var
  673. SS : ShortString;
  674. begin
  675. str (v:Len,SS);
  676. S:=SS;
  677. end;
  678. {$endif CPU64}
  679. Procedure Delete (Var S : AnsiString; Index,Size: SizeInt);
  680. Var
  681. LS : SizeInt;
  682. begin
  683. ls:=Length(S);
  684. If (Index>LS) or (Index<=0) or (Size<=0) then
  685. exit;
  686. UniqueString (S);
  687. If (Size>LS-Index) then // Size+Index gives overflow ??
  688. Size:=LS-Index+1;
  689. If (Size<=LS-Index) then
  690. begin
  691. Dec(Index);
  692. Move(PByte(Pointer(S))[Index+Size],PByte(Pointer(S))[Index],LS-Index-Size+1);
  693. end;
  694. Setlength(S,LS-Size);
  695. end;
  696. Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : SizeInt);
  697. var
  698. Temp : AnsiString;
  699. LS : SizeInt;
  700. begin
  701. If Length(Source)=0 then
  702. exit;
  703. if index <= 0 then
  704. index := 1;
  705. Ls:=Length(S);
  706. if index > LS then
  707. index := LS+1;
  708. Dec(Index);
  709. Pointer(Temp) := NewAnsiString(Length(Source)+LS);
  710. SetLength(Temp,Length(Source)+LS);
  711. If Index>0 then
  712. move (Pointer(S)^,Pointer(Temp)^,Index);
  713. Move (Pointer(Source)^,PByte(Temp)[Index],Length(Source));
  714. If (LS-Index)>0 then
  715. Move(PByte(Pointer(S))[Index],PByte(temp)[Length(Source)+index],LS-Index);
  716. S:=Temp;
  717. end;
  718. Function StringOfChar(c : char;l : SizeInt) : AnsiString;
  719. begin
  720. SetLength(StringOfChar,l);
  721. FillChar(Pointer(StringOfChar)^,Length(StringOfChar),c);
  722. end;
  723. Procedure SetString (Out S : AnsiString; Buf : PChar; Len : SizeInt); {$IFNDEF VER2_0} Inline; {$ENDIF}
  724. begin
  725. SetLength(S,Len);
  726. If (Buf<>Nil) then
  727. Move (Buf^,Pointer(S)^,Len);
  728. end;
  729. Procedure SetString (Out S : AnsiString; Buf : PWideChar; Len : SizeInt);
  730. begin
  731. if (Buf<>nil) and (Len>0) then
  732. widestringmanager.Wide2AnsiMoveProc(Buf,S,Len)
  733. else
  734. SetLength(S, Len);
  735. end;
  736. *)
  737. function upcase(const s : ansistring) : ansistring;
  738. var
  739. u : unicodestring;
  740. begin
  741. u:=s;
  742. result:=upcase(u);
  743. end;
  744. function lowercase(const s : ansistring) : ansistring;
  745. var
  746. u : unicodestring;
  747. begin
  748. u:=s;
  749. result:=lowercase(u);
  750. end;