home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TPROUTN.ZIP / PATHS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-05-17  |  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.