home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 2: PC
/
frozenfish_august_1995.bin
/
bbs
/
d09xx
/
d0904.lha
/
Fill
/
Source
/
Fill.e
< prev
Wrap
Text File
|
1993-08-26
|
20KB
|
688 lines
/*
Fill V1.1. Smart Multi-file Mover.
Copyright ⌐1993 Barry Wills. All rights reserved.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
HISTORY:
~~~~~~~
V0.10b - First release May 1993.
~~~~~~
1. Locks destination. Doesn't care if it's a floppy.
2. Locks source. Source is always current directory.
3. Examines contents of source directory. Stores filenames and sizes in
a list in descending order.
4. Checks free space on destination. Gets from list largest files that
will fit on destination. Moves files to destination. Continues
until list is emptied or files remaining in list won't fit on an
empty volume.
5. Prompts for disk-change when volume becomes full.
6. Displays number of unused bytes on a finished volume.
7. Supports options:
-b## Copy buffer size (1-100k; default 20)
-c Copy only. Don't move files. (default MOVE FILES)
-e## Error Margin for storage estimate (1-20 blocks; default 0)
8. Preserves file attributes.
9. Recovers from full disk error (untested.)
V0.11b - Released (I forgot.)
~~~~~~
1. Corrected erroneous check for file too big to fit on empty volume.
V0.10b would keep asking for another disk, even though a file would
not fit on an empty volume. User had to enter 'Q' or 'q' to quit at
the prompt.
2. Corrected to get the destination infodata before displaying free
space when exiting the program. Previously, the free space shown
upon exiting was the free space on the destination BEFORE the last
file was copied/moved. (oops)
V0.12b - Released 22 May 93.
~~~~~~
1. Added Ctrl-C abort capability.
V1.0 - Released 13 Jun 93.
~~~~
1. Removed from beta status.
2. New command-line argument for source dev:directory.
3. Now using arp.library to select filenames by pattern.
V1.1 - Released 24 Jul 93.
~~~~
1. Added -n switch for "no overhead consideration", intended for use
with MS-DOS floppies.
2. Cosmetic adjustment of status messages.
3. If a destination directory is specified, the file name was prepended
with the directory name instead of being placed in the destination
directory.
*/
MODULE 'dos/dos'
MODULE 'libraries/arpbase'
MODULE 'arp'
PMODULE 'PMODULES:commandLineArgs'
PMODULE 'PMODULES:upperChar'
/* Runtime exceptions. */
ENUM ER_NONE,
ER_OPEN_ARPLIBRARY,
ER_USAGE,
ER_DEST_LOCK,
ER_SOURCE_SPEC,
ER_DEST_INFO,
ER_FILES_TOO_LARGE,
ER_MEM,
ER_WONT_FIT,
ER_USER_ABORT
RAISE ER_MEM IF New () = NIL,
ER_MEM IF String () = NIL
DEF copyBuffer /* Will be allocated. */
CONST SIZEOF_A_FILE_BLOCK = 35136,
NUMBLOCKS_USED_ON_BLANK_DISK_AMIGA_880K = 2,
NUMBLOCKS_USED_ON_BLANK_DISK_IBM_720K = 14
/*=== List definitions. ==================================================*/
/* NOTE: I did this stuff before I tried playing with E lists. It works */
/* so I won't try changing it until the next release. */
OBJECT fl_ElementType
fileName : LONG /* ptr to string */
fileSize : LONG /* long int */
fileProtection : LONG /* long int */
ENDOBJECT
/* fl_ElementType */
OBJECT fl_NodeType
element : LONG /* ptr to fl_ElementType */
nextNode : LONG /* ptr to fl_NodeType */
ENDOBJECT
/* fl_NodeType */
OBJECT fl_ListType
head : LONG /* all ptr to fl_NodeType */
tail : LONG
current : LONG
ENDOBJECT
/* fl_ListType */
/*=== Command-line argument defs. ========================================*/
CONST MAX_ARG_BUFSIZE = 100,
MAX_ARG_ERRORMARGIN = 20,
MAX_DEPTH_OF_COMPARISON = 2
DEF optionIsSet_CopyOnly = FALSE,
argBufSize = 20,
argErrorMargin = 0,
argSourceSpec = NIL,
argDestPath = NIL,
argNoDosOverHead = FALSE,
sourceDir [108] : STRING,
sourcePathAndFilename [108] : STRING,
destPathAndFilename [108] : STRING,
numblocksUsedOnABlankDisk = NUMBLOCKS_USED_ON_BLANK_DISK_AMIGA_880K,
userAbort = FALSE
/*=== Command-line Argument Parser =======================================*/
PROC getSourceDir ()
DEF c
c := StrLen (argSourceSpec)
WHILE (c-- > 0) AND
(argSourceSpec [c] <> ":") AND
(argSourceSpec [c] <> "/") DO NOP
IF c = 0
StrCopy (sourceDir, '', ALL)
ELSE
INC c
WHILE c-- >= 0 DO sourceDir [c] := argSourceSpec [c]
SetStr (sourceDir, StrLen (sourceDir))
ENDIF
ENDPROC
PROC parseCommandLineArguments () HANDLE
DEF index = 1,
char,
theArg : PTR TO CHAR
theArg := String (StrLen (arg))
WHILE getArg (theArg, index)
INC index
char := theArg [0]
IF char = "-"
char := theArg [1]
SELECT char
CASE "c"
optionIsSet_CopyOnly := TRUE
CASE "b"
/* Use nextArg to save storage. */
/* MidStr (nextArg, theArg, 2, ALL) */
argBufSize := Val (/*nextArg*/ (theArg+2), NIL)
IF argBufSize <=0 THEN Raise (ER_USAGE)
IF argBufSize > MAX_ARG_BUFSIZE THEN argBufSize := MAX_ARG_BUFSIZE
CASE "e"
/* Use nextArg to save storage. */
/* MidStr (nextArg, theArg, 2, ALL) */
argErrorMargin := Val (/*nextArg*/ (theArg+2), NIL)
IF argErrorMargin <=0 THEN Raise (ER_USAGE)
IF argErrorMargin > MAX_ARG_ERRORMARGIN THEN argErrorMargin := MAX_ARG_ERRORMARGIN
CASE "n"
argNoDosOverHead := TRUE
numblocksUsedOnABlankDisk := NUMBLOCKS_USED_ON_BLANK_DISK_IBM_720K
ENDSELECT
ELSEIF argSourceSpec = NIL
argSourceSpec := String (StrLen (theArg))
StrCopy (argSourceSpec, theArg, ALL)
ELSEIF argDestPath = NIL
argDestPath := String (StrLen (theArg))
StrCopy (argDestPath, theArg, ALL)
ELSE /* Too many args. */
Raise (ER_USAGE)
ENDIF
ENDWHILE
IF (argSourceSpec = NIL) OR
(argDestPath = NIL) THEN Raise (ER_USAGE)
Dispose (theArg)
getSourceDir ()
EXCEPT
Raise (exception)
ENDPROC
/* parseCommandLineArguments */
/*=== Begin File List Implementation =====================================*/
/*------------------------------------------------------------------------
These functions are used to gain easy access to the list substructures.
--------------------------------------------------------------------------*/
PROC fl_FileSizeFrom (theElement)
DEF el : PTR TO fl_ElementType
el := theElement
ENDPROC el.fileSize /* long int */
PROC fl_ElementFrom (theNode)
DEF node : PTR TO fl_NodeType
node := theNode
ENDPROC node.element /* ptr to fl_ElementType */
PROC fl_NextNodeFrom (theNode)
DEF node : PTR TO fl_NodeType
node := theNode
ENDPROC node.nextNode /* ptr to fl_ElementType */
/*------------------------------------------------------------------------
These functions are used to manipulate the list.
--------------------------------------------------------------------------*/
PROC fl_New ()
DEF newFileList : PTR TO fl_ListType,
head : PTR TO fl_NodeType,
tail : PTR TO fl_NodeType
newFileList := New (SIZEOF fl_ListType)
newFileList.head := New (SIZEOF fl_NodeType)
newFileList.tail := New (SIZEOF fl_NodeType)
head := newFileList.head
tail := newFileList.tail
head.nextNode := newFileList.tail
tail.nextNode := NIL
head.element := NIL
tail.element := NIL
newFileList.current := newFileList.head
ENDPROC newFileList /* fl_ListType */
/* fl_New */
PROC fl_Insert (theElement, theList)
DEF newNode : PTR TO fl_NodeType,
element : PTR TO fl_ElementType,
list : PTR TO fl_ListType,
current : PTR TO fl_NodeType,
newElement : PTR TO fl_ElementType
element := theElement
list := theList
list.current := list.head
WHILE (fl_NextNodeFrom (list.current) <> list.tail) AND
fl_IsLessThan (element, fl_ElementFrom (fl_NextNodeFrom (list.current)))
list.current := fl_NextNodeFrom (list.current)
ENDWHILE
current := list.current /* shorten name to get at substructure */
newNode := New (SIZEOF fl_NodeType)
newNode.element := New (SIZEOF fl_ElementType)
newElement := newNode.element
newElement.fileName := element.fileName
newElement.fileSize := element.fileSize
newElement.fileProtection := element.fileProtection
element.fileName := NIL /* detach pointer so that list owns it */
newNode.nextNode := current.nextNode
current.nextNode := newNode
ENDPROC TRUE
/* fl_Insert */
PROC fl_RetrieveFirst (theList)
DEF list : PTR TO fl_ListType
IF fl_IsEmpty (theList) THEN RETURN NIL
list := theList
list.current := fl_NextNodeFrom (list.head)
RETURN fl_ElementFrom (list.current)
ENDPROC
/* fl_RetrieveFirst */
PROC fl_RetrieveNext (theList)
DEF list : PTR TO fl_ListType
IF fl_IsEmpty (theList) THEN RETURN NIL
list := theList
IF fl_NextNodeFrom (list.current) = list.tail THEN RETURN NIL
list.current := fl_NextNodeFrom (list.current)
RETURN fl_ElementFrom (list.current)
ENDPROC
/* fl_RetrieveNext */
PROC fl_RemoveCurrent (theList)
DEF list : PTR TO fl_ListType,
current : PTR TO fl_NodeType,
node : PTR TO fl_NodeType,
element : PTR TO fl_ElementType
IF fl_IsEmpty (theList) THEN RETURN NIL
list := theList
/* find node */
IF list.current = list.head THEN RETURN NIL
/* current undefined; must call one */
/* of the functions that set current. */
IF list.current = list.tail THEN RETURN NIL
/* At end of list. */
current := list.head
WHILE (current.nextNode <> list.current)
current := current.nextNode
ENDWHILE
/* detach node */
node := list.current
current.nextNode := node.nextNode
list.current := current
/* this sets up for a possible subsequent call to fl_RetrieveNext. */
/* remove element and deallocate node */
element := node.element
Dispose (node)
RETURN element
ENDPROC
/* fl_RemoveCurrent */
PROC fl_IsLessThan (thisElement, thatElement)
RETURN fl_FileSizeFrom (thisElement) < fl_FileSizeFrom (thatElement)
ENDPROC
PROC fl_IsEmpty (theList)
DEF list : PTR TO fl_ListType
list := theList
RETURN fl_NextNodeFrom (list.head) = list.tail
ENDPROC
/*=== End File List Implementation =======================================*/
PROC enoughRoomOnDest (theDestInfo : PTR TO infodata,
theElement : PTR TO fl_ElementType)
DEF numBytesFree,
numBytesRequired,
numFileExtensionBlocks,
numBytesForFileExtensionBlocks
IF theElement = NIL THEN RETURN FALSE
/* Compute what DOS says is free. */
numBytesFree := Mul ((theDestInfo.numblocks - theDestInfo.numblocksused),
theDestInfo.bytesperblock)
IF argNoDosOverHead
numBytesRequired := theElement.fileSize
ELSE
/*------------------------------------------------*/
/* Storage required by DOS filesystem = */
/* file_size_in_bytes + */
/* one_block_for_file_header + */
/* number_file_extension_blocks_required * */
/* bytes_per_block */
/*------------------------------------------------*/
numFileExtensionBlocks := Div (theElement.fileSize, SIZEOF_A_FILE_BLOCK)
numBytesForFileExtensionBlocks := Mul (numFileExtensionBlocks,
theDestInfo.bytesperblock)
numBytesRequired := theElement.fileSize + /* file size */
theDestInfo.bytesperblock + /* file header */
numBytesForFileExtensionBlocks + /* extension blocks */
(argErrorMargin *
theDestInfo.bytesperblock)
ENDIF
/*** LEAVE THESE IN JUST IN CASE SOMEONE REPORTS ERRORS ********************
WriteF ('\n\nfilename \s', theElement.fileName)
WriteF ('\n filesize \d', theElement.fileSize)
WriteF ('\n numblocks \d', theDestInfo.numblocks)
WriteF ('\n numblocksused \d', theDestInfo.numblocksused)
WriteF ('\n bytesperblock \d', theDestInfo.bytesperblock)
WriteF ('\n numbytesfree \d', numBytesFree)
WriteF ('\n numFileExtensionBlocks \d', numFileExtensionBlocks)
WriteF ('\n numBytesForFileExtensionBlocks \d', numBytesForFileExtensionBlocks)
WriteF ('\n numBytesRequired \d', numBytesRequired)
Raise (0)
***************************************************************************/
ENDPROC numBytesRequired <= numBytesFree
/* enoughRoomOnDest */
PROC moveFile (theElement : PTR TO fl_ElementType) HANDLE
DEF sourceFileHandle = NIL,
destFileHandle = NIL,
bytesRead,
bytesWritten = 1
StringF (sourcePathAndFilename, '\s\s',
sourceDir, theElement.fileName)
StringF (destPathAndFilename, '\s\s\s',
argDestPath,
IF Char (argDestPath + StrLen (argDestPath) - 1) = ":" THEN '' ELSE '/',
theElement.fileName)
WriteF ('\n \s \s ...',
IF optionIsSet_CopyOnly THEN 'Copying' ELSE 'Moving',
sourcePathAndFilename)
sourceFileHandle := Open (sourcePathAndFilename, OLDFILE)
IF sourceFileHandle = NIL THEN Raise ('Error opening file for input.')
destFileHandle := Open (destPathAndFilename, NEWFILE)
IF destFileHandle = NIL THEN Raise ('Error opening file for output.')
REPEAT
bytesRead := Read (sourceFileHandle, copyBuffer, argBufSize)
IF bytesRead > 0
bytesWritten := Write (destFileHandle, copyBuffer, bytesRead)
IF bytesWritten <> bytesRead THEN Raise (ER_WONT_FIT)
ENDIF
userAbort := CtrlC ()
UNTIL (bytesRead < 1) OR
(bytesWritten < 1) OR
userAbort
Close (destFileHandle)
Close (sourceFileHandle)
/* Check for IO error. */
IF bytesRead < 0 THEN Raise ('Error reading input file.')
IF bytesWritten < 0 THEN Raise ('Error writing output file.')
IF userAbort = FALSE
IF optionIsSet_CopyOnly
WriteF (' copied.')
ELSE
DeleteFile (sourcePathAndFilename)
WriteF (' moved.')
ENDIF
IF SetProtection (destPathAndFilename, theElement.fileProtection) = FALSE
WriteF ('\nFailed to set protection bits for \s.', theElement.fileName)
ENDIF
ELSE
DeleteFile (destPathAndFilename)
ENDIF
EXCEPT
IF sourceFileHandle THEN Close (sourceFileHandle)
IF destFileHandle THEN Close (destFileHandle)
SELECT exception
CASE ER_WONT_FIT
WriteF ('\n didn\at fit. Trying a smaller one.')
DeleteFile (destPathAndFilename)
RETURN FALSE
DEFAULT
WriteF ('\n\n\s', exception)
ENDSELECT
Raise (exception)
ENDPROC TRUE
/* moveFile */
PROC main () HANDLE
DEF anchorPath : anchorpath, /* Arp object. */
sourceFib : fileinfoblock,
destLock = NIL,
destInfo : infodata,
fileList : PTR TO fl_ListType,
element : PTR TO fl_ElementType,
sourceFindSuccess,
destInfoSuccess,
fileName,
checkingForFile,
char,
newDisk = TRUE,
filesMoved = 0
WriteF ('\n Fill V1.1. Smart Multi-file Mover/Copier.' +
'\n Copyright ⌐1993 Barry Wills. All rights reserved.')
/* OPEN ARP LIBRARY. */
IF (arpbase := OpenLibrary ('arp.library', 39)) = NIL
Raise (ER_OPEN_ARPLIBRARY)
ENDIF
/* GET COMMAND LINE ARGUMENTS. */
IF arg [] = 0 THEN Raise (ER_USAGE)
copyBuffer := New ((argBufSize * 1024))
fileList := fl_New ()
parseCommandLineArguments ()
/* CHECK DESTINATION VALIDITY. */
IF (destLock := Lock (argDestPath, SHARED_LOCK)) = NIL THEN Raise (ER_DEST_LOCK)
/* CHECK SOURCE VALIDITY. */
anchorPath.breakbits := SIGBREAKF_CTRL_C /* Arp: allow user to abort. */
anchorPath.strlen := 0
IF (sourceFindSuccess := FindFirst (argSourceSpec, anchorPath)) <> 0
Raise (ER_SOURCE_SPEC)
ENDIF
/* GET SOURCE FILE LIST. */
WriteF ('\n\n Getting file list.')
/* Put filenames and sizes in a list, */
/* sorted on filesize by fl_Insert(). */
WHILE sourceFindSuccess = 0
sourceFib := anchorPath.info
IF sourceFib.direntrytype < 0
fileName := String (108)
StrCopy (fileName, sourceFib.filename, ALL)
fl_Insert ([fileName, sourceFib.size, sourceFib.protection], fileList)
ENDIF
sourceFindSuccess := FindNext (anchorPath)
ENDWHILE
/* FINISHED WITH ARP. */
FreeAnchorChain (anchorPath); anchorPath := NIL
CloseLibrary (arpbase); arpbase := NIL
/* MOVE FILES. */
WHILE fl_IsEmpty (fileList) = FALSE
IF newDisk OR (element = NIL)
element := fl_RetrieveFirst (fileList)
newDisk := FALSE
filesMoved := 0
WriteF ('\n')
ELSE
element := fl_RetrieveNext (fileList)
ENDIF
destInfoSuccess := Info (destLock, destInfo)
IF destInfoSuccess = FALSE THEN Raise (ER_DEST_INFO)
checkingForFile := TRUE
WHILE checkingForFile
IF element = NIL
checkingForFile := FALSE
ELSEIF enoughRoomOnDest (destInfo, element)
checkingForFile := FALSE
ELSE
element := fl_RetrieveNext (fileList)
ENDIF
ENDWHILE
IF element <> NIL
element := fl_RemoveCurrent (fileList)
moveFile (element)
IF userAbort THEN Raise (ER_USER_ABORT)
INC filesMoved
Dispose (element)
ELSEIF destInfo.numblocksused = numblocksUsedOnABlankDisk
Raise (ER_FILES_TOO_LARGE)
ELSE
/* Disk filled; prompt for another. */
WriteF ('\n\s', IF filesMoved THEN '' ELSE '\nNo files moved/copied.')
WriteF ('\nUnused bytes = \d.',
Mul ((destInfo.numblocks - destInfo.numblocksused),
destInfo.bytesperblock))
WriteF ('\nInsert next volume. Press RETURN to proceed, \aQ\a or \aq\a to discontinue...')
char := Inp (stdout)
IF char <> 10 THEN WHILE Inp (stdout) <> 10 DO NOP /* Flush input buffer. */
IF upperChar (char) = "Q" THEN Raise (ER_USER_ABORT)
UnLock (destLock)
IF (destLock := Lock (argDestPath, SHARED_LOCK)) = NIL THEN Raise (ER_DEST_LOCK)
newDisk := TRUE
ENDIF
ENDWHILE
/* Display unused bytes on destination before leaving program. */
destInfoSuccess := Info (destLock, destInfo)
IF destInfoSuccess = FALSE THEN Raise (ER_DEST_INFO)
WriteF ('\n\nUnused bytes = \d.',
Mul ((destInfo.numblocks - destInfo.numblocksused),
destInfo.bytesperblock))
/* Clean up. */
UnLock (destLock)
WriteF ('\n\n')
CleanUp (0);
EXCEPT
WriteF ('\n\n')
SELECT exception
CASE ER_OPEN_ARPLIBRARY;
WriteF ('Error opening arp.library V39+')
CASE ER_USAGE
WriteF (' Usage: Fill [<options>] <source> <dest>' +
'\n <source> Any valid DOS "dev:dir/filepat", ARP wildcards supported' +
'\n <dest> Any valid DOS "dev:dir"' +
'\n [<options>]' +
'\n -b## Buffer size in kbytes (1-\d; default 20)' +
'\n -c Copy files only, don\at delete source (default MOVE FILES)' +
'\n -e## Error margin, add blocks to storage estimate (1-\d; default 0)' +
'\n -n No DOS overhead considerations (use on MS-DOS floppies)',
MAX_ARG_BUFSIZE, MAX_ARG_ERRORMARGIN)
CASE ER_DEST_LOCK; WriteF (' *** Destination \s does not exist.', argDestPath)
CASE ER_SOURCE_SPEC; WriteF (' *** No entries found.')
CASE ER_MEM; WriteF (' *** Insufficient memory.')
CASE ER_DEST_INFO; WriteF (' *** Error occurred while getting destination Info.')
CASE ER_FILES_TOO_LARGE
WriteF (' *** Remaining file(s) too large to fit on destination.')
CASE ER_USER_ABORT; WriteF (' *** Program aborted by request.')
DEFAULT; NOP
ENDSELECT
IF destLock THEN UnLock (destLock)
/* Arp stuff. */
IF anchorPath THEN FreeAnchorChain (anchorPath)
IF arpbase THEN CloseLibrary (arpbase)
WriteF ('\n\n')
CleanUp (RETURN_WARN);
ENDPROC