home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / compiler / fst_mod / source / dirhelps.mod < prev    next >
Text File  |  1987-03-25  |  8KB  |  243 lines
  1. IMPLEMENTATION MODULE DirHelps;
  2.  
  3. (*           Copyright (c) 1987 - Coronado Enterprises             *)
  4.  
  5. FROM InOut      IMPORT WriteString,Write,WriteLn;
  6. FROM FileSystem IMPORT Lookup, Close, File, Response,
  7.                        ReadNBytes, WriteNBytes;
  8. FROM SYSTEM     IMPORT AX,BX,CX,DX,DS,SWI,GETREG,SETREG,
  9.                        ADDRESS,ADR;
  10.  
  11. VAR DiskTransAdr : ARRAY[1..43] OF CHAR;         (* Must be Global *)
  12.  
  13. (*******************************************************************)
  14. PROCEDURE ReadFileStats(FileName      : ARRAY OF CHAR;
  15.                         FirstFile     : BOOLEAN;
  16.                         VAR FilePt    : FileDataPointer;
  17.                         VAR FileError : BOOLEAN);
  18.  
  19. VAR MaskAddr     : ADDRESS;
  20.     Error        : CARDINAL;
  21.     Index        : CARDINAL;
  22. BEGIN
  23.    IF FirstFile THEN
  24.       FOR Index := 1 TO 43 DO                 (* Clear out the DTA *)
  25.          DiskTransAdr[Index] := " ";
  26.       END;
  27.  
  28.       SETREG(AX,01A00H);       (* Set up the Disk Transfer Address *)
  29.       MaskAddr := ADR(DiskTransAdr);
  30.       SETREG(DS,MaskAddr.SEGMENT);
  31.       SETREG(DX,MaskAddr.OFFSET);
  32.       SWI(021H);
  33.  
  34.       MaskAddr := ADR(FileName);
  35.       SETREG(AX,04E00H);                         (* Get first file *)
  36.       SETREG(DS,MaskAddr.SEGMENT);
  37.       SETREG(DX,MaskAddr.OFFSET);
  38.       SETREG(CX,017H);                  (* Attribute for all files *)
  39.       SWI(021H);
  40.    ELSE
  41.       SETREG(AX,04F00H);                   (* Get additional files *)
  42.       SWI(021H);
  43.    END;
  44.    GETREG(AX, Error);
  45.    Error := Error MOD 256;                 (* Logical AND with 255 *)
  46.    IF Error = 0 THEN
  47.       FileError := FALSE;  (* Good read, put data in the structure *)
  48.       FOR Index := 0 TO 13 DO    (* Put all blanks in the filename *)
  49.          FilePt^.Name[Index] := ' ';
  50.       END;
  51.       Index := 0;
  52.       REPEAT                            (* Copy filename to record *)
  53.          FilePt^.Name[Index] := DiskTransAdr[Index + 31];
  54.          Index := Index + 1;
  55.       UNTIL (Index > 11) OR (DiskTransAdr[Index + 31] = 000C);
  56.       FilePt^.Name[12] := 000C;               (* ASCIIZ terminator *)
  57.  
  58.       FilePt^.Attr := ORD(DiskTransAdr[22]);
  59.       FilePt^.Time := 0;                            (* Ignore Time *)
  60.       FilePt^.Date := 0;                            (* Ignore Date *)
  61.       FilePt^.Size := 65536.0 * FLOAT(ORD(DiskTransAdr[29]))
  62.                       + 256.0 * FLOAT(ORD(DiskTransAdr[28]))
  63.                       +         FLOAT(ORD(DiskTransAdr[27]));
  64.       FilePt^.Left := NIL;
  65.       FilePt^.Right := NIL;
  66.    ELSE
  67.       FileError := TRUE;
  68.    END; (* of IF Error = 0 *)
  69.  
  70. END ReadFileStats;
  71.  
  72.  
  73.  
  74. (*******************************************************************)
  75. PROCEDURE GetDiskStatistics(Drive          : CHAR;
  76.                             VAR SectorsPerCluster : CARDINAL;
  77.                             VAR FreeClusters      : CARDINAL;
  78.                             VAR BytesPerSector    : CARDINAL;
  79.                             VAR TotalClusters     : CARDINAL);
  80. VAR DriveCode : INTEGER;
  81. BEGIN
  82.    DriveCode := INTEGER(ORD(Drive)) - 64;
  83.    IF (DriveCode > 17) OR (DriveCode < 0) THEN
  84.       WriteString("Error - Drive code invalid ---> ");
  85.       Write(Drive);
  86.       WriteLn;
  87.       SectorsPerCluster := 0;
  88.       FreeClusters := 0;
  89.       BytesPerSector := 0;
  90.       TotalClusters := 0;
  91.    ELSE
  92.       SETREG(AX,03600H);
  93.       SETREG(DX,DriveCode);
  94.       SWI(021H);
  95.       GETREG(BX,FreeClusters);
  96.       GETREG(AX,SectorsPerCluster);
  97.       GETREG(CX,BytesPerSector);
  98.       GETREG(DX,TotalClusters);
  99.       IF SectorsPerCluster = 0FFFFH THEN
  100.          WriteString("Error - Drive doesn't exist ---> ");
  101.          Write(Drive);
  102.          WriteLn;
  103.          SectorsPerCluster := 0;
  104.          FreeClusters := 0;
  105.          BytesPerSector := 0;
  106.          TotalClusters := 0;
  107.       END;
  108.    END;
  109. END GetDiskStatistics;
  110.  
  111.  
  112.  
  113.  
  114. (*******************************************************************)
  115. PROCEDURE ChangeToDirectory(Directory : ARRAY OF CHAR;
  116.                             CreateIt : BOOLEAN;
  117.                             VAR ErrorReturn : BOOLEAN);
  118.  
  119. VAR MaskAddr : ADDRESS;
  120.     Good     : CARDINAL;
  121.  
  122.      PROCEDURE CHDIR(Path : ARRAY OF CHAR;
  123.                      VAR Error : CARDINAL);
  124.      BEGIN
  125.         MaskAddr := ADR(Path);
  126.         SETREG(AX,03B00H);
  127.         SETREG(DX,MaskAddr.OFFSET);
  128.         SETREG(DS,MaskAddr.SEGMENT);
  129.         SWI(021H);
  130.         GETREG(AX,Error);
  131.         Error := Error MOD 256;
  132.      END CHDIR;
  133.  
  134.      PROCEDURE MKDIR(Path : ARRAY OF CHAR;
  135.                      VAR Error : CARDINAL);
  136.      BEGIN
  137.         MaskAddr := ADR(Path);
  138.         SETREG(AX,03900H);
  139.         SETREG(DX,MaskAddr.OFFSET);
  140.         SETREG(DS,MaskAddr.SEGMENT);
  141.         SWI(021H);
  142.         GETREG(AX,Error);
  143.         Error := Error MOD 256;
  144.      END MKDIR;
  145.  
  146.      PROCEDURE CreateAndChangeDirectory(Directory : ARRAY OF CHAR);
  147.      VAR SubDir  : ARRAY[0..64] OF CHAR;
  148.          Index   : CARDINAL;
  149.          Correct : CARDINAL;
  150.      BEGIN
  151.         Index := 0;
  152.         REPEAT                        (* Find the terminating zero *)
  153.            SubDir[Index] := Directory[Index];
  154.            Index := Index + 1;
  155.         UNTIL (Directory[Index] = 000C) OR (Index = 64);
  156.         SubDir[Index] := 000C;
  157.         REPEAT                            (* Remove a subdirectory *)
  158.            SubDir[Index] := 000C;
  159.            IF Index > 2 THEN
  160.               Index := Index - 1;
  161.            END;
  162.         UNTIL (Index = 2) OR (SubDir[Index] = '\');
  163.         IF Index > 2 THEN
  164.            SubDir[Index] := 000C;          (* Blank out trailing \ *)
  165.         END;
  166.         CHDIR(SubDir,Correct);
  167.         IF (Correct <> 0) AND         (* SubDir Doesn't exist, AND *)
  168.                    (Index > 2) THEN       (* subdirs still in list *)
  169.            CreateAndChangeDirectory(SubDir);
  170.            MKDIR(SubDir,Correct);         (* Make the subdirectory *)
  171.            CHDIR(SubDir,Correct);       (* Change the subdirectory *)
  172.         END;
  173.      END CreateAndChangeDirectory;
  174. BEGIN
  175.    CHDIR(Directory,Good);
  176.    IF Good = 0 THEN                  (* Change to dir if it exists *)
  177.       ErrorReturn := FALSE;
  178.    ELSIF CreateIt THEN              (* Create and change directory *)
  179.       CreateAndChangeDirectory(Directory);
  180.       MKDIR(Directory,Good);
  181.       CHDIR(Directory,Good);
  182.       ErrorReturn := FALSE;
  183.    ELSE                      (* Dir doesn't exist, return an error *)
  184.       ErrorReturn := TRUE;
  185.    END;
  186. END ChangeToDirectory;
  187.  
  188.  
  189.  
  190.  
  191. (*******************************************************************)
  192. PROCEDURE CopyFile(SourceFile       : ARRAY OF CHAR;
  193.                    DestinationFile  : ARRAY OF CHAR;
  194.                    FileSize         : REAL;
  195.                    VAR ResultOfCopy : CARDINAL);
  196.  
  197.  
  198. TYPE BufferType = ARRAY [1..1024] OF CHAR;
  199.  
  200. VAR InputFile  : File;
  201.     OutputFile : File;
  202.     Buffer     : BufferType;
  203.     BufferPtr  : POINTER TO BufferType;
  204.     BlockSize  : CARDINAL;
  205.     Number     : CARDINAL;
  206. BEGIN
  207.    Lookup(InputFile,SourceFile,FALSE);
  208.    IF InputFile.res = done THEN
  209.       Lookup(OutputFile,DestinationFile,TRUE);
  210.       IF OutputFile.res = done THEN
  211.          BufferPtr := ADR(Buffer[1]);
  212.          WHILE FileSize > 0.0 DO
  213.             IF FileSize > 1024.0 THEN
  214.                BlockSize := 1024;
  215.                FileSize := FileSize - 1024.0;
  216.             ELSE
  217.                BlockSize := TRUNC(FileSize);
  218.                FileSize := 0.0;
  219.             END;
  220.             ReadNBytes(InputFile,BufferPtr,BlockSize,Number);
  221.             WriteNBytes(OutputFile,BufferPtr,BlockSize,Number);
  222.          END;
  223.          ResultOfCopy := 0;                   (* Good copy made *)
  224.          Close(OutputFile);
  225.       ELSE
  226.          ResultOfCopy := 2;        (* Cannot open destination file *)
  227.          WriteString("Unable to open Destination file ---> ");
  228.          WriteString(DestinationFile);
  229.          WriteLn;
  230.       END;
  231.       Close(InputFile);
  232.    ELSE
  233.       ResultOfCopy := 1;
  234.       WriteString("Unable to open Source file ---> ");
  235.       WriteString(SourceFile);
  236.       WriteLn;
  237.    END;
  238. END CopyFile;
  239.  
  240.  
  241. BEGIN
  242. END DirHelps.
  243.