tdisk.pp 1.9 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071
  1. { %INTERACTIVE }
  2. { this one is interactive because
  3. on removable drives it will generate
  4. alert boxes on some OS like windows }
  5. {******************************************}
  6. { Used to check the DOS unit }
  7. {------------------------------------------}
  8. { DiskFree / DiskSize routine testing }
  9. {******************************************}
  10. uses dos;
  11. const
  12. has_errors : boolean = false;
  13. { verifies that the DOSError variable is equal to }
  14. { the value requested. }
  15. Procedure CheckDosError(err: Integer);
  16. var
  17. x : integer;
  18. s :string;
  19. Begin
  20. Write('Verifying value of DOS Error...');
  21. x := DosError;
  22. case x of
  23. 0 : s := '(0): No Error.';
  24. 2 : s := '(2): File not found.';
  25. 3 : s := '(3): Path not found.';
  26. 5 : s := '(5): Access Denied.';
  27. 6 : s := '(6): Invalid File Handle.';
  28. 8 : s := '(8): Not enough memory.';
  29. 10 : s := '(10) : Invalid Environment.';
  30. 11 : s := '(11) : Invalid format.';
  31. 18 : s := '(18) : No more files.';
  32. else
  33. s := 'INVALID DOSERROR';
  34. end;
  35. if err <> x then
  36. Begin
  37. WriteLn('FAILURE. (Value should be ',err,' '+s+')');
  38. has_errors:=true;
  39. end
  40. else
  41. WriteLn('Success.');
  42. end;
  43. Procedure TestdiskSize;
  44. Var
  45. i : Integer;
  46. Begin
  47. WriteLn('----------------------------------------------------------------------');
  48. WriteLn(' DISKSIZE/DISKFREE ');
  49. WriteLn('----------------------------------------------------------------------');
  50. WriteLn(' Note: Should return -1 on both functions if device is not ready. ');
  51. WriteLn('----------------------------------------------------------------------');
  52. CheckDosError(0);
  53. { Check Disksize / DiskFree routines }
  54. for I:=0 to 20 do
  55. Begin
  56. Write('Disk unit ',i:2,' free size : ',DiskFree(i):10, ' Total Size: ',DiskSize(i):10);
  57. WriteLn(' bytes.');
  58. end;
  59. CheckDosError(0);
  60. end;
  61. Begin
  62. TestDiskSize;
  63. if has_errors then
  64. Halt(1);
  65. end.