astrings.inc 20 KB

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