home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / dr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  1.4 KB  |  66 lines
  1. {B+}
  2.  
  3. unit DR;
  4.  
  5. interface
  6. uses Crt, Def, FastWr, DrawSqar, CPaU, BeeU, ColorDef, GetKeU;
  7. procedure GetDrive;
  8. procedure PutDrive;
  9. procedure DriveSet;
  10.  
  11. implementation
  12.  
  13. procedure GetDrive;
  14. var Err:           integer;
  15. begin
  16. TempFileLine := 'Drive';
  17. assign(DriveFile,TempFileLine);  (* make empty slot in mode *)
  18. DataDrive := 'A:';
  19. {$I-}     reset(DriveFile);
  20. {$I+}     Err := ioresult;
  21. {$I-}     read(DriveFile,DataDrive);
  22. {$I+}     Err := ioresult;
  23. {$I-}     close(DriveFile);
  24. {$I+}     Err := ioresult;
  25. end;
  26.  
  27. procedure PutDrive;
  28. begin
  29. TempFileLine := 'Drive';
  30. assign(DriveFile,TempFileLine); rewrite(DriveFile);
  31. write(DriveFile,DataDrive);  close(DriveFile);
  32. end;
  33.  
  34. procedure DriveSet;
  35. var I,
  36.     X:             integer;
  37.     FunctionKey:   boolean;
  38.     Ch:            char;
  39. begin
  40. clrscr;
  41. DrawSquare( 1, 1, 80, 5, Msgs.Attr, true);
  42. GetDrive;
  43. FastWrite( CPad('Current Data Drive '+ DataDrive,78), 2, 2, Msgs.Attr);
  44. FastWrite( CPad('Type drive letter (A - E)',78), 3, 2, Msgs.Attr);
  45. FastWrite( CPad('Strike [ESC] to exit',78), 4, 2, Msgs.Attr);
  46. GetKey(Ch,FunctionKey);
  47. Ch := upcase(Ch);
  48. while ((Ch < 'A') or (Ch > 'G')) and (Ch <> #27) do
  49.     begin
  50.     Beep(1);
  51.     GetKey(Ch,FunctionKey);
  52.     Ch := upcase(Ch);
  53.     end;
  54. clrscr;
  55. I := ord(Ch);
  56. if I <> 27 then
  57.    if (I > 64) and (I < 91) then
  58.       begin
  59.       DataDrive := Ch+':';
  60.       PutDrive;
  61.       end;
  62. end;
  63.  
  64. end.
  65. 
  66.