disk.inc 5.0 KB

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