development/compilers/freepascal/rtl/objpas/syspch.inc

   1 {
   2     *********************************************************************
   3     $Id$
   4     Copyright (C) 1997, 1998 Gertjan Schouten
   5
   6     This program is free software; you can redistribute it and/or modify
   7     it under the terms of the GNU General Public License as published by
   8     the Free Software Foundation; either version 2 of the License, or
   9     (at your option) any later version.
  10
  11     This program is distributed in the hope that it will be useful,
  12     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14     GNU General Public License for more details.
  15
  16     You should have received a copy of the GNU General Public License
  17     along with this program; if not, write to the Free Software
  18     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19     *********************************************************************
  20
  21     System Utilities For Free Pascal
  22 }
  23
  24 {  PChar functions  }
  25
  26 type
  27    pbyte = ^byte;
  28    CharArray = array[0..0] of char;
  29
  30 { Processor dependent part, shared withs strings unit }
  31 {$i strings.inc }
  32
  33 { Processor independent part, shared with strings unit }
  34 {$i stringsi.inc }
  35
  36 {  StrPas converts a PChar to a pascal string  }
  37
  38 function StrPas(Str: PChar): string;
  39 begin
  40   SetLength(result, StrLen(Str));
  41   Move(Str^, result[1], Length(result));
  42 end ;
  43
  44 {  StrAlloc allocates a buffer of Size + 4
  45    the size of the allocated buffer is stored at result - 4
  46    StrDispose should be used to destroy the buffer  }
  47
  48 function StrAlloc(Size: cardinal): PChar;
  49 begin
  50   inc(size,sizeof(cardinal));
  51   getmem(result,size);
  52   cardinal(pointer(result)^):=size;
  53   inc(result,sizeof(cardinal));
  54 end;
  55
  56
  57 { Allocates a new string using StrAlloc, you need StrDispose to dispose the
  58   string }
  59
  60 function strnew(p : pchar) : pchar;
  61 var
  62   len : longint;
  63 begin
  64   strnew:=nil;
  65   if (p=nil) or (p^=#0) then
  66    exit;
  67   len:=strlen(p)+1;
  68   StrNew:=StrAlloc(Len);
  69   if strnew<>nil then
  70    strmove(strnew,p,len);
  71 end;
  72
  73
  74 {  StrPCopy copies the pascal string Source to Dest and returns Dest  }
  75
  76 function StrPCopy(Dest: PChar; Source: string): PChar;
  77 begin
  78   result := StrMove(Dest, PChar(Source), length(Source)+1);
  79 end ;
  80
  81 {  StrPLCopy copies MaxLen or less characters from the pascal string
  82    Source to Dest and returns Dest  }
  83
  84 function StrPLCopy(Dest: PChar; Source: string; MaxLen: cardinal): PChar;
  85 var Count: cardinal;
  86 begin
  87 result := Dest;
  88 if (Result <> Nil) and (MaxLen <> 0) then begin
  89    Count := Length(Source);
  90    if Count > MaxLen then
  91       Count := MaxLen;
  92    StrMove(Dest, PChar(Source), Count);
  93    CharArray(result^)[Count] := #0;  { terminate ! }
  94    end ;
  95 end ;
  96
  97
  98 {   StrDispose clears the memory allocated with StrAlloc   }
  99
 100 procedure StrDispose(Str: PChar);
 101 begin
 102   if (Str <> Nil) then
 103    begin
 104      dec(Str,sizeof(cardinal));
 105      Freemem(str,cardinal(pointer(str)^));
 106    end;
 107 end;
 108
 109 {  StrBufSize returns the amount of memory allocated for pchar Str allocated with StrAlloc  }
 110
 111 function StrBufSize(Str: PChar): cardinal;
 112 begin
 113   if Str <> Nil then
 114    result := cardinal(pointer(Str - SizeOf(cardinal))^)-sizeof(cardinal)
 115   else
 116    result := 0;
 117 end ;
 118
 119 {
 120   $Log$
 121   Revision 1.1  2002/02/19 08:25:45  sasu
 122   Initial revision
 123
 124   Revision 1.1  2000/07/13 06:31:01  michael
 125   + Initial import
 126
 127   Revision 1.9  2000/02/09 16:59:32  peter
 128     * truncated log
 129
 130   Revision 1.8  1999/12/10 15:02:12  peter
 131     * strnew is ofcourse also different between sysutils and strings, just
 132       like stralloc/strdispose.
 133
 134   Revision 1.7  1999/11/06 14:41:31  peter
 135     * truncated log
 136
 137   Revision 1.6  1999/08/24 13:14:50  peter
 138     * disposestr allocstr compatible with delphi
 139
 140 }