astrings.inc 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1993,97 by Michael Van Canneyt,
  5. member of the Free Pascal development team.
  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. { ---------------------------------------------------------------------
  13. This file implements AnsiStrings for FPC
  14. ---------------------------------------------------------------------}
  15. {
  16. This file contains the implementation of the LongString type,
  17. and all things that are needed for it.
  18. AnsiSTring is defined as a 'silent' pchar :
  19. a pchar that points to :
  20. @-12 : Longint for maximum size;
  21. @-8 : Longint for size;
  22. @-4 : Longint for reference count;
  23. @ : String + Terminating #0;
  24. Pchar(Ansistring) is a valid typecast.
  25. So AS[i] is converted to the address @AS+i-1.
  26. Constants should be assigned a reference count of -1
  27. Meaning that they can't be disposed of.
  28. }
  29. Function NewAnsiString (Len : Longint) : Pointer; forward;
  30. Procedure DisposeAnsiString (Var S : Pointer); forward;
  31. Procedure Decr_Ansi_Ref (Var S : Pointer); forward;
  32. Procedure Incr_Ansi_Ref (Var S : Pointer); forward;
  33. Procedure AssignAnsiString (Var S1 : Pointer; S2 : Pointer); forward;
  34. Function Ansi_String_Concat (S1,S2 : Pointer): Pointer; forward;
  35. Procedure Ansi_ShortString_Concat (Var S1: AnsiString; Var S2 : ShortString); forward;
  36. Procedure Ansi_To_ShortString (Var S1 : ShortString; S2 : Pointer; maxlen : longint); forward;
  37. Procedure Short_To_AnsiString (Var S1 : Pointer; Const S2 : ShortString); forward;
  38. Procedure Char_To_AnsiString(var S1 : Pointer; c : Char); forward;
  39. Function AnsiCompare (S1,S2 : Pointer): Longint; forward;
  40. Function AnsiCompare (var S1 : Pointer; Var S2 : ShortString): Longint; forward;
  41. Procedure SetCharAtIndex (Var S : AnsiString; Index : Longint; C : CHar); forward;
  42. Type
  43. TAnsiRec = Packed Record
  44. Maxlen, len, ref : Longint;
  45. First : Char;
  46. end;
  47. PAnsiRec = ^TAnsiRec;
  48. Const
  49. AnsiRecLen = SizeOf(TAnsiRec);
  50. FirstOff = SizeOf(TAnsiRec)-1;
  51. { ---------------------------------------------------------------------
  52. Internal functions, not in interface.
  53. ---------------------------------------------------------------------}
  54. Procedure DumpAnsiRec(S : Pointer);
  55. begin
  56. If S=Nil then
  57. Writeln ('String is nil')
  58. Else
  59. Begin
  60. With PAnsiRec(S-Firstoff)^ do
  61. begin
  62. Write ('(Maxlen: ',maxlen);
  63. Write (' Len:',len);
  64. Writeln (' Ref: ',ref,')');
  65. end;
  66. end;
  67. end;
  68. Function NewAnsiString(Len : Longint) : Pointer;
  69. {
  70. Allocate a new AnsiString on the heap.
  71. initialize it to zero length and reference count 1.
  72. }
  73. Var
  74. P : Pointer;
  75. begin
  76. GetMem(P,Len+AnsiRecLen);
  77. If P<>Nil then
  78. begin
  79. PAnsiRec(P)^.Maxlen:=Len; { Maximal length }
  80. PAnsiRec(P)^.Len:=0; { Initial length }
  81. PAnsiRec(P)^.Ref:=1; { Set reference count }
  82. PAnsiRec(P)^.First:=#0; { Terminating #0 }
  83. P:=P+FirstOff; { Points to string now }
  84. end;
  85. NewAnsiString:=P;
  86. end;
  87. Procedure DisposeAnsiString(Var S : Pointer);
  88. {
  89. Deallocates a AnsiString From the heap.
  90. }
  91. begin
  92. If S=Nil then exit;
  93. Dec (Longint(S),FirstOff);
  94. FreeMem (S,PAnsiRec(S)^.Maxlen+AnsiRecLen);
  95. S:=Nil;
  96. end;
  97. Procedure Decr_Ansi_Ref (Var S : Pointer);[Public,Alias:'FPC_ANSISTR_DECR_REF'];
  98. {
  99. Decreases the ReferenceCount of a non constant ansistring;
  100. If the reference count is zero, deallocate the string;
  101. }
  102. Type
  103. plongint = ^longint;
  104. Var
  105. l : plongint;
  106. Begin
  107. { Zero string }
  108. If S=Nil then exit;
  109. { check for constant strings ...}
  110. l:=@PANSIREC(S-FirstOff)^.Ref;
  111. If l^<0 then exit;
  112. Dec(l^);
  113. If l^=0 then
  114. { Ref count dropped to zero }
  115. DisposeAnsiString (S); { Remove...}
  116. end;
  117. Procedure Incr_Ansi_Ref (Var S : Pointer);[Public,Alias:'FPC_ANSISTR_INCR_REF'];
  118. Begin
  119. If S=Nil then
  120. exit;
  121. { Let's be paranoid : Constant string ??}
  122. If PAnsiRec(S-FirstOff)^.Ref<0 then exit;
  123. Inc(PAnsiRec(S-FirstOff)^.Ref);
  124. end;
  125. Procedure UniqueAnsiString (Var S : AnsiString); [Public,Alias : 'FPC_ANSISTR_UNIQUE'];
  126. {
  127. Make sure reference count of S is 1,
  128. using copy-on-write semantics.
  129. }
  130. Var
  131. SNew : Pointer;
  132. begin
  133. If Pointer(S)=Nil then
  134. exit;
  135. if PAnsiRec(Pointer(S)-Firstoff)^.Ref<>1 then
  136. begin
  137. SNew:=NewAnsiString (PAnsiRec(Pointer(S)-FirstOff)^.len);
  138. Move (Pointer(S)^,SNew^,PAnsiRec(Pointer(S)-FirstOff)^.len+1);
  139. PAnsiRec(SNew-FirstOff)^.len:=PAnsiRec(Pointer(S)-FirstOff)^.len;
  140. Decr_Ansi_Ref (Pointer(S)); { Thread safe }
  141. Pointer(S):=SNew;
  142. end;
  143. end;
  144. Procedure AssignAnsiString (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_ANSISTR_ASSIGN'];
  145. {
  146. Assigns S2 to S1 (S1:=S2), taking in account reference counts.
  147. }
  148. begin
  149. If S2<>nil then
  150. If PAnsiRec(S2-FirstOff)^.Ref>0 then
  151. Inc(PAnsiRec(S2-FirstOff)^.ref);
  152. { Decrease the reference count on the old S1 }
  153. Decr_Ansi_Ref (S1);
  154. { And finally, have S1 pointing to S2 (or its copy) }
  155. S1:=S2;
  156. end;
  157. function Ansi_String_Concat (S1,S2 : Pointer) : pointer;[Public, alias: 'FPC_ANSISTR_CONCAT'];
  158. {
  159. Concatenates 2 AnsiStrings : S1+S2.
  160. Result Goes to S3;
  161. }
  162. Var
  163. Size,Location : Longint;
  164. S3 : pointer;
  165. begin
  166. if (S1=Nil) then
  167. AssignAnsiString(S3,S2)
  168. else
  169. begin
  170. S3:=Nil;
  171. Size:=PAnsiRec(S2-FirstOff)^.Len;
  172. Location:=Length(AnsiString(S1));
  173. { Setlength takes case of uniqueness
  174. and allocated memory. We need to use length,
  175. to take into account possibility of S1=Nil }
  176. SetLength (AnsiString(S3),Size+Location);
  177. Move (S1^,S3^,PAnsiRec(S1-FirstOff)^.Len);
  178. Move (S2^,(S3+location)^,Size+1);
  179. end;
  180. Ansi_String_Concat:=S3;
  181. end;
  182. Procedure Ansi_ShortString_Concat (Var S1: AnsiString; Var S2 : ShortString);
  183. {
  184. Concatenates a Ansi with a short string; : S2 + S2
  185. }
  186. Var
  187. Size,Location : Longint;
  188. begin
  189. Size:=Length(S2);
  190. Location:=Length(S1);
  191. If Size=0 then exit;
  192. { Setlength takes case of uniqueness
  193. and alllocated memory. We need to use length,
  194. to take into account possibility of S1=Nil }
  195. SetLength (S1,Size+Length(S1));
  196. Move (S2[1],Pointer(Pointer(S1)+Location)^,Size);
  197. PByte( Pointer(S1)+length(S1) )^:=0; { Terminating Zero }
  198. end;
  199. Procedure Ansi_To_ShortString (Var S1 : ShortString;S2 : Pointer; Maxlen : Longint);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR'];
  200. {
  201. Converts a AnsiString to a ShortString;
  202. }
  203. Var
  204. Size : Longint;
  205. begin
  206. if S2=nil then
  207. S1:=''
  208. else
  209. begin
  210. Size:=PAnsiRec(S2-FirstOff)^.Len;
  211. If Size>maxlen then
  212. Size:=maxlen;
  213. Move (S2^,S1[1],Size);
  214. byte(S1[0]):=Size;
  215. end;
  216. end;
  217. Procedure Short_To_AnsiString (Var S1 : Pointer; Const S2 : ShortString);[Public, alias: 'FPC_SHORTSTR_TO_ANSISTR'];
  218. {
  219. Converts a ShortString to a AnsiString;
  220. }
  221. Var
  222. Size : Longint;
  223. begin
  224. Size:=Length(S2);
  225. Setlength (AnsiString(S1),Size);
  226. if Size>0 then
  227. begin
  228. Move (S2[1],Pointer(S1)^,Size);
  229. { Terminating Zero }
  230. PByte(Pointer(S1)+Size)^:=0;
  231. end;
  232. end;
  233. Procedure Char_To_AnsiString(var S1 : Pointer; c : Char);[Public, alias: 'FPC_CHAR_TO_ANSISTR'];
  234. {
  235. Converts a ShortString to a AnsiString;
  236. }
  237. begin
  238. Setlength (AnsiString(S1),1);
  239. PByte(Pointer(S1))^:=byte(c);
  240. { Terminating Zero }
  241. PByte(Pointer(S1)+1)^:=0;
  242. end;
  243. Procedure PChar2Ansi(var a : ansistring;p : pchar);[Public,Alias : 'FPC_PCHAR_TO_ANSISTR'];
  244. Var L : Longint;
  245. begin
  246. if p[0]=#0 Then
  247. Pointer(a):=nil
  248. else
  249. begin
  250. //!! Horribly inneficient, but I see no other way...
  251. L:=1;
  252. While P[l]<>#0 do inc (l);
  253. Pointer(a):=NewAnsistring(L);
  254. SetLength(A,L);
  255. Move (P[0],Pointer(A)^,L)
  256. end;
  257. end;
  258. { the compiler generates inline code for that
  259. Const
  260. EmptyChar : char = #0;
  261. Function Ansi2pchar (S : Pointer) : Pchar; [Alias : 'FPC_ANSISTR_TO_PCHAR'];
  262. begin
  263. If S<>Nil then
  264. Ansi2Pchar:=S
  265. else
  266. Ansi2Pchar:=@emptychar;
  267. end;
  268. }
  269. { stupid solution, could be done with public,name in later versions }
  270. {$ASMMODE DIRECT}
  271. procedure dummy;assembler;
  272. asm
  273. .globl FPC_EMPTYCHAR
  274. FPC_EMPTYCHAR:
  275. .byte 0
  276. end;
  277. {$ASMMODE ATT}
  278. Function AnsiCompare(S1,S2 : Pointer): Longint;[Public,Alias : 'FPC_ANSISTR_COMPARE'];
  279. {
  280. Compares 2 AnsiStrings;
  281. The result is
  282. <0 if S1<S2
  283. 0 if S1=S2
  284. >0 if S1>S2
  285. }
  286. Var
  287. i,MaxI,Temp : Longint;
  288. begin
  289. i:=0;
  290. Maxi:=Length(AnsiString(S1));
  291. temp:=Length(AnsiString(S2));
  292. If MaxI>Temp then
  293. MaxI:=Temp;
  294. Temp:=0;
  295. While (i<MaxI) and (Temp=0) do
  296. begin
  297. Temp:= PByte(S1+I)^ - PByte(S2+i)^;
  298. inc(i);
  299. end;
  300. if temp=0 then
  301. temp:=Length(AnsiString(S1))-Length(AnsiString(S2));
  302. AnsiCompare:=Temp;
  303. end;
  304. Function AnsiCompare (Var S1 : Pointer; Var S2 : ShortString): Longint;
  305. {
  306. Compares a AnsiString with a ShortString;
  307. The result is
  308. <0 if S1<S2
  309. 0 if S1=S2
  310. >0 if S1>S2
  311. }
  312. Var
  313. i,MaxI,Temp : Longint;
  314. begin
  315. Temp:=0;
  316. i:=0;
  317. MaxI:=Length(AnsiString(S1));
  318. if MaxI>byte(S2[0]) then MaxI:=Byte(S2[0]);
  319. While (i<MaxI) and (Temp=0) do
  320. begin
  321. Temp:= PByte(S1+I)^ - Byte(S2[i+1]);
  322. inc(i);
  323. end;
  324. AnsiCompare:=Temp;
  325. end;
  326. { Not used, can be removed. }
  327. Procedure SetCharAtIndex (Var S : AnsiString; Index : Longint; C : CHar);
  328. begin
  329. if Index<=Length(S) then
  330. begin
  331. UniqueAnsiString(S);
  332. Pbyte(Pointer(S)+index-1)^:=Byte(C);
  333. end;
  334. end;
  335. { ---------------------------------------------------------------------
  336. Public functions, In interface.
  337. ---------------------------------------------------------------------}
  338. Function Length (Const S : AnsiString) : Longint;
  339. {
  340. Returns the length of an AnsiString.
  341. Takes in acount that zero strings are NIL;
  342. }
  343. begin
  344. If Pointer(S)=Nil then
  345. Length:=0
  346. else
  347. Length:=PAnsiRec(Pointer(S)-FirstOff)^.Len;
  348. end;
  349. Procedure SetLength (Var S : AnsiString; l : Longint);
  350. {
  351. Sets The length of string S to L.
  352. Makes sure S is unique, and contains enough room.
  353. }
  354. Var
  355. Temp : Pointer;
  356. begin
  357. If (Pointer(S)=Nil) and (l>0) then
  358. begin
  359. { Need a complete new string...}
  360. Pointer(s):=NewAnsiString(l);
  361. PAnsiRec(Pointer(S)-FirstOff)^.Len:=l;
  362. PAnsiRec(Pointer(S)-FirstOff)^.MaxLen:=l;
  363. PByte (Pointer(S)+l)^:=0;
  364. end
  365. else if l>0 then
  366. begin
  367. If (PAnsiRec(Pointer(S)-FirstOff)^.Maxlen < L) or
  368. (PAnsiRec(Pointer(S)-FirstOff)^.Ref <> 1) then
  369. begin
  370. { Reallocation is needed... }
  371. Temp:=Pointer(NewAnsiString(L));
  372. if Length(S)>0 then
  373. Move (Pointer(S)^,Temp^,Length(S)+1);
  374. Decr_Ansi_ref (Pointer(S));
  375. Pointer(S):=Temp;
  376. end
  377. else
  378. //!! Force nil termination in case it gets shorter
  379. PByte(Pointer(S)+l)^:=0;
  380. PAnsiRec(Pointer(S)-FirstOff)^.Len:=l;
  381. end
  382. else
  383. { Length=0 }
  384. begin
  385. Decr_Ansi_Ref (Pointer(S));
  386. Pointer(S):=Nil;
  387. end;
  388. end;
  389. Function Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;
  390. var
  391. ResultAddress : Pointer;
  392. begin
  393. ResultAddress:=Nil;
  394. dec(index);
  395. { Check Size. Accounts for Zero-length S }
  396. if Length(S)<Index+Size then
  397. Size:=Length(S)-Index;
  398. If Size>0 then
  399. begin
  400. ResultAddress:=Pointer(NewAnsiString (Size));
  401. if ResultAddress<>Nil then
  402. begin
  403. Move (Pointer(Pointer(S)+index)^,ResultAddress^,Size);
  404. PAnsiRec(ResultAddress-FirstOff)^.Len:=Size;
  405. PByte(ResultAddress+Size)^:=0;
  406. end;
  407. end;
  408. Pointer(Copy):=ResultAddress;
  409. end;
  410. Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint;
  411. var i,j : longint;
  412. e : boolean;
  413. s,se : Pointer;
  414. begin
  415. i := 0;
  416. j := 0;
  417. e := true;
  418. if Length(SubStr)=0 then e := false;
  419. while (e) and (i <= length (Source) - length (substr)) do
  420. begin
  421. inc (i);
  422. S:=Pointer(copy(Source,i,length(Substr)));
  423. Se:=pointer(substr);
  424. if AnsiCompare(se,S)=0 then
  425. begin
  426. j := i;
  427. e := false;
  428. end;
  429. DisposeAnsiString(S);
  430. end;
  431. pos := j;
  432. end;
  433. Procedure Val (Const S : AnsiString; var R : real; Var Code : Integer);
  434. Var SS : String;
  435. begin
  436. Ansi_To_ShortString (SS,Pointer(S),255);
  437. Val(SS,R,Code);
  438. end;
  439. {
  440. Procedure Val (var S : AnsiString; var D : Double; Var Code : Integer);
  441. Var SS : ShortString;
  442. begin
  443. Ansi_To_ShortString (SS,S,255);
  444. Val(SS,D,Code);
  445. end;
  446. }
  447. Procedure Val (Const S : AnsiString; var E : Extended; Code : Integer);
  448. Var SS : ShortString;
  449. begin
  450. Ansi_To_ShortString (SS,Pointer(S),255);
  451. Val(SS,E,Code);
  452. end;
  453. Procedure Val (Const S : AnsiString; var C : Cardinal; Code : Integer);
  454. Var SS : ShortString;
  455. begin
  456. Ansi_To_ShortString (SS,Pointer(S),255);
  457. Val(SS,C,Code);
  458. end;
  459. Procedure Val (Const S : AnsiString; var L : Longint; Var Code : Integer);
  460. Var SS : ShortString;
  461. begin
  462. Ansi_To_ShortString (SS,Pointer(S),255);
  463. Val(SS,L,Code);
  464. end;
  465. Procedure Val (Const S : AnsiString; var W : Word; Var Code : Integer);
  466. Var SS : ShortString;
  467. begin
  468. Ansi_To_ShortString (SS,Pointer(S),255);
  469. Val(SS,W,Code);
  470. end;
  471. Procedure Val (Const S : AnsiString; var I : Integer; Var Code : Integer);
  472. Var SS : ShortString;
  473. begin
  474. Ansi_To_ShortString (SS,Pointer(S),255);
  475. Val(SS,I,Code);
  476. end;
  477. Procedure Val (Const S : AnsiString; var B : Byte; Var Code : Integer);
  478. Var SS : ShortString;
  479. begin
  480. Ansi_To_ShortString (SS,Pointer(S),255);
  481. Val(SS,B,Code);
  482. end;
  483. Procedure Val (Const S : AnsiString; var SI : ShortInt; Var Code : Integer);
  484. Var SS : ShortString;
  485. begin
  486. Ansi_To_ShortString (SS,Pointer(S),255);
  487. Val(SS,SI,Code);
  488. end;
  489. {!!!!!!!!!!!!
  490. We need ansistring str routines for the following types:
  491. FIXED16
  492. QWORD
  493. INT64
  494. }
  495. Procedure ACoStr (Co : Comp;Len,fr: Longint; Var S : AnsiString);
  496. [Public,Alias : 'FPC_STRANSI_COMP'];
  497. Var SS : ShortString;
  498. begin
  499. int_Str_comp (Co,Len,fr,SS);
  500. S:=SS;
  501. end;
  502. Procedure ASiStr (Si : Single;Len,fr: Longint; Var S : AnsiString);
  503. [Public,Alias : 'FPC_STRANSI_SINGLE'];
  504. Var SS : ShortString;
  505. begin
  506. int_Str_Single (Si,Len,fr,SS);
  507. S:=SS;
  508. end;
  509. Procedure AFiStr (fi : Comp;Len,fr: Longint; Var S : AnsiString);
  510. [Public,Alias : 'FPC_STRANSI_FIXED'];
  511. Var SS : ShortString;
  512. begin
  513. int_Str_Fixed (fi,Len,fr,SS);
  514. S:=SS;
  515. end;
  516. Procedure ARStr (D : Real;Len,fr: Longint; Var S : AnsiString);
  517. [Public,Alias : 'FPC_STRANSI_REAL'];
  518. Var SS : ShortString;
  519. begin
  520. int_Str_real (D,Len,fr,SS);
  521. S:=SS;
  522. end;
  523. Procedure AEStr (E : Extended;Len,Fr: Longint; Var S : AnsiString);
  524. [Public,Alias : 'FPC_STRANSI_EXTENDED'];
  525. Var SS : ShortString;
  526. begin
  527. int_Str_Extended (E,Len,fr,SS);
  528. S:=SS;
  529. end;
  530. Procedure ACStr (C : Cardinal;Len : Longint; Var S : AnsiString);
  531. [Public,Alias : 'FPC_STRANSI_CARDINAL'];
  532. Var SS : ShortString;
  533. begin
  534. int_str_cardinal(C,Len,SS);
  535. S:=SS;
  536. end;
  537. Procedure ALStr (L : Longint; Len : Longint; Var S : AnsiString);
  538. [Public,Alias : 'FPC_STRANSI_LONGINT'];
  539. Var SS : ShortString;
  540. begin
  541. int_Str_Longint (L,Len,SS);
  542. S:=SS;
  543. end;
  544. Procedure Delete (Var S : AnsiString; Index,Size: Longint);
  545. Var LS : Longint;
  546. begin
  547. If Length(S)=0 then exit;
  548. if index<=0 then
  549. begin
  550. Size:=Size+index-1;
  551. index:=1;
  552. end;
  553. LS:=PAnsiRec(Pointer(S)-FirstOff)^.Len;
  554. if (Index<=LS) and (Size>0) then
  555. begin
  556. UniqueAnsiString (S);
  557. if Size+Index>LS then
  558. Size:=LS-Index+1;
  559. if Index+Size<=LS then
  560. begin
  561. Dec(Index);
  562. Move(PByte(Pointer(S))[Index+Size],
  563. PByte(Pointer(S))[Index],LS-Index+1);
  564. end;
  565. Setlength(s,LS-Size);
  566. end;
  567. end;
  568. Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
  569. var Temp : AnsiString;
  570. LS : Longint;
  571. begin
  572. If Length(Source)=0 then exit;
  573. if index <= 0 then index := 1;
  574. Ls:=Length(S);
  575. if index > LS then index := LS+1;
  576. Dec(Index);
  577. Pointer(Temp) := NewAnsiString(Length(Source)+LS);
  578. SetLength(Temp,Length(Source)+LS);
  579. If Index>0 then
  580. move (Pointer(S)^,Pointer(Temp)^,Index);
  581. Move (Pointer(Source)^,PByte(Temp)[Index],Length(Source));
  582. If (LS-Index)>1 then
  583. Move(PByte(Pointer(S))[Index],PByte(temp)[Length(Source)+index],LS-Index);
  584. S:=Temp;
  585. end;
  586. {
  587. $Log$
  588. Revision 1.8 1999-01-06 14:48:43 michael
  589. + Implemented more str() functions
  590. Revision 1.7 1999/01/06 13:03:39 peter
  591. * fixed str() and made it working
  592. Revision 1.6 1999/01/06 12:25:02 florian
  593. * naming for str(...) routines inserted
  594. * don't know what in int64 changed
  595. Revision 1.5 1998/12/15 22:43:01 peter
  596. * removed temp symbols
  597. Revision 1.4 1998/11/18 10:56:46 michael
  598. + Fixed pchar2ansi
  599. Revision 1.3 1998/11/17 12:16:07 michael
  600. + Fixed copy. Now reference count is correct
  601. Revision 1.2 1998/11/17 11:33:22 peter
  602. + several checks for empty string
  603. Revision 1.1 1998/11/17 10:34:18 michael
  604. + renamed from astrings.pp to astrings.inc
  605. Revision 1.34 1998/11/17 00:41:11 peter
  606. * renamed string functions
  607. Revision 1.33 1998/11/16 15:42:04 peter
  608. + char2ansi
  609. Revision 1.32 1998/11/16 11:11:47 michael
  610. + Fix for Insert and Delete functions
  611. Revision 1.31 1998/11/13 14:37:11 michael
  612. + Insert procedure corrected
  613. Revision 1.30 1998/11/05 14:20:36 peter
  614. * removed warnings
  615. Revision 1.29 1998/11/04 20:34:04 michael
  616. + Removed ifdef useansistrings
  617. Revision 1.28 1998/11/04 15:39:44 michael
  618. + Small fixes to assign and add
  619. Revision 1.27 1998/11/04 10:20:48 peter
  620. * ansistring fixes
  621. Revision 1.26 1998/11/02 09:46:12 michael
  622. + Fix for assign of null string
  623. Revision 1.25 1998/10/30 21:42:48 michael
  624. Fixed assignment of NIL string.
  625. Revision 1.24 1998/10/22 11:32:23 michael
  626. + AssignAnsistring no longer copies constant ansistrings;
  627. + CompareAnsiString is now faster (1 call to length less)
  628. + UniqueAnsiString is fixed.
  629. Revision 1.23 1998/10/21 23:01:54 michael
  630. + Some more corrections
  631. Revision 1.22 1998/10/21 09:03:11 michael
  632. + more fixes so it compiles
  633. Revision 1.21 1998/10/21 08:56:58 michael
  634. + Fix so it compiles
  635. Revision 1.20 1998/10/21 08:38:46 florian
  636. * ansistringconcat fixed
  637. Revision 1.19 1998/10/20 12:46:11 florian
  638. * small fixes to ansicompare
  639. Revision 1.18 1998/09/28 14:02:34 michael
  640. + AnsiString changes
  641. Revision 1.17 1998/09/27 22:44:50 florian
  642. * small fixes
  643. * made UniqueAnsistring public
  644. * ...
  645. Revision 1.16 1998/09/20 17:49:08 florian
  646. * some ansistring fixes
  647. Revision 1.15 1998/09/19 08:33:17 florian
  648. * some internal procedures take now an pointer instead of a
  649. ansistring
  650. Revision 1.14 1998/09/14 10:48:14 peter
  651. * FPC_ names
  652. * Heap manager is now system independent
  653. Revision 1.13 1998/08/23 20:58:51 florian
  654. + rtti for objects and classes
  655. + TObject.GetClassName implemented
  656. Revision 1.12 1998/08/22 09:32:12 michael
  657. + minor fixes typos, and ansi2pchar
  658. Revision 1.11 1998/08/08 12:28:10 florian
  659. * a lot small fixes to the extended data type work
  660. Revision 1.10 1998/07/29 21:44:34 michael
  661. + Implemented reading/writing of ansistrings
  662. Revision 1.9 1998/07/20 23:36:56 michael
  663. changes for ansistrings
  664. Revision 1.8 1998/07/13 21:19:09 florian
  665. * some problems with ansi string support fixed
  666. Revision 1.7 1998/07/06 14:29:08 michael
  667. + Added Public,Alias directives for some calls
  668. Revision 1.6 1998/06/25 08:41:44 florian
  669. * better rtti
  670. Revision 1.5 1998/06/12 07:39:13 michael
  671. + Added aliases for Incr/Decr ref.
  672. Revision 1.4 1998/06/08 19:35:02 michael
  673. Some changes to integrate in system unit
  674. Revision 1.3 1998/06/08 12:38:22 michael
  675. Implemented rtti, inserted ansistrings again
  676. Revision 1.2 1998/05/12 10:42:44 peter
  677. * moved getopts to inc/, all supported OS's need argc,argv exported
  678. + strpas, strlen are now exported in the systemunit
  679. * removed logs
  680. * removed $ifdef ver_above
  681. }