home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / NMOVE.ZIP / NMOVE.PAS
Encoding:
Pascal/Delphi Source File  |  1986-11-08  |  3.8 KB  |  128 lines
  1. program nmove;
  2.  
  3. type
  4.     anystr = string[255];
  5.     parmtype = string[127];
  6.     pathtype  = string[62];
  7.     drivetype = string[2];
  8.     rtype     = record
  9.                       ax,bx,cx,dx,bp,si,di,ds,es,flags:integer
  10.                 end;
  11.  
  12. var
  13. fname,dirname,nname,rname  : anystr;
  14. command : parmtype;
  15.  
  16. procedure rename(x,y:pathtype);
  17.  
  18. var
  19.    wx,wy : pathtype;
  20.    reg   : rtype;
  21.  
  22. function currentdrive: drivetype;
  23. var
  24.    w   : drivetype;
  25.    reg : rtype;
  26.  
  27. begin
  28.      reg.ax:=$1900;
  29.      intr($21,reg);
  30.      w:='A:';
  31.      w[1]:=chr(ord(w[1])+lo(reg.ax));
  32.      currentdrive:=w
  33.      end;
  34.  
  35. begin
  36.      wx := x + chr(0);
  37.      wy := y + chr(0);
  38.      if wx[2]<>':' then wx :=currentdrive+wx;
  39.      reg.ax := $5600;
  40.      reg.ds := seg(wx[1]);
  41.      reg.dx := ofs(wx[1]);
  42.      reg.es := seg(wy[1]);
  43.      reg.di := ofs(wy[1]);
  44.      intr($21,reg);
  45.      if (reg.flags and 1) <> 0 then
  46.         begin
  47.              WRITELN;
  48.              writeln;
  49.              writeln('Error -- invalid rename request.');
  50.              writeln('      -- from: ''',x,'''');
  51.              writeln('      -- to:   ''',y,'''');
  52.              halt
  53.         end
  54. end;
  55.  
  56. (*--------------------------------------------------------------------------*)
  57. (*                        GETPARMS.INC                                      *)
  58. (*  Turbo Pascal procedure to retrieve command line parameters.             *)
  59. (*  Copywrite 1984 Michael A. Covington                                     *)
  60. (*--------------------------------------------------------------------------*)
  61.  
  62. procedure getparm(var s:parmtype);
  63. (*--------------------------------------------------------------------------*)
  64. (*  returns first available parameter from DOS command line and removes it  *)
  65. (*  next parameter will be returned on next call.  If no more parameters    *)
  66. (*  are available, returns a null string.                                   *)
  67. (*--------------------------------------------------------------------------*)
  68. var
  69.    parms  : parmtype absolute CSEG:$80;
  70.  
  71. begin
  72.      s:='';
  73.      (* parms[1] exists even when length is zero *)
  74.      while ( length(parms) > 0) and (parms[1] = ' ') do
  75.           delete(parms,1,1);
  76.      while (length(parms) > 0) and (parms[1] <> ' ') do
  77.           begin
  78.                s:=s+parms[1]; delete(parms,1,1)
  79.           end
  80. end;
  81.  
  82. begin {main}
  83.  
  84. getparm(command);
  85.                   fname := (command);
  86. getparm(command);
  87.                   rname := (command);
  88.  
  89. if length(fname) = 0 then
  90.    begin
  91.         writeln;
  92.         write('file to move: ');
  93.         readln(fname);
  94.         write('new directory: ');
  95.         readln(dirname);
  96.         if dirname = '\' then dirname := ''
  97.         else dirname := dirname;
  98.         write('name of moved file (<cr> for same name): ');
  99.         read(nname);
  100.                     if length(nname) = 0 then rname := (dirname+'\'+fname)
  101.                             else
  102.                     rname := (dirname+'\'+nname);
  103.                     rename(fname,rname);
  104.         end
  105. else
  106. if (fname) = '?' then
  107. begin
  108.    writeln;
  109.    WRITELN('A move can be executed from the command line, bypassing prompts,');
  110.    WRITELN('by entering:');
  111.    WRITELN;
  112.    WRITELN('Syntax:   Nmove <fname> <\path\fname2>');
  113.    WRITELN;
  114.    WRITELN('               Where <fname> is the file to move, <\path> ');
  115.    WRITELN('               is the destination directory, and <fname2> ');
  116.    WRITELN('               is the destination filename.               ');
  117.    WRITELN;
  118.    WRITELN('               Note:  the destination <fname2> may be     ');
  119.    WRITELN('                      different from the source <fname>.  ');
  120.    WRITELN('');
  121.    WRITELN('Nmove will not write over an existing file ');
  122.    WRITELN('in the destination directory.');
  123.    delay(1000);
  124. end
  125.    else
  126. rename(fname,rname);
  127. end.
  128.