home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MOVEDIR.ZIP / MOVEDIR.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1986-12-11  |  1.5 KB  |  53 lines
  1. Program MoveDir;
  2. TYPE
  3.    CommandStr = STRING[127];
  4.    Str80 = STRING[80];
  5.    Registers = RECORD CASE Integer OF
  6.      1 : (AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAGS : Integer);
  7.      2 : (AL, AH, BL, BH, CL, CH, DL, DH  : Byte);
  8.      END; {of case}
  9. VAR
  10.    OrgName, NewName :Str80;
  11.    Error : Integer;
  12.  
  13. PROCEDURE Move_Dir (VAR Orgn, Newn : Str80; VAR ER : Integer);
  14. VAR  Regs : Registers;
  15. BEGIN
  16.    WITH Regs DO
  17.      BEGIN
  18.        AH := $56;  {Dos function $56}
  19.        DS := Seg(Orgn);  {address of original name}
  20.        DX := Ofs(Orgn)+1;
  21.        ES := Seg(NewN);  {address of new name}
  22.        DI := Ofs(NewN)+1;
  23.        MsDos(Regs);
  24.        IF Flags AND 1 = 1 THEN ER := AX
  25.        ELSE ER := 0;
  26.      END;
  27. END;
  28.  
  29. PROCEDURE Move_Dir2 (VAR Orgn, Newn : Str80; VAR ER : Integer);
  30. (* Uses Turbo's Own Rename procedure to change a file's directory *)
  31. VAR F : file;
  32. BEGIN
  33.    Assign(F,Orgn);
  34.    {$I-} Rename(F,NewN); {$I+}
  35.    ER := IOresult;
  36. END;
  37.  
  38. BEGIN
  39.    IF ParamCount = 2 THEN
  40.       BEGIN
  41.          OrgName := ParamStr(1)+Chr(0);
  42.          NewName := ParamStr(2)+Chr(0);
  43.          Move_Dir2(OrgName, Newname, Error);
  44.          CASE Error OF
  45.            0 : Writeln('Successfully moved ',OrgName,' to ',NewName);
  46.            2 : Writeln('File Not found.');
  47.            3 : Writeln('Path not found.');
  48.            5 : Writeln('File Access Denied');
  49.          ELSE  Writeln('Error #',Error);
  50.          END;
  51.       END
  52.       ELSE Writeln(#7, 'Enter "MOVEDIR <oldpathname> <newpathname>"');
  53. END.