filectrl.pas 6.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
  1. {
  2. $Id$
  3. System independent low-level file interface
  4. Copyright (c) 1997 Balazs Scheidler ([email protected])
  5. This library is free software; you can redistribute it and/or
  6. modify it under the terms of the GNU Library General Public
  7. License as published by the Free Software Foundation; either
  8. version 2 of the License, or (at your option) any later version.
  9. This library 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 GNU
  12. Library General Public License for more details.
  13. You should have received a copy of the GNU Library General Public
  14. License along with this library; if not, write to the Free
  15. Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************}
  17. unit FileCtrl;
  18. interface
  19. {$I platform.inc}
  20. uses
  21. ApiComm, FileSys;
  22. { The following platforms are supported
  23. OS/2 either 1.x, or 2.x
  24. Linux
  25. DOS 16 bit, DPMI, Windows 3.1
  26. Win32
  27. }
  28. const
  29. { standard file handles under DOS, under linux only stdin, stdout and strerr
  30. is defined }
  31. stdin = 0;
  32. stdout = 1;
  33. stderr = 2;
  34. stdaux = 3;
  35. stdprn = 4;
  36. { file access constants }
  37. filRead = 0;
  38. filWrite = 1;
  39. filReadWrite = 2;
  40. { seek constants }
  41. skBeg = 0;
  42. skCur = 1;
  43. skEnd = 2;
  44. FilePerms: Word = $1A4; { rw-r--r-- }
  45. type
  46. {$IFDEF BIT_16}
  47. TFileHandle = Word;
  48. {$ELSE}
  49. TFileHandle = Longint;
  50. {$ENDIF}
  51. { System independent calls }
  52. { All of these functions do what their name imply, set ErrorCode (in Common)
  53. to the returned error. }
  54. { Under linux, I'll use FilePerms as permissions, instead of expecting an
  55. additional parameter }
  56. {$IFDEF PPC_Feature_Overriding}
  57. function OpenFile(FName: PChar; Flags: Longint): TFileHandle;
  58. function CreateFile(FName: PChar): TFileHandle;
  59. procedure DeleteFile(FName: PChar); { should be moved to FileSys }
  60. {$ENDIF}
  61. function OpenFileStr(FName: PChar; Flags: Longint): TFileHandle;
  62. function CreateFileStr(FName: PChar): TFileHandle;
  63. procedure DeleteFileStr(FName: PChar); { should be moved to FileSys }
  64. function OpenFile(FName: TFileName; Flags: Longint): TFileHandle;
  65. function CreateFile(FName: TFileName): TFileHandle;
  66. procedure DeleteFile(FName: TFileName);
  67. procedure CloseFile(Handle: TFileHandle);
  68. function SeekFile(Handle: TFileHandle; Pos: TFileInt; SeekType: Word): TFileInt;
  69. function ReadFile(Handle: TFileHandle; var Buff; Count: CPUWord): CPUWord;
  70. function WriteFile(Handle: TFileHandle; var Buff; Count: CPUWord): CPUWord;
  71. procedure FlushFile(Handle: TFileHandle);
  72. procedure TruncateFile(Handle: TFileHandle);
  73. function EndOfFile(Handle: TFileHandle): Boolean;
  74. function FilePos(Handle: TFileHandle): TFileInt;
  75. function FileSize(Handle: TFileHandle): TFileInt;
  76. procedure CopyFile(F1, F2: TFileHandle; Length: TFileInt);
  77. implementation
  78. { Include system dependent part }
  79. {$i filectrl.inc}
  80. function OpenFile(FName: TFileName; Flags: Longint): TFileHandle;
  81. begin
  82. FName := FName + #0;
  83. OpenFile := OpenFileStr(@FName[1], Flags);
  84. end;
  85. function CreateFile(FName: TFileName): TFileHandle;
  86. begin
  87. FName := FName+#0;
  88. CreateFile := CreateFileStr(@FName[1]);
  89. end;
  90. procedure DeleteFile(FName: TFileName);
  91. begin
  92. FName := FName + #0;
  93. DeleteFileStr(@FName[1]);
  94. end;
  95. {$IFDEF PPC_Feature_Overriding}
  96. function OpenFile(FName: PChar; Flags: Longint): TFileHandle;
  97. begin
  98. OpenFile := OpenFileStr(FName, Flags);
  99. end;
  100. function CreateFile(FName: PChar): TFileHandle;
  101. begin
  102. CreateFile := CreateFileStr(FName);
  103. end;
  104. procedure DeleteFile(FName: PChar);
  105. begin
  106. DeleteFileStr(FName);
  107. end;
  108. {$ENDIF}
  109. procedure CopyFile(F1, F2: TFileHandle; Length: TFileInt);
  110. var
  111. Buf: array [0..1023] of Byte;
  112. Len: Word;
  113. begin
  114. while (ErrorCode = 0) and (Length <> 0) do begin
  115. if Length < 1024 then Len := Length else Len := 1024;
  116. Len := ReadFile(F1, Buf, Len);
  117. WriteFile(F2, Buf, Len);
  118. Dec(Length, Len);
  119. end;
  120. end;
  121. end.
  122. {
  123. $Log$
  124. Revision 1.2 2000-12-17 20:40:25 hajny
  125. * OS/2 implementation corrected and finished
  126. Revision 1.1 2000/07/13 06:29:38 michael
  127. + Initial import
  128. Revision 1.2 2000/02/29 11:43:16 pierre
  129. Common renamed APIComm to avoid problems with free vision
  130. Revision 1.1 2000/01/06 01:20:31 peter
  131. * moved out of packages/ back to topdir
  132. Revision 1.1 1999/12/23 19:36:47 peter
  133. * place unitfiles in target dirs
  134. Revision 1.1 1999/11/24 23:36:37 peter
  135. * moved to packages dir
  136. Revision 1.3 1999/04/13 09:29:44 daniel
  137. * Reverted a terrible mistake
  138. Revision 1.1 1998/12/04 12:48:24 peter
  139. * moved some dirs
  140. Revision 1.6 1998/10/26 11:22:49 peter
  141. * updates
  142. Date Version Who Comments
  143. 07/06/97 0.1 bazsi Initial implementation
  144. many of the platforms implemented, but not
  145. tested at all
  146. 07/07/97 0.1.1 bazsi Some changes suggested by Marco Schmidt
  147. (TFileInt)
  148. Tested under Linux (FPC) and DOS (BP).
  149. 07/12/97 0.1.2 bazsi Converted to the new error-handling scheme,
  150. began adding error codes, but this will be
  151. changed (!)
  152. 07/18/97 0.2 bazsi Error codes moved to common
  153. 07/18/97 0.2.1 bazsi Corrected some syntactical errors (haven't
  154. checked before uploading...)
  155. 07/19/97 0.2.2 bazsi Overriden versions using Pascal style strings
  156. 07/19/97 0.3 bazsi EndOfFile, TruncateFile added, FlushFile
  157. implemented on Linux, DOS
  158. 07/28/97 0.3.1 bazsi Corrected some DOS 16 bit bugs (setting ErrorCode)
  159. 08/07/97 0.3.2 bazsi renamed to .PAS
  160. PChar versions are named xxxxStr, overriden
  161. versions are provided if PPC_Feature_Overriding is
  162. defined (the Str versions are provided in both cases)
  163. 08/24/97 0.3.3 bazsi FileSys added to uses clause
  164. 04/15/98 0.3.4 Michael Updated Linux implementation.
  165. 05/05/98 0.3.5 mkoeppe Fixed ReadFile, WriteFile return value in Linux.
  166. }