home *** CD-ROM | disk | FTP | other *** search
/ Hacker Chronicles 2 / HACKER2.BIN / 147.FILESYST.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-17  |  17KB  |  426 lines
  1. (****************************************************************************)
  2. (***                                                                      ***)
  3. (***  FileIO saves, retrieves, or deletes files from disk. Data files     ***)
  4. (***  will be saved as follows:                                           ***)
  5. (***        1. Number of elements (= NumPoints).                          ***)
  6. (***        2. x, y                     (the time domain data point)      ***)
  7. (***        3. From 0 up to MaxInfo number of information lines.          ***)
  8. (***                                                                      ***)
  9. (***  Additionally, files may be "imported" from the Device Damage        ***)
  10. (***  Testing (DDT) programs. When imported, the DDT file is translated   ***)
  11. (***  to the format listed above. The operator is also given the option   ***)
  12. (***  of scaling the integer values of the DDT files to "true" values.    ***)
  13. (***                                                                      ***)
  14. (***  A directory may also be shown by giving a file mask. The file mask  ***)
  15. (***  is of the form [d:][path][filename][.ext]. Wildcards may be used.   ***)
  16. (***                                                                      ***)
  17. (****************************************************************************)
  18.  
  19. UNIT FileSystem;
  20.  
  21. INTERFACE
  22. USES
  23.    DOS,
  24. {$IFDEF DOSCrt}
  25.    DOSCrt,
  26. {$ELSE}
  27.    Crt,
  28. {$ENDIF}
  29.    Extended_Reals,
  30.    TextOps,
  31.    Global;
  32.  
  33.  
  34. PROCEDURE FileIO;
  35.  
  36.  
  37. (****************************************************************************)
  38.  
  39. IMPLEMENTATION
  40.  
  41. VAR
  42.    counter : INTEGER;       (* counter variables        *)
  43.    OKSave  : BOOLEAN;       (* overwrite old file?      *)
  44.    Name    : text;          (* file input/output stream *)
  45.    choice  : CHAR;
  46.  
  47. {----------------------------------------------------------------------------}
  48. {-                                                                          -}
  49. {-  Modify searches a filename for three conditions:                        -}
  50. {-      1. No filename given (length = 0);                                  -}
  51. {-      2. Drive name specified (e.g. a:);                                  -}
  52. {-      3. Full path name specified (e.g. \fft\sine.raw).                   -}
  53. {-  If none of these conditions is true, then the default data directory    -}
  54. {-  is added to the path of the filename (e.g. if the default data          -}
  55. {-  directory is 'c:\fft' and the filename is 'sine.raw', the resulting     -}
  56. {-  filename from Modify will be 'c:\fft\sine.raw'.)                        -}
  57. {-                                                                          -}
  58. {----------------------------------------------------------------------------}
  59.  
  60. PROCEDURE Modify (VAR filename : string);
  61.  
  62.    BEGIN   {Modify}
  63.       IF (length (filename) > 0) AND
  64.          (filename[2] <> ':')    AND
  65.          (filename[1] <> '\')
  66.          THEN filename:=DefaultDataDir+'\'+filename;
  67.    END;   {Modify}
  68.  
  69. {----------------------------------------------------------------------------}
  70. {-                                                                          -}
  71. {-    SaveFile tests if the specified filename already exists. If so, the   -}
  72. {-    user is asked if the old file should be overwritten. If so, or if     -}
  73. {-    the old file does not exist, then the data is saved as filename and   -}
  74. {-    the user is returned to the Main Menu, otherwise the user is          -}
  75. {-    returned to the FileIO Menu.                                          -}
  76. {-                                                                          -}
  77. {----------------------------------------------------------------------------}
  78.  
  79. PROCEDURE SaveFile;
  80.  
  81.    VAR
  82.       filename : string;
  83.       i        : INTEGER;
  84.  
  85.    BEGIN  {SaveFile}
  86.       OKSave:=FALSE;
  87.       WriteXY ('Save to file: ',StartColumn,24);
  88.       ReadLn (filename);
  89.       Modify (filename);
  90.       {-   Does file exist? If so, is it safe to overwrite it?   -}
  91.       IF NOT EXIST (filename)
  92.          THEN BEGIN
  93.             IF length (filename) > 0
  94.                THEN OKSave:=TRUE
  95.                ELSE OKSave:=FALSE;
  96.          END   {THEN}
  97.          ELSE BEGIN
  98.             PrintErrorMsg ('File already exists: overwrite (y/n)? ',
  99.                             StartColumn,21,TRUE,choice);
  100.             IF (UpCase(choice)='Y')
  101.                THEN OKSave:=TRUE
  102.                ELSE OKSave:=FALSE;
  103.          END;   {ELSE}
  104.       {-   If it is safe to write to the file, then save the data.   -}
  105.       IF OKSave THEN BEGIN
  106.          {$I-}    (* Turn off error checking. *)
  107.          WriteXY ('Saving file. Please wait ... ',StartColumn,22);
  108.          Assign (Name,filename);
  109.          Rewrite (Name);
  110.          WriteLn (Name,NumPoints);
  111.          FOR i:=0 TO NumPoints-1 DO
  112.             WriteLn (Name,time^[i]:precision,'   ',
  113.                           ampl^[i]:precision);
  114.          FOR i:=1 TO MaxInfo DO
  115.             WriteLn (Name,info[i]);
  116.          Close (Name);
  117.          GotoXY (StartColumn,22); ClrEOL;
  118.          GotoXY (StartColumn,24); ClrEOL;
  119.          {$I+}   (* Turn error checking on. *)
  120.          IF (IOResult <> 0) THEN BEGIN
  121.             PrintErrorMsg ('Error on disk. File not saved! ',
  122.                            StartColumn,24,FALSE,choice);
  123.          END;   {IF}
  124.       END;   {IF}
  125.    END;   {SaveFile}
  126.  
  127. {----------------------------------------------------------------------------}
  128. {-                                                                          -}
  129. {-    RetrieveFile first calls EXIST. If the file exists, then the file     -}
  130. {-    is read and the user is returned to the Main Menu; otherwise the      -}
  131. {-    user is given an error message and returned to the FileIO Menu.       -}
  132. {-                                                                          -}
  133. {----------------------------------------------------------------------------}
  134.  
  135.  
  136. PROCEDURE RetrieveFile;
  137.  
  138.    PROCEDURE ReadReal ( VAR st : string;
  139.                         VAR x  : REAL
  140.                       );
  141.  
  142.       VAR
  143.          error : INTEGER;
  144.          x_str : string [33];
  145.  
  146.       BEGIN   {ReadReal}
  147.          x_str:=st;
  148.          WHILE x_str[1] = ' ' DO
  149.             x_str:=Copy (x_str,2,length(x_str));
  150.          IF (x_str[1] = '.')
  151.             THEN x_str:='0'+x_str
  152.          ELSE IF ((x_str[1] = '-') AND (x_str[2] = '.'))
  153.             THEN BEGIN
  154.                x_str[1]:='0';
  155.                x_str:='-'+x_str;
  156.             END;   {ELSE-IF}
  157.          Val (x_str,x,error);
  158.          IF error <> 0 THEN BEGIN
  159.             st:=Copy (x_str,error,length(x_str));
  160.             x_str:=Copy (x_str,1,error-1);
  161.             Val (x_str,x,error);
  162.          END;   {IF}
  163.       END;   {ReadReal}
  164.  
  165.    VAR
  166.       delta_x  : REAL;                    (* distance between time values   *)
  167.       filename : string;
  168.       i        : INTEGER;                 (* temporary counter variable     *)
  169.       j        : INTEGER;
  170.       y        : string[33];
  171.  
  172.  
  173.    BEGIN  {RetrieveFile}
  174.       GotoXY (StartColumn,22); ClrEOL;
  175.       WriteXY ('File to read: ',StartColumn,24);
  176.       ReadLn (filename);
  177.       Modify (filename);
  178.       {-   Does file exist? If not, ERROR! If so, read the file.   -}
  179.       IF NOT EXIST (filename)
  180.          THEN BEGIN
  181.             IF length (filename) > 0 THEN
  182.                PrintErrorMsg ('File does not exist!',
  183.                                StartColumn+2,22,FALSE,choice);
  184.             WriteXY ('Your Choice? ',StartColumn,24);
  185.          END   {THEN}
  186.          ELSE BEGIN
  187.             WriteXY ('Reading. Please wait ...',StartColumn,22);
  188.             Assign (Name,filename);
  189.             Reset (Name);
  190.             TRANS:=FALSE;
  191.             ORIG:=TRUE;
  192.             ACCEPT:=FALSE;
  193.             {--- Initialize array variables ---}
  194.             FillChar (time^, SizeOf(time^), 0);
  195.             FillChar (ampl^, SizeOf(ampl^), 0);
  196.             FillChar (freq^, SizeOf(freq^), 0);
  197.             FillChar (mag^,  SizeOf(mag^),  0);
  198.             FillChar (phase^,SizeOf(phase^),0);
  199.  
  200.             ReadLn (Name,NumPoints);
  201.             {--- Read (x,y) coordinate pairs ---}
  202.             FOR i:=0 TO NumPoints-1 DO BEGIN
  203.                ReadLn (Name,y);
  204.                ReadReal (y,time^[i]);
  205.                ReadReal (y,ampl^[i]);
  206.             END;   {FOR}
  207.             i:=1;
  208.             WHILE (NOT EOF (Name)) AND (i <= MaxInfo) DO BEGIN
  209.                ReadLn (Name,info[i]);
  210.                INC (i,1);
  211.             END;   {WHILE}
  212.             FOR j:=i+1 TO MaxInfo DO
  213.                info[i]:=blank;
  214.             Close (Name);
  215.          END;   {ELSE}
  216.    END;   {RetrieveFile}
  217.  
  218. {----------------------------------------------------------------------------}
  219. {-                                                                          -}
  220. {-    DeleteFile deletes a file, if present, from disk, after asking the    -}
  221. {-    user to verify that he wants to delete it.                            -}
  222. {-                                                                          -}
  223. {----------------------------------------------------------------------------}
  224.  
  225. PROCEDURE DeleteFile;
  226.  
  227.    VAR
  228.       filename : string;
  229.  
  230.    BEGIN  {DeleteFile}
  231.       WriteXY ('Delete filename: ',StartColumn,24);
  232.       ReadLn (filename);
  233.       Modify (filename);
  234.       IF EXIST (filename) THEN BEGIN
  235.          PrintErrorMsg ('Delete file (y/n)? ',StartColumn+2,22,TRUE,choice);
  236.          IF (UpCase (choice) = 'Y') THEN Erase (Name);
  237.       END;   {THEN}
  238.    END;   {DeleteFile}
  239.  
  240.  
  241. {----------------------------------------------------------------------------}
  242. {-                                                                          -}
  243. {-    This procedure lists the directory of the current (logged) drive.     -}
  244. {-                                                                          -}
  245. {----------------------------------------------------------------------------}
  246.  
  247. PROCEDURE DiskDirectory;
  248.  
  249.    CONST
  250.       MaxDirectoryEntries = 200;
  251.       DefaultDrive        = 0;
  252.       Search              = $30;      {search for directories and files   }
  253.  
  254.    TYPE
  255.       MaxEntries  = 1..MaxDirectoryEntries;
  256.       Colors      = 1..8;
  257.  
  258.    VAR
  259.       NamR        : array [1..MaxDirectoryEntries] of string [12];
  260.       EntryDir    : array [1..MaxDirectoryEntries] of BOOLEAN;
  261.       DefaultDir  : string;
  262.       buffer      : string;
  263.       temp        : SearchRec;
  264.       DirColor    : byte;
  265.       DirBack     : byte;
  266.       EntryNumber : byte;
  267.       NumEntries  : byte;
  268.       NumScreens  : byte;
  269.       x           : byte;
  270.       y           : byte;
  271.       z           : byte;
  272.       ch          : CHAR;
  273.       Drive       : byte;
  274.       temp_int    : longint;
  275.  
  276.    BEGIN   {DiskDirectory}
  277.       DirColor:=abs((7-ForeColor) mod 16);
  278.       DirBack :=abs((7-BackColor) mod 16);
  279.       ClrScr;
  280.       GetDir (DefaultDrive,DefaultDir);
  281.       ChDir (DefaultDataDir);
  282.       FillChar (NamR,SizeOf(NamR),0);
  283.       FillChar (buffer,SizeOf(buffer),0);
  284.       buffer[0]:=CHAR(0);
  285.       WriteXY ('File mask: ',1,1); ReadLn (buffer);
  286.       IF (length(buffer) = 0)
  287.          THEN BEGIN
  288.             buffer:='*.*';
  289.             IF DefaultDataDir[2] = ':'
  290.                THEN Drive:=ord(UpCase(DefaultDataDir[1]))-ord('A')+1
  291.                ELSE Drive:=DefaultDrive;
  292.             WriteXY (DefaultDataDir,12,1);
  293.          END   {THEN}
  294.          ELSE BEGIN
  295.             IF buffer[2] = ':'          {Get drive number}
  296.                THEN BEGIN
  297.                   Drive:=ord(UpCase(buffer[1]))-(ord('A')-1);
  298.                   IF length(buffer) = 2 THEN buffer:=buffer+'*.*';
  299.                END   {THEN}
  300.                ELSE BEGIN
  301.                   IF DefaultDataDir[2] = ':'
  302.                      THEN Drive:=ord(UpCase(DefaultDataDir[1]))-ord('A')+1
  303.                      ELSE Drive:=DefaultDrive;
  304.                END;   {ELSE}
  305.          END;   {ELSE}
  306.       EntryNumber:=0;
  307.       FindFirst (buffer,search,temp);
  308.       IF (DosError = 0) AND (temp.Attr = Directory) THEN BEGIN
  309.          {$I-} ChDir (buffer); {$I+}
  310.          IF IOResult = 0 THEN buffer:='*.*';
  311.          FindFirst (buffer,search,temp);
  312.       END;   {IF}
  313.       WHILE (DosError = 0) DO BEGIN
  314.          EntryNumber:=succ(EntryNumber);
  315.          NamR[EntryNumber]:=temp.Name;
  316.          IF temp.attr = Directory
  317.             THEN EntryDir [EntryNumber]:=TRUE
  318.             ELSE EntryDir [EntryNumber]:=FALSE;
  319.          FindNext (temp);
  320.       END;   {WHILE}
  321.       NumEntries:=EntryNumber;
  322.       NumScreens:=(NumEntries-1) div 72 +1;
  323.       IF (NumEntries >= 1)
  324.          THEN BEGIN
  325.             EntryNumber:=1;
  326.             FOR z:=1 TO NumScreens DO BEGIN
  327.                FOR y:=3 TO 20 DO
  328.                   FOR x:=1 TO 4 DO BEGIN
  329.                      GotoXY (20*x-19,y);
  330.                      IF EntryDir[EntryNumber]
  331.                         THEN BEGIN
  332.                            TextColor (DirColor);
  333.                            TextBackground (DirBack);
  334.                         END   {THEN}
  335.                         ELSE BEGIN
  336.                            TextColor (ForeColor);
  337.                            TextBackGround (BackColor);
  338.                         END;   {ELSE}
  339.                      write (NamR[EntryNumber]);
  340.                      EntryNumber:=succ(EntryNumber);
  341.                   END;   {FOR}
  342.                IF (NumScreens > 1) THEN IF (z < NumScreens) THEN BEGIN
  343.                   WriteXY ('Press any key for more entries....',1,24);
  344.                   ch:=ReadKey;
  345.                   ClrScr;
  346.                   WriteXY ('File mask: '+buffer,1,1);
  347.                END;   {IF}
  348.             END;   {FOR}
  349.          END   {THEN}
  350.          ELSE BEGIN
  351.             PrintErrorMsg ('File not found! ',4,5,FALSE,ch);
  352.          END;   {ELSE}
  353.       GotoXY (1,22);
  354.       TextColor (ForeColor);
  355.       TextBackground (BackColor);
  356.       temp_int:=DiskFree (Drive) div 1000;
  357.       IF Drive > 0
  358.          THEN ch:=CHAR(Drive+ord('A')-1)
  359.          ELSE ch:='C';
  360.       Write ('Drive ',ch,': has ',temp_int,' kB free.');
  361.       {$I-} ChDir (DefaultDir); {$I+}
  362.       ch:=CHAR(IOResult);                {Dummy assignment                }
  363.       WriteXY ('Press any key to return ...',1,24);
  364.       ch:=ReadKey;
  365.       ClrScr;
  366.    END;   {DiskDirectory}
  367.  
  368. PROCEDURE ReadInfoLines;
  369.  
  370.    VAR
  371.       ch  : CHAR;
  372.       int : byte;
  373.  
  374.    BEGIN   {ReadInfoLines}
  375.       ClrScr;
  376.       FOR int:=1 TO MaxInfo DO
  377.          WriteLn (info[int]);
  378.       WriteXY ('Press any key to return to the File I/O menu ...',1,25);
  379.       ch:=ReadKey;
  380.       ClrScr;
  381.    END;   {ReadInfoLines}
  382.  
  383. PROCEDURE FileIOMenu;
  384.  
  385.    BEGIN
  386.       {-   Set up window, print FileIO Menu, prompt for choice.   -}
  387.       ClrScr;
  388.       WriteXY ('File I/O Menu'                    ,StartColumn+10,3);
  389.       WriteXY ('Select Option by typing a number:',StartColumn   ,5);
  390.       WriteXY ('1. Save Data to disk'             ,StartColumn+8 ,8);
  391.       WriteXY ('2. Retrieve Data from disk'       ,StartColumn+8 ,10);
  392.       WriteXY ('3. Delete Data from disk'         ,StartColumn+8 ,12);
  393.       WriteXY ('4. Disk Directory'                ,StartColumn+8 ,14);
  394.       WriteXY ('5. Display Information Lines'     ,StartColumn+8 ,16);
  395.       WriteXY ('9. Exit to Main Menu'             ,StartColumn+8 ,18);
  396.       WriteXY ('Your choice?'                     ,StartColumn   ,24);
  397.       GotoXY (StartColumn+13,24); ClrEOL;
  398.       REPEAT
  399.          choice:=ReadKey;
  400.       UNTIL choice IN ['1'..'5','9'];
  401.    END;   {FileIOMenu}
  402.  
  403. PROCEDURE FileIO;
  404.  
  405.    BEGIN   {FileIO}
  406.       WHILE TRUE DO BEGIN
  407.          FileIOMenu;
  408.          CASE choice OF                      (* Choice:                   *)
  409.             '1': SaveFile;                   (* Save file.                *)
  410.             '2': RetrieveFile;               (* Retrieve file.            *)
  411.             '3': DeleteFile;                 (* Delete file.              *)
  412.             '4': DiskDirectory;              (* Disk Directory.           *)
  413.             '5': ReadInfoLines;              (* Display descriptive info. *)
  414.             '9': BEGIN                       (* Return.                   *)
  415.                     ClrScr;
  416.                     Exit;
  417.                  END;
  418.          END;   {CASE}
  419.       END;   {WHILE}
  420.    END;   {FileIO}
  421.  
  422. (****************************************************************************)
  423.  
  424. BEGIN   {Initialization}
  425. END.   {Initialization}
  426.