development/compilers/freepascal/rtl/inc/file.inc

   1 {
   2     $Id$
   3     This file is part of the Free Pascal Run time library.
   4     Copyright (c) 1999-2000 by the Free Pascal development team
   5
   6     See the file COPYING.FPC, included in this distribution,
   7     for details about the copyright.
   8
   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.
  12
  13  **********************************************************************}
  14
  15 {****************************************************************************
  16                     subroutines For UnTyped File handling
  17 ****************************************************************************}
  18
  19 type
  20   UnTypedFile=File;
  21
  22 Procedure Assign(var f:File;const Name:string);
  23 {
  24   Assign Name to file f so it can be used with the file routines
  25 }
  26 Begin
  27   FillChar(f,SizeOf(FileRec),0);
  28   FileRec(f).Handle:=UnusedHandle;
  29   FileRec(f).mode:=fmClosed;
  30   Move(Name[1],FileRec(f).Name,Length(Name));
  31 End;
  32
  33
  34 Procedure assign(var f:File;p:pchar);
  35 {
  36   Assign Name to file f so it can be used with the file routines
  37 }
  38 begin
  39   Assign(f,StrPas(p));
  40 end;
  41
  42
  43 Procedure assign(var f:File;c:char);
  44 {
  45   Assign Name to file f so it can be used with the file routines
  46 }
  47 begin
  48   Assign(f,string(c));
  49 end;
  50
  51
  52 Procedure Rewrite(var f:File;l:Longint);[IOCheck];
  53 {
  54   Create file f with recordsize of l
  55 }
  56 Begin
  57   If InOutRes <> 0 then
  58    exit;
  59   Case FileRec(f).mode Of
  60    fmInOut,fmInput,fmOutput : Close(f);
  61    fmClosed : ;
  62   else
  63    Begin
  64      InOutRes:=102;
  65      exit;
  66    End;
  67   End;
  68   If l=0 Then
  69    InOutRes:=2
  70   else
  71    Begin
  72      { Reopen with filemode 2, to be Tp compatible (PFV) }
  73      Do_Open(f,PChar(@FileRec(f).Name),$1002);
  74      FileRec(f).RecSize:=l;
  75    End;
  76 End;
  77
  78
  79 Procedure Reset(var f:File;l:Longint);[IOCheck];
  80 {
  81   Open file f with recordsize of l and filemode
  82 }
  83 Begin
  84   If InOutRes <> 0 then
  85    Exit;
  86   Case FileRec(f).mode Of
  87    fmInOut,fmInput,fmOutput : Close(f);
  88    fmClosed : ;
  89   else
  90    Begin
  91      InOutRes:=102;
  92      exit;
  93    End;
  94   End;
  95   If l=0 Then
  96    InOutRes:=2
  97   else
  98    Begin
  99      Do_Open(f,PChar(@FileRec(f).Name),Filemode);
 100      FileRec(f).RecSize:=l;
 101    End;
 102 End;
 103
 104
 105 Procedure Rewrite(Var f:File);[IOCheck];
 106 {
 107   Create file with (default) 128 byte records
 108 }
 109 Begin
 110   If InOutRes <> 0 then
 111    exit;
 112   Rewrite(f,128);
 113 End;
 114
 115
 116 Procedure Reset(Var f:File);[IOCheck];
 117 {
 118   Open file with (default) 128 byte records
 119 }
 120 Begin
 121   If InOutRes <> 0 then
 122    exit;
 123   Reset(f,128);
 124 End;
 125
 126
 127 Procedure BlockWrite(Var f:File;Var Buf;Count:Longint;var Result:Longint);[IOCheck];
 128 {
 129   Write Count records from Buf to file f, return written records in result
 130 }
 131 Begin
 132   Result:=0;
 133   If InOutRes <> 0 then
 134    exit;
 135   case FileRec(f).Mode of
 136     fmInOut,fmOutput :
 137       Result:=Do_Write(FileRec(f).Handle,Longint(@Buf),Count*FileRec(f).RecSize)
 138         div FileRec(f).RecSize;
 139     fmInPut: inOutRes := 105;
 140     else InOutRes:=103;
 141   end;
 142 End;
 143
 144
 145 Procedure BlockWrite(Var f:File;Var Buf;Count:Word;var Result:Word);[IOCheck];
 146 {
 147   Write Count records from Buf to file f, return written records in Result
 148 }
 149 var
 150   l : longint;
 151 Begin
 152   BlockWrite(f,Buf,Count,l);
 153   Result:=l;
 154 End;
 155
 156
 157 Procedure BlockWrite(Var f:File;Var Buf;Count:Word;var Result:Integer);[IOCheck];
 158 {
 159   Write Count records from Buf to file f, return written records in Result
 160 }
 161 var
 162   l : longint;
 163 Begin
 164   BlockWrite(f,Buf,Count,l);
 165   Result:=l;
 166 End;
 167
 168
 169 Procedure BlockWrite(Var f:File;Var Buf;Count:Longint);[IOCheck];
 170 {
 171   Write Count records from Buf to file f, if none a Read and Count>0 then
 172   InOutRes is set
 173 }
 174 var
 175   Result : Longint;
 176 Begin
 177   BlockWrite(f,Buf,Count,Result);
 178   If (Result<Count) and (Count>0) Then
 179    InOutRes:=101;
 180 End;
 181
 182
 183 Procedure BlockRead(var f:File;var Buf;Count:Longint;var Result:Longint);[IOCheck];
 184 {
 185   Read Count records from file f ro Buf, return number of read records in
 186   Result
 187 }
 188 Begin
 189   Result:=0;
 190   If InOutRes <> 0 then
 191    exit;
 192   case FileRec(f).Mode of
 193     fmInOut,fmInput :
 194       Result:=Do_Read(FileRec(f).Handle,Longint(@Buf),count*FileRec(f).RecSize)
 195         div FileRec(f).RecSize;
 196     fmOutput: inOutRes := 104;
 197     else InOutRes:=103;
 198   end;
 199 End;
 200
 201
 202 Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Word);[IOCheck];
 203 {
 204   Read Count records from file f to Buf, return number of read records in
 205   Result
 206 }
 207 var
 208   l : longint;
 209 Begin
 210   BlockRead(f,Buf,Count,l);
 211   Result:=l;
 212 End;
 213
 214
 215 Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Integer);[IOCheck];
 216 {
 217   Read Count records from file f to Buf, return number of read records in
 218   Result
 219 }
 220 var
 221   l : longint;
 222 Begin
 223   BlockRead(f,Buf,Count,l);
 224   Result:=l;
 225 End;
 226
 227
 228 Procedure BlockRead(Var f:File;Var Buf;Count:Longint);[IOCheck];
 229 {
 230   Read Count records from file f to Buf, if none are read and Count>0 then
 231   InOutRes is set
 232 }
 233 var
 234   Result : Longint;
 235 Begin
 236   BlockRead(f,Buf,Count,Result);
 237   If (Result<Count) and (Count>0) Then
 238    InOutRes:=100;
 239 End;
 240
 241
 242 Function FilePos(var f:File):Longint;[IOCheck];
 243 {
 244   Return current Position In file f in records
 245 }
 246 Begin
 247   FilePos:=0;
 248   If InOutRes <> 0 then
 249    exit;
 250   case FileRec(f).Mode of
 251     fmInOut,fmInput,fmOutput :
 252       FilePos:=Do_FilePos(FileRec(f).Handle) div FileRec(f).RecSize;
 253     else
 254       InOutRes:=103;
 255   end;
 256 End;
 257
 258
 259 Function FileSize(var f:File):Longint;[IOCheck];
 260 {
 261   Return the size of file f in records
 262 }
 263 Begin
 264   FileSize:=0;
 265   If InOutRes <> 0 then
 266    exit;
 267   case FileRec(f).Mode of
 268     fmInOut,fmInput,fmOutput :
 269       begin
 270         if (FileRec(f).RecSize>0) then
 271           FileSize:=Do_FileSize(FileRec(f).Handle) div FileRec(f).RecSize;
 272       end;
 273     else InOutRes:=103;
 274   end;
 275 End;
 276
 277
 278 Function Eof(var f:File):Boolean;[IOCheck];
 279 {
 280   Return True if we're at the end of the file f, else False is returned
 281 }
 282 Begin
 283   Eof:=false;
 284   If InOutRes <> 0 then
 285    exit;
 286   case FileRec(f).Mode of
 287     {Can't use do_ routines because we need record support}
 288     fmInOut,fmInput,fmOutput : Eof:=(FileSize(f)<=FilePos(f));
 289     else InOutRes:=103;
 290   end;
 291 End;
 292
 293
 294 Procedure Seek(var f:File;Pos:Longint);[IOCheck];
 295 {
 296   Goto record Pos in file f
 297 }
 298 Begin
 299   If InOutRes <> 0 then
 300    exit;
 301   case FileRec(f).Mode of
 302     fmInOut,fmInput,fmOutput :
 303       Do_Seek(FileRec(f).Handle,Pos*FileRec(f).RecSize);
 304     else InOutRes:=103;
 305   end;
 306 End;
 307
 308
 309 Procedure Truncate(Var f:File);[IOCheck];
 310 {
 311   Truncate/Cut file f at the current record Position
 312 }
 313 Begin
 314   If InOutRes <> 0 then
 315    exit;
 316   case FileRec(f).Mode of
 317     fmInOut,fmOutput :
 318       Do_Truncate(FileRec(f).Handle,FilePos(f)*FileRec(f).RecSize);
 319     else InOutRes:=103;
 320   end;
 321 End;
 322
 323
 324 Procedure Close(var f:File);[IOCheck];
 325 {
 326   Close file f
 327 }
 328 Begin
 329   If InOutRes <> 0 then
 330    exit;
 331   case FileRec(f).Mode of
 332     fmInOut,fmInput,fmOutput :
 333       begin
 334         Do_Close(FileRec(f).Handle);
 335         FileRec(f).mode:=fmClosed;
 336       end
 337     else InOutRes:=103;
 338   end;
 339 End;
 340
 341
 342 Procedure Erase(var f : File);[IOCheck];
 343 Begin
 344   If InOutRes <> 0 then
 345    exit;
 346   If FileRec(f).mode=fmClosed Then
 347    Do_Erase(PChar(@FileRec(f).Name));
 348 End;
 349
 350
 351 Procedure Rename(var f : File;p:pchar);[IOCheck];
 352 Begin
 353   If InOutRes <> 0 then
 354    exit;
 355   If FileRec(f).mode=fmClosed Then
 356    Begin
 357      Do_Rename(PChar(@FileRec(f).Name),p);
 358      Move(p^,FileRec(f).Name,StrLen(p)+1);
 359    End;
 360 End;
 361
 362
 363 Procedure Rename(var f : File;const s : string);[IOCheck];
 364 var
 365   p : array[0..255] Of Char;
 366 Begin
 367   If InOutRes <> 0 then
 368    exit;
 369   Move(s[1],p,Length(s));
 370   p[Length(s)]:=#0;
 371   Rename(f,Pchar(@p));
 372 End;
 373
 374
 375 Procedure Rename(var f : File;c : char);[IOCheck];
 376 var
 377   p : array[0..1] Of Char;
 378 Begin
 379   If InOutRes <> 0 then
 380    exit;
 381   p[0]:=c;
 382   p[1]:=#0;
 383   Rename(f,Pchar(@p));
 384 End;
 385
 386 {
 387   $Log$
 388   Revision 1.1  2002/02/19 08:25:20  sasu
 389   Initial revision
 390
 391   Revision 1.1  2000/07/13 06:30:44  michael
 392   + Initial import
 393
 394   Revision 1.20  2000/03/24 10:26:18  jonas
 395     * changed a lot of "if fm.mode = fmClosed then" to case statements,
 396       because if f is not yet initialized, the mode is invalid and can
 397       contain another value even though the file is closed
 398     + check if a file is open in writeln_end (caused crash if used on
 399       not opened files)
 400
 401   Revision 1.19  2000/02/09 16:59:29  peter
 402     * truncated log
 403
 404   Revision 1.18  2000/01/17 20:02:30  peter
 405     * open with mode 2 in rewrite
 406
 407   Revision 1.17  2000/01/16 22:25:38  peter
 408     * check handle for file closing
 409
 410   Revision 1.16  2000/01/07 16:41:33  daniel
 411     * copyright 2000
 412
 413   Revision 1.15  2000/01/07 16:32:24  daniel
 414     * copyright 2000 added
 415
 416   Revision 1.14  1999/10/28 09:52:50  peter
 417     * use filemode for rewrite instead of mode 1
 418
 419   Revision 1.13  1999/09/10 15:40:33  peter
 420     * fixed do_open flags to be > $100, becuase filemode can be upto 255
 421
 422   Revision 1.12  1999/09/08 16:12:24  peter
 423     * fixed inoutres for diskfull
 424
 425   Revision 1.11  1999/09/07 15:54:18  hajny
 426     * fixed problem with Close under OS/2
 427
 428 }