syspch.inc 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130
  1. {
  2. *********************************************************************
  3. $Id$
  4. Copyright (C) 1997, 1998 Gertjan Schouten
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. *********************************************************************
  17. System Utilities For Free Pascal
  18. }
  19. { PChar functions }
  20. type
  21. pbyte = ^byte;
  22. CharArray = array[0..0] of char;
  23. { Processor dependent part, shared withs strings unit }
  24. {$i strings.inc }
  25. { Processor independent part, shared with strings unit }
  26. {$i stringsi.inc }
  27. { StrPas converts a PChar to a pascal string }
  28. function StrPas(Str: PChar): string;
  29. begin
  30. SetLength(result, StrLen(Str));
  31. if Length(Result) > 0 then
  32. Move(Str^, result[1], Length(result));
  33. end;
  34. { StrAlloc allocates a buffer of Size + 4
  35. the size of the allocated buffer is stored at result - 4
  36. StrDispose should be used to destroy the buffer }
  37. function StrAlloc(Size: cardinal): PChar;
  38. begin
  39. inc(size,sizeof(cardinal));
  40. getmem(result,size);
  41. cardinal(pointer(result)^):=size;
  42. inc(result,sizeof(cardinal));
  43. end;
  44. { Allocates a new string using StrAlloc, you need StrDispose to dispose the
  45. string }
  46. function strnew(p : pchar) : pchar;
  47. var
  48. len : longint;
  49. begin
  50. strnew:=nil;
  51. if (p=nil) or (p^=#0) then
  52. exit;
  53. len:=strlen(p)+1;
  54. StrNew:=StrAlloc(Len);
  55. if strnew<>nil then
  56. strmove(strnew,p,len);
  57. end;
  58. { StrPCopy copies the pascal string Source to Dest and returns Dest }
  59. function StrPCopy(Dest: PChar; Source: string): PChar;
  60. begin
  61. result := StrMove(Dest, PChar(Source), length(Source)+1);
  62. end ;
  63. { StrPLCopy copies MaxLen or less characters from the pascal string
  64. Source to Dest and returns Dest }
  65. function StrPLCopy(Dest: PChar; Source: string; MaxLen: cardinal): PChar;
  66. var Count: cardinal;
  67. begin
  68. result := Dest;
  69. if (Result <> Nil) and (MaxLen <> 0) then begin
  70. Count := Length(Source);
  71. if Count > MaxLen then
  72. Count := MaxLen;
  73. StrMove(Dest, PChar(Source), Count);
  74. CharArray(result^)[Count] := #0; { terminate ! }
  75. end ;
  76. end ;
  77. { StrDispose clears the memory allocated with StrAlloc }
  78. procedure StrDispose(Str: PChar);
  79. begin
  80. if (Str <> Nil) then
  81. begin
  82. dec(Str,sizeof(cardinal));
  83. Freemem(str,cardinal(pointer(str)^));
  84. end;
  85. end;
  86. { StrBufSize returns the amount of memory allocated for pchar Str allocated with StrAlloc }
  87. function StrBufSize(Str: PChar): cardinal;
  88. begin
  89. if Str <> Nil then
  90. result := cardinal(pointer(Str - SizeOf(cardinal))^)-sizeof(cardinal)
  91. else
  92. result := 0;
  93. end ;
  94. {
  95. $Log$
  96. Revision 1.3 2000-11-23 11:04:26 sg
  97. * Protected some Move()'s by 'if' clauses so that the Move won't be
  98. executed when the length would be 0. Otherwise, the corresponding
  99. routines might get an RTE when compiled with $R+.
  100. Revision 1.2 2000/07/13 11:33:51 michael
  101. + removed logs
  102. }