paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 08:09:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Implemented reading/writing of ansistrings

Browse Source
This commit is contained in:
michael 1998-07-29 21:44:34 +00:00
parent 9865eea0ef
commit 6827a17d38
2 changed files with 71 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
rtl/inc/astrings.pp
View File

@ -110,7 +110,7 @@ Procedure DisposeAnsiString (Var S : AnsiString);
Deallocates a AnsiString From the heap.
}
begin
Writeln ('In disposeAnsiSTring');
// Writeln ('In disposeAnsiSTring');
If Pointer(S)=Nil then exit;
Dec (Longint(S),FirstOff);
FreeMem (Pointer(S),PAnsiRec(Pointer(S))^.Maxlen+AnsiRecLen);
@ -129,18 +129,18 @@ Var l : plongint;
Begin
dumpansirec(s);
// dumpansirec(s);
If Pointer(S)=Nil then exit; { Zero string }
{ check for constant strings ...}
l:=Pointer(S)-FirstOff+8;
If l^<0 then exit;
l^:=l^-1;
dumpansirec(s);
// dumpansirec(s);
If l^=0 then
{ Ref count dropped to zero }
begin
Writeln ('CAlling disposestring');
// Writeln ('CAlling disposestring');
DisposeAnsiString (S); { Remove...}
end
end;
@ -336,13 +336,6 @@ end;
Procedure Write_Text_AnsiString (Len : Longint; T : TextRec; Var S : AnsiString);[Public, alias: 'WRITE_TEXT_ANSISTRING'];
{
Writes a AnsiString to the Text file T
}
begin
end;
Procedure SetCharAtIndex (Var S : AnsiString; Index : Longint; C : CHar);
begin
@ -397,7 +390,7 @@ begin
if Length(S)>0 then
Move (Pointer(S)^,Temp^,Length(S)+1);
Decr_Ansi_ref (S);
S:=AnsiString(Temp);
Pointer(S):=Temp;
end;
PAnsiRec(Pointer(S)-FirstOff)^.Len:=l
end
@ -683,7 +676,10 @@ end;
{
$Log$
Revision 1.9 1998-07-20 23:36:56 michael
Revision 1.10 1998-07-29 21:44:34 michael
+ Implemented reading/writing of ansistrings
Revision 1.9 1998/07/20 23:36:56 michael
changes for ansistrings
Revision 1.8 1998/07/13 21:19:09 florian

64
rtl/inc/text.inc
View File

@ -467,6 +467,22 @@ Begin
WriteBuffer(f,p^,PCharLen);
End;
{$ifdef UseAnsiStrings}
Procedure Write_Text_AnsiString (Len : Longint; Var T : TextRec; Var S : AnsiString);[Public, alias: 'WRITE_TEXT_ANSISTRING'];
{
Writes a AnsiString to the Text file T
}
Var Temp : Pointer;
begin
Temp:=Pointer(S);
If Temp=Nil then exit;
Write_pchar (Len,t,PChar(Temp));
end;
{$endif}
Procedure Write_LongInt(Len : Longint;var t : TextRec;l : Longint);[Public,Alias: 'WRITE_TEXT_LONGINT'];
var
@ -756,7 +772,7 @@ Begin
s[0]:=chr(sPos-1);
End;
{$ELSE}
Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : String);[Public,Alias: 'READ_TEXT_STRING'];
Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : String);[Public,Alias:'READ_TEXT_STRING'];
var
Temp,sPos,nrread : Word;
Begin
@ -884,6 +900,47 @@ Begin
p^:=#0;
End;
{$ifdef useansistrings}
Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : AnsiString);[Public,Alias: 'READ_TEXT_ANSISTRING'];
var
p : PChar;
Temp : byte;
len : Longint;
Begin
{ Delete the string }
Decr_ansi_ref (S);
// We assign room for 1024 characters totally at random....
Pointer(s):=Pointer(NewAnsiString(1024));
If InOutRes <> 0 then exit;
p:=pointer(s);
if not OpenInput(f) then
exit;
Temp:=f.BufPos;
while (f.BufPos<f.BufEnd) and (f.Bufptr^[Temp]<>#10) Do
Begin
{ search linefeed }
while (f.Bufptr^[Temp]<>#10) and (Temp<f.BufEnd) Do
inc(Temp);
{ copy string. }
Move (f.Bufptr^[f.BufPos],p^,Temp-f.BufPos);
Inc(Longint(p),Temp-f.BufPos);
Inc(len,Temp-f.bufpos);
If pchar(p-1)^=#13 Then
dec(p);
{ update f.BufPos }
f.BufPos:=Temp;
If Temp>=f.BufEnd Then
Begin
FileFunc(f.InOutFunc)(f);
Temp:=f.BufPos;
End
End;
p^:=#0;
PAnsiRec(Pointer(S)-FirstOff)^.Len:=len
End;
{$endif}
Procedure Read_Longint(var f : TextRec;var l : Longint);[Public,Alias: 'READ_TEXT_LONGINT'];
var
@ -1135,7 +1192,10 @@ end;
{
$Log$
Revision 1.17 1998-07-19 19:55:33 michael
Revision 1.18 1998-07-29 21:44:35 michael
+ Implemented reading/writing of ansistrings
Revision 1.17 1998/07/19 19:55:33 michael
+ fixed rename. Changed p to p^
Revision 1.16 1998/07/10 11:02:40 peter