syspch.inc 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136
  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. Result:=Str;
  31. end ;
  32. { StrAlloc allocates a buffer of Size + 4
  33. the size of the allocated buffer is stored at result - 4
  34. StrDispose should be used to destroy the buffer }
  35. function StrAlloc(Size: cardinal): PChar;
  36. begin
  37. inc(size,sizeof(cardinal));
  38. getmem(result,size);
  39. cardinal(pointer(result)^):=size;
  40. inc(result,sizeof(cardinal));
  41. end;
  42. { Allocates a new string using StrAlloc, you need StrDispose to dispose the
  43. string }
  44. function strnew(p : pchar) : pchar;
  45. var
  46. len : longint;
  47. begin
  48. strnew:=nil;
  49. if (p=nil) or (p^=#0) then
  50. exit;
  51. len:=strlen(p)+1;
  52. StrNew:=StrAlloc(Len);
  53. if strnew<>nil then
  54. strmove(strnew,p,len);
  55. end;
  56. { StrPCopy copies the pascal string Source to Dest and returns Dest }
  57. function StrPCopy(Dest: PChar; Source: string): PChar;
  58. begin
  59. result := StrMove(Dest, PChar(Source), length(Source)+1);
  60. end ;
  61. { StrPLCopy copies MaxLen or less characters from the pascal string
  62. Source to Dest and returns Dest }
  63. function StrPLCopy(Dest: PChar; Source: string; MaxLen: cardinal): PChar;
  64. var Count: cardinal;
  65. begin
  66. result := Dest;
  67. if (Result <> Nil) and (MaxLen <> 0) then begin
  68. Count := Length(Source);
  69. if Count > MaxLen then
  70. Count := MaxLen;
  71. StrMove(Dest, PChar(Source), Count);
  72. CharArray(result^)[Count] := #0; { terminate ! }
  73. end ;
  74. end ;
  75. { StrDispose clears the memory allocated with StrAlloc }
  76. procedure StrDispose(Str: PChar);
  77. begin
  78. if (Str <> Nil) then
  79. begin
  80. dec(Str,sizeof(cardinal));
  81. Freemem(str,cardinal(pointer(str)^));
  82. end;
  83. end;
  84. { StrBufSize returns the amount of memory allocated for pchar Str allocated with StrAlloc }
  85. function StrBufSize(Str: PChar): cardinal;
  86. begin
  87. if Str <> Nil then
  88. result := cardinal(pointer(Str - SizeOf(cardinal))^)-sizeof(cardinal)
  89. else
  90. result := 0;
  91. end ;
  92. {
  93. $Log$
  94. Revision 1.5 2002-08-01 16:53:14 jonas
  95. * fix for StrPas() by Sergey Korshunoff <[email protected]> (merged)
  96. Revision 1.4 2001/07/30 10:21:09 sg
  97. * Two moves with a string as target are now only exectuted if the number of
  98. bytes to move is greater than 0. This prevents RTE201's when compiled
  99. with range checks enabled.
  100. Revision 1.3 2000/11/23 11:04:26 sg
  101. * Protected some Move()'s by 'if' clauses so that the Move won't be
  102. executed when the length would be 0. Otherwise, the corresponding
  103. routines might get an RTE when compiled with $R+.
  104. Revision 1.2 2000/07/13 11:33:51 michael
  105. + removed logs
  106. }