stringsi.inc 2.1 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999 by the Free Pascal development team
  5. Processor independent part for strings and sysutils units
  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. function strcat(dest,source : pchar) : pchar;
  13. begin
  14. strcopy(strend(dest),source);
  15. strcat:=dest;
  16. end;
  17. function strlcat(dest,source : pchar;l : longint) : pchar;
  18. var
  19. destend : pchar;
  20. begin
  21. destend:=strend(dest);
  22. dec(l,destend-dest);
  23. if l>0 then
  24. strlcopy(destend,source,l);
  25. strlcat:=dest;
  26. end;
  27. function strmove(dest,source : pchar;l : longint) : pchar;
  28. begin
  29. move(source^,dest^,l);
  30. strmove:=dest;
  31. end;
  32. function strpos(str1,str2 : pchar) : pchar;
  33. var
  34. p : pchar;
  35. lstr2 : longint;
  36. begin
  37. strpos:=nil;
  38. p:=strscan(str1,str2^);
  39. if p=nil then
  40. exit;
  41. lstr2:=strlen(str2);
  42. while p<>nil do
  43. begin
  44. if strlcomp(p,str2,lstr2)=0 then
  45. begin
  46. strpos:=p;
  47. exit;
  48. end;
  49. inc(longint(p));
  50. p:=strscan(p,str2^);
  51. end;
  52. end;
  53. function strnew(p : pchar) : pchar;
  54. var
  55. len : longint;
  56. begin
  57. strnew:=nil;
  58. if (p=nil) or (p^=#0) then
  59. exit;
  60. len:=strlen(p)+1;
  61. getmem(strnew,len);
  62. if strnew<>nil then
  63. strmove(strnew,p,len);
  64. end;
  65. {
  66. $Log$
  67. Revision 1.4 1999-09-13 11:42:42 peter
  68. * fixed strlcat
  69. Revision 1.3 1999/09/01 09:25:10 peter
  70. * fixed return of strcat,strlcat
  71. Revision 1.2 1999/02/25 10:05:07 michael
  72. + Added header and log
  73. }