program FastCopy; uses crt, XMS; const BufSize:word=32768; var h,nr,nw:word; inp,out:file; size,fpos,outsize:longint; XMSsize,XMSposr,XMSposw:longint; s,sf:string; Block:pointer; ypos:byte; isXMS,done,esc:boolean; pars:TMoveParams; procedure WriteStatus(y:byte; value,total:longint); var i,n:word; begin value:=value div 1024; total:=total div 1024; n:=round(100*(value/total)); gotoxy(7,y); write(value,' bytes (',n,'%) '); if keypressed then esc:=(readkey=#27); end; procedure Quit(s:string); begin gotoxy(1,ypos+2); writeln(s); close(out); close(inp); freemem(Block,BufSize); if isXMS then XMSFree(h); halt; end; procedure Crush; begin writeln('Usage: fcopy [path\]file path\[file]'); writeln('Example: fcopy heroes2.agg d:'); writeln; halt; end; begin writeln; writeln('Files copying utility, using XMS.'); if not XMSInstalled then begin writeln('...but XMS driver (himem.sys) is not installed.'); isXMS:=false; XMSsize:=0; end else begin XMSInit; isXMS:=true; XMSsize:=XMSGetFreeMem; writeln('Free XMS: ',XMSsize,' Kb (All that will be allocated)'); XMSsize:=XMSsize*1024; end; if paramcount<>2 then Crush; s:=paramstr(1); if s[2]=':' then delete(s,1,2); while pos('\',s)>0 do delete(s,1,pos('\',s)); if s='' then Crush; sf:=paramstr(2); if (sf[length(sf)]='\') or (sf[length(sf)]=':') then sf:=sf+s; assign(inp,paramstr(1)); assign(out,sf); {$I-} reset(inp,1); {$I+} if IOResult<>0 then begin writeln('Cannot open file ',s); halt; end; size:=filesize(inp); {$I-} reset(out,1); {$I+} if IOResult=0 then begin writeln(sf,' exists. ENTER - overwrite...'); if readkey<>#13 then halt; end; fpos:=0; rewrite(out,1); if MaxAvail64512 then XMSsize:=64512; if not XMSAllocate(h,XMSsize) then begin writeln('XMS allocating error'); isXMS:=false; end; end; outsize:=0; writeln; writeln('Read :'); writeln('Write:'); ypos:=WhereY-2; esc:=false; repeat with pars do begin SourceHandle:=0; SourceOffset:=longint(Block); DestHandle:=h; end; XMSposr:=0; done:=false; if not isXMS then done:=true; repeat blockread(inp,Block^,BufSize,nr); pars.DestOffset:=XMSposr; pars.Length:=nr; if isXMS then XMSMove(@pars); inc(XMSposr,nr); if isXMS then if XMSposr=XMSsize*1024 then done:=true; inc(fpos,nr); if nr