disk.inc 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225
  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. Disk functions from Delphi's sysutils.pas
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$IFDEF INT64}
  13. function DiskFree (Drive: byte): int64;
  14. var FI: TFSinfo;
  15. RC: longint;
  16. begin
  17. if (os_mode = osDOS) or (os_mode = osDPMI) then
  18. {Function 36 is not supported in OS/2.}
  19. asm
  20. movb 8(%ebp),%dl
  21. movb $0x36,%ah
  22. call syscall
  23. cmpw $-1,%ax
  24. je .LDISKFREE1
  25. mulw %cx
  26. mulw %bx
  27. shll $16,%edx
  28. movw %ax,%dx
  29. xchgl %edx,%eax
  30. leave
  31. ret
  32. .LDISKFREE1:
  33. cltd
  34. leave
  35. ret
  36. end
  37. else
  38. {In OS/2, we use the filesystem information.}
  39. begin
  40. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  41. if RC = 0 then
  42. DiskFree := int64 (FI.Free_Clusters) *
  43. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  44. else
  45. DiskFree := -1;
  46. end;
  47. end;
  48. function DiskSize (Drive: byte): int64;
  49. var FI: TFSinfo;
  50. RC: longint;
  51. begin
  52. if (os_mode = osDOS) or (os_mode = osDPMI) then
  53. {Function 36 is not supported in OS/2.}
  54. asm
  55. movb 8(%ebp),%dl
  56. movb $0x36,%ah
  57. call syscall
  58. movw %dx,%bx
  59. cmpw $-1,%ax
  60. je .LDISKSIZE1
  61. mulw %cx
  62. mulw %bx
  63. shll $16,%edx
  64. movw %ax,%dx
  65. xchgl %edx,%eax
  66. leave
  67. ret
  68. .LDISKSIZE1:
  69. cltd
  70. leave
  71. ret
  72. end
  73. else
  74. {In OS/2, we use the filesystem information.}
  75. begin
  76. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  77. if RC = 0 then
  78. DiskSize := int64 (FI.Total_Clusters) *
  79. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  80. else
  81. DiskSize := -1;
  82. end;
  83. end;
  84. {$ELSE}
  85. function DiskFree (Drive: byte): longint;
  86. var FI: TFSinfo;
  87. RC: longint;
  88. begin
  89. if (os_mode = osDOS) or (os_mode = osDPMI) then
  90. {Function 36 is not supported in OS/2.}
  91. asm
  92. movb 8(%ebp),%dl
  93. movb $0x36,%ah
  94. call syscall
  95. cmpw $-1,%ax
  96. je .LDISKFREE1
  97. mulw %cx
  98. mulw %bx
  99. shll $16,%edx
  100. movw %ax,%dx
  101. xchgl %edx,%eax
  102. leave
  103. ret
  104. .LDISKFREE1:
  105. cltd
  106. leave
  107. ret
  108. end
  109. else
  110. {In OS/2, we use the filesystem information.}
  111. begin
  112. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  113. if RC = 0 then
  114. DiskFree := FI.Free_Clusters *
  115. FI.Sectors_Per_Cluster * FI.Bytes_Per_Sector
  116. else
  117. DiskFree := -1;
  118. end;
  119. end;
  120. function DiskSize (Drive: byte): longint;
  121. var FI: TFSinfo;
  122. RC: longint;
  123. begin
  124. if (os_mode = osDOS) or (os_mode = osDPMI) then
  125. {Function 36 is not supported in OS/2.}
  126. asm
  127. movb 8(%ebp),%dl
  128. movb $0x36,%ah
  129. call syscall
  130. movw %dx,%bx
  131. cmpw $-1,%ax
  132. je .LDISKSIZE1
  133. mulw %cx
  134. mulw %bx
  135. shll $16,%edx
  136. movw %ax,%dx
  137. xchgl %edx,%eax
  138. leave
  139. ret
  140. .LDISKSIZE1:
  141. cltd
  142. leave
  143. ret
  144. end
  145. else
  146. {In OS/2, we use the filesystem information.}
  147. begin
  148. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  149. if RC = 0 then
  150. DiskSize := FI.Total_Clusters *
  151. FI.Sectors_Per_Cluster * FI.Bytes_Per_Sector
  152. else
  153. DiskSize := -1;
  154. end;
  155. end;
  156. {$ENDIF}
  157. function GetCurrentDir: string;
  158. begin
  159. GetDir (0, Result);
  160. end;
  161. function SetCurrentDir (const NewDir: string): boolean;
  162. begin
  163. {$I-}
  164. ChDir (NewDir);
  165. Result := (IOResult = 0);
  166. {$I+}
  167. end;
  168. function CreateDir (const NewDir: string): boolean;
  169. begin
  170. {$I-}
  171. MkDir (NewDir);
  172. Result := (IOResult = 0);
  173. {$I+}
  174. end;
  175. function RemoveDir (const Dir: string): boolean;
  176. begin
  177. {$I-}
  178. RmDir (Dir);
  179. Result := (IOResult = 0);
  180. {$I+}
  181. end;
  182. {
  183. $Log$
  184. Revision 1.5 2000-05-28 18:21:51 hajny
  185. + initial implementation
  186. Revision 1.4 2000/05/21 15:55:11 hajny
  187. * int64 result for Disk* functions
  188. Revision 1.3 2000/02/09 16:59:33 peter
  189. * truncated log
  190. Revision 1.2 2000/01/07 16:41:45 daniel
  191. * copyright 2000
  192. }