home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PATHS.ZIP / PATHS.PAS
Encoding:
Pascal/Delphi Source File  |  1986-11-08  |  9.1 KB  |  166 lines
  1. { ****************************** PATHS.PAS *******************************}
  2. { These procedures perform various functions to paths under PCMSDos 2.0   }
  3. { They are designed to be $Included into one's Turbo PASCAL program       }
  4. { Written by:         Clark Walker                                        }
  5. {                     CompuServe 76010,346                                }
  6. { ************************************************************************}
  7.  
  8. { ************************************************************************}
  9. {             This procedure will get the current directory               }
  10. { ************************************************************************}
  11. PROCEDURE CurrDir(    Drive   : CHAR    ;    { Drive A,B,C, etc           }
  12.                   VAR Path    : String80;    { Current Path returned here }
  13.                   VAR Error   : INTEGER);    { See dos 2.0 manual pg D-14 }
  14. VAR
  15.    I             :  INTEGER;
  16. BEGIN
  17.    Error := 0;
  18.    Regs.AX := $4700;                       { Dos function to get curr dir }
  19.    Regs.DX := ORD(Drive) - ORD('A') + 1;   { Dos uses 1,2,3.. not A,B,C.. }
  20.    Regs.DS := SEG(Path);                   { Point to area to hold Path   }
  21.    Regs.SI := OFS(Path);                   { Func 47 use DS:SI            }
  22.    Regs.SI := Regs.SI + 1;                 { Point past string length byte}
  23.    INTR($21,Regs);                         { Call Dos using interupt 21   }
  24.    Error := Regs.AX AND $ff;               { Error 15 = bad Drive         }
  25.    I := 1;
  26.    WHILE Path[I] <> CHR(0) DO I := I + 1;  { Dos puts chr(0) at end       }
  27.    Path[0]:=CHR(I-1);                      { Set length byte in string    }
  28. END;
  29.  
  30. { ************************************************************************}
  31. {             This procedure will create a subdirectory                   }
  32. { ************************************************************************}
  33. PROCEDURE MkDir(VAR AsciiZ   : String80;    { Full Path (Drive:\Path)     }
  34.                 VAR Error    : INTEGER );   { See dos 2.0 manual pg D-14  }
  35. BEGIN
  36.    Error := 0;
  37.    Regs.AX := $3900;                       { Dos function to make dir     }
  38.    Regs.DS := SEG(AsciiZ);                 { Point to Drive:\Path param   }
  39.    Regs.DX := OFS(AsciiZ);
  40.    Regs.DX := Regs.DX + 1;                 { Func 39 uses DS:DX           }
  41.    AsciiZ[LENGTH(AsciiZ)+1]:=CHR(0);       { dos wants it to end in chr(0)}
  42.    INTR($21,Regs);                         { Call Dos using interupt 21   }
  43.    Error := Regs.AX AND $ff;               { See dos manual Page D-14     }
  44.    IF Error = 2 THEN Error := 0;           { Dos reports 'file not found' }
  45.                                            { .. Error (incorrectly) I hope}
  46. END;
  47.  
  48. { ************************************************************************}
  49. {             This procedure will delete a subdirectory                   }
  50. { ************************************************************************}
  51. PROCEDURE RmDir(VAR AsciiZ   : String80;    { Full Path (Drive:\Path)     }
  52.                 VAR Error    : INTEGER );   { See dos 2.0 manual pg D-14  }
  53. BEGIN
  54.    Error := 0;
  55.    Regs.AX := $3A00;                       { Dos function to remote dir   }
  56.    Regs.DS := SEG(AsciiZ);                 { Point to Drive:\Path param   }
  57.    Regs.DX := OFS(AsciiZ);
  58.    Regs.DX := Regs.DX + 1;                 { Func 3A uses DS:DX           }
  59.    AsciiZ[LENGTH(AsciiZ)+1]:=CHR(0);       { dos wants it to end in chr(0)}
  60.    INTR($21,Regs);                         { Call Dos using interupt 21   }
  61.    Error := Regs.AX AND $ff;               { See dos manual Page D-14     }
  62. END;
  63.  
  64. { ************************************************************************}
  65. {          This procedure will change to a different directory            }
  66. { ************************************************************************}
  67. {   After changing directories, any access within Turbo or outside Turbo  }
  68. {   to the Drive in the AsciiZ string will result in this directory being }
  69. {   accessed.                                                             }
  70. { ************************************************************************}
  71. PROCEDURE ChDir(VAR AsciiZ   : String80;    { Full Path (Drive:\Path)     }
  72.                 VAR Error    : INTEGER );   { See dos 2.0 manual pg D-14  }
  73. BEGIN
  74.    Error := 0;
  75.    Regs.AX := $3B00;                       { Dos function to change dir   }
  76.    Regs.DS := SEG(AsciiZ);                 { Point to Drive:\Path param   }
  77.    Regs.DX := OFS(AsciiZ);
  78.    Regs.DX := Regs.DX + 1;                 { Func 3B uses DS:DX           }
  79.    AsciiZ[LENGTH(AsciiZ)+1]:=CHR(0);       { dos wants it to end in chr(0)}
  80.    INTR($21,Regs);                         { Call Dos using interupt 21   }
  81.    Error := Regs.AX AND $ff;               { See dos manual Page D-14     }
  82. END;
  83.  
  84. { ************************************************************************}
  85. {          This procedure will delete a file in a directory               }
  86. { ************************************************************************}
  87. PROCEDURE DelFile(VAR AsciiZ   : String80;  { Full Path (Drive:\Path\file)}
  88.                   VAR Error    : INTEGER ); { See dos 2.0 manual pg D-14  }
  89. BEGIN
  90.    Error := 0;
  91.    Regs.AX := $4100;                       { Dos function to del via dir  }
  92.    Regs.DS := SEG(AsciiZ);                 { Point to Drive:\Path param   }
  93.    Regs.DX := OFS(AsciiZ);
  94.    Regs.DX := Regs.DX + 1;                 { Func 41 uses DS:DX           }
  95.    AsciiZ[LENGTH(AsciiZ)+1]:=CHR(0);       { dos wants it to end in chr(0)}
  96.    INTR($21,Regs);                         { Call Dos using interupt 21   }
  97.    Error := Regs.AX AND $ff;               { See dos manual Page D-14     }
  98. END;
  99.  
  100. { ************************************************************************}
  101. {      This procedure will rename a file using a directory Path           }
  102. { ************************************************************************}
  103. {  Using this procedure you can MOVE a file between directories keeping   }
  104. {  in mind the second (to) directory\file is on the same Drive.           }
  105. { ************************************************************************}
  106. {  Note: If you specify a Drive in Path it must be the same as that in    }
  107. {  AsciiZ. In fact, if it is not your current Drive you MUST specify a    }
  108. {  Drive.  Note, You will get Error code 255 (invalid Drive) when you     }
  109. {  specify the Drive and it is not your current 'logged on' Drive.        }
  110. { ************************************************************************}
  111. PROCEDURE RenFile(VAR AsciiZ   : String80;  { Full Path (Drive:\Path\file)}
  112.                   VAR Path     : String80;  { \Path\File.name or filename }
  113.                   VAR Error    : INTEGER ); { See dos 2.0 manual pg D-14  }
  114. BEGIN
  115.    Error := 0;
  116.    Regs.AX := $5600;                       { Dos function to move files   }
  117.    Regs.DS := SEG(AsciiZ);                 { Point to Drive:\Path param   }
  118.    Regs.DX := OFS(AsciiZ);
  119.    Regs.DX := Regs.DX + 1;                 { Point past length byte       }
  120.    Regs.ES := SEG(Path);
  121.    Regs.DI := OFS(Path);
  122.    Regs.DI := Regs.DI + 1;
  123.    AsciiZ[LENGTH(AsciiZ)+1]:=CHR(0);       { dos wants it to end in chr(0)}
  124.    Path[LENGTH(Path)+1]:=CHR(0);
  125.    INTR($21,Regs);                         { Call Dos using interupt 21   }
  126.    Error := Regs.AX AND $ff;               { See dos manual Page D-14     }
  127. END;
  128.  
  129. { ************************************************************************}
  130. {  This function will return your current disk Drive id (A,B,C, etc.).    }
  131. { ************************************************************************}
  132. FUNCTION  CurrDrive : CHAR;                  { A,B,C, etc.                }
  133. BEGIN
  134.    Regs.AX := $1900;                         { Dos function returns Drive }
  135.    INTR($21,Regs);
  136.    CurrDrive := CHR(LO(Regs.AX)+ORD('A'));   { 0=A, 1=B, etc              }
  137. END;
  138.  
  139. { ************************************************************************}
  140. {         This procedure will change your 'logged on disk'                }
  141. { ************************************************************************}
  142. PROCEDURE chgdrive  (Drive : CHAR);          { A,B,C, etc.                }
  143. BEGIN
  144.    Regs.AX := $0E00;                         { Dos function changes Drive }
  145.    Regs.DX := ORD(Drive) - ORD('A');         { Dos uses 0,1,2 not A,B,C   }
  146.    INTR($21,Regs);
  147. END;
  148.  
  149. { ************************************************************************}
  150. {    This function will return the free disk space on any Drive           }
  151. { ************************************************************************}
  152. FUNCTION  FreeSpace (Drive : CHAR) : REAL;   { A,B,C, etc.                }
  153. VAR
  154.    AvailClusters,SectorsPerCluster,BytesPerSector : REAL;
  155. BEGIN
  156.    Regs.AX := $3600;                         { Dos function for free space}
  157.    Regs.DX := ORD(Drive) - ORD('A') + 1;     { Dos uses 1,2,3 for A,B,C   }
  158.    INTR($21,Regs);
  159.    { returns: BX=avail clusters DX=total clusters
  160.               CX=bytes per sector AX=sectors per cluster }
  161.    AvailClusters := Regs.BX;
  162.    SectorsPerCluster := Regs.AX;
  163.    BytesPerSector := Regs.CX;
  164.    FreeSpace := AvailClusters * SectorsPerCluster * BytesPerSector;
  165. END;
  166.