Post by Steve WendtFTP
accepts wildcards
Having thought about it, so should an app copying one file. To be able
to use T*.MPG instead of "The Schaffhausen Orchesta - Second Practice
DVD Recording.MPG".
Below is a Q&D Rexx version. It's rather easy to add support for
multiple files, there's room for improvement, an audio signal may be
added when it's done, most likely the math isn't perfect, and it
supports the same maximum file size the Rexx interpreter of your
choice.
--
/* XLCopy.CMD */
CALL RxFuncAdd 'SysLoadFuncs','Rexxutil','SysLoadFuncs'
CALL SysLoadFuncs
CALL SysCls
PARSE ARG args
IF args='' THEN DO
SAY
SAY 'XLCopy copies a single file and displays a progress indicator.'
SAY
SAY 'Usage:'
SAY
SAY ' XLCOPY.CMD <file> <drive>'
SAY
SAY 'Example:'
SAY
SAY ' XLCOPY.CMD "U:\First R*.MPG" I:'
SAY
EXIT
END
PARSE VAR args file drive
IF Left(file,1)='"' THEN PARSE VAR args '"' file '"' drive
IF drive='' THEN DO
SAY 'Error: no target drive specified'
EXIT
END
IF Length(drive)<>2 '' THEN DO
SAY 'Error: no valid target drive specified'
EXIT
END
IF Right(drive,1)<>':' THEN DO
SAY 'Error: no valid target drive specified'
EXIT
END
drive=Translate(drive)
drives=SysDriveMap()
IF Pos(drive,drives,1)=0 THEN DO
SAY 'Error: drive' drive 'not found'
EXIT
END
IF SysFileTree(file,'files.','FO')=2 THEN DO
SAY 'Error: not enough memory available to query a list of files'
EXIT
END
IF files.0=0 THEN DO
SAY 'Error: no files found matching' file
EXIT
END
IF files.0>1 THEN DO
SAY 'Error: more than one file is matching' file
EXIT
END
free=SysDriveInfo(drive)
IF free='' THEN DO
SAY 'Error: drive' drive 'not accessible'
EXIT
END
size=Stream(files.1,'C','QUERY SIZE')
IF Word(free,2)<size THEN DO
SAY 'Error: not enough free space available on drive' drive
EXIT
END
IF size=0 THEN DO
SAY 'Error: size of file' files.1 'is 0'
EXIT
END
name=FileSpec('N',files.1)
target=drive||name
IF Stream(target,'C','QUERY EXISTS')<>'' THEN DO
SAY 'Error: file' name 'already exists on drive' drive
EXIT
END
PARSE VALUE SysTextScreenSize() WITH height width
IF height<3 THEN DO
SAY 'Error: the height of the screen is not at least 3 characters'
EXIT
END
IF width<3 THEN DO
SAY 'Error: the width of the screen is not at least 3 characters'
EXIT
END
SAY
PARSE VALUE SysCurPos() WITH y .
CALL CharOut '','|'
DO x=1 TO width-2
CALL CharOut '','-'
END x
CALL CharOut '','|'
pixel=size/(width-2)
firstpixel=1
pixels=0
read=0
readtotal=0
DO WHILE Chars(files.1)>0
data=CharIn(files.1,,8192)
len=Length(data)
read=read+len
readtotal=readtotal+len
CALL CharOut target,data
IF read>=pixel THEN DO
pixels=pixels+1
pixels=Max(pixels,Format((readtotal/size)*(width-2)+0.5,,0))
IF pixels>width-2 THEN pixels=width-2
read=0
DO x=firstpixel TO pixels
CALL SysCurPos y,x
CALL CharOut '','='
END x
firstpixel=pixels
END
END
CALL CharOut files.1
CALL CharOut target
SAY
EXIT