OS/2, eCS & ArcaOS - Technical > Utilities
"Pack this tree" on XWorkplace - ArcaOS
ivan:
Hi Doug and Pete,
I couldn't find it on the hard disk so I installed it from the DVD. I am now a happy camper with my usual icons back - thanks
Pete, take care of yourself and don't over do it too soon.
Martin Iturbide:
Thanks for the feedback. I have the "Pack this tree" back on the WPS. Thanks Doug.
Regards
Andreas Schnellbacher:
Hi all, I've finally ported my GetRealCase function to REXX and have created a replacement for XWP's packtree.cmd. I always found it annoying that the original script always creates uppercased zip filenames. (I guess it's an XWP bug when the Configuration folder feature is used.)
Here's a replacement/extension. It also adds the zip option 'S' (include system and hidden files):
* Create a new file. Give it the name e.g. PackTreeRealCase.cmd.
* Copy the contents of the following code into it.
* Then open the properties of the program object System Setup -> XWorkplace Configuration Folder -> Folder actions -> Pack tree.
* Under "Path and filename" replace the entry with: <path>PackTreeRealCase.cmd, where <path> is the path where you placed the .cmd file. Let the other fileds empty.
* To restore the original behavior, just restore the entry, e.g. C:\sys\apps\xwps\bin\packtree.cmd
--- Code: ---/* REXX ------------------------------------------------------------------ */
/* This is a replacement for XWP's packtree.cmd. */
/* It works around the XWP flaw to always return the filename of a folder */
/* in uppercase. */
/* Therefore it uses the GetRealCase function. That uses SysFileTree, */
/* which uses DosFind* to query the real case of a file spec. */
/* Unfortunately DosFind* returns only the last segment in the correct */
/* case, so it must be processed segment-wise. */
/* Additionally, several ZipOptions are specified and the default value */
/* (the last one) was changed. */
'@ECHO OFF'
CALL RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
CALL SysLoadFuncs
/* The last one is the active one */
ZipOptions = '-r9' /* original XWP */
ZipOptions = '-rSX9' /* with system attributes, without EAs */
ZipOptions = '-rS9' /* with system attributes */
Dirname = DIRECTORY()
Dirname = GetRealCase( Dirname)
Foldername = FILESPEC( 'NAME', Dirname)
SAY 'Packing 'Dirname' into file 'Foldername'.zip...'
'zip 'ZipOptions' ..\'Foldername'.zip *'
EXIT
/* ----------------------------------------------------------------------- */
/* Gets the real case of a file system object. Returns the input if it */
/* doesn't exist. */
/* DosFind* for a filename or dirname returns the correct case, but only */
/* for the last segment. To get the correct case for the entire string, it */
/* must be processed segment-wise. */
GetRealCase:
DO 1
PARSE ARG FileMask
fFile = 0
fDir = 0
rc = 0
/* Process only full file specs */
IF SUBSTR( FileMask, 2, 1) <> ':' THEN
LEAVE
/* Check if dir or file to call the correct proc for the last segment */
SELECT
WHEN FileExist( FileMask) THEN
fFile = 1
WHEN DirExist( FileMask) THEN
fDir = 1
/* Handle drive only */
WHEN RIGHT( FileMask, 1) = ':' THEN
DO
FileMask = TRANSLATE( FileMask)
LEAVE
END
OTHERWISE
/* Process only existing file specs */
LEAVE
END
Rest = FileMask
NewFileMask = ''
DO WHILE Rest <> ''
PARSE VALUE Rest WITH Next'\'Rest
IF Next = '' THEN
ITERATE
/* Drive */
IF RIGHT( next, 1) = ':' THEN
DO
NewFileMask = NewFileMask''TRANSLATE( Next)
/* For root dir: append '\' here, because no more segemnt exists */
IF RIGHT( FileMask, 2) = ':\' THEN
NewFileMask = NewFileMask'\'
ITERATE
END
IF Rest = '' THEN
DO
/* Last segment */
SELECT
WHEN fFile THEN
DO
NewFileMask = NewFileMask'\'Next
Found. = ''
Found.0 = 0
rcx = SysFileTree( NewFileMask, 'Found.', 'FO')
IF Found.0 > 0 THEN
NewFileMask = Found.1
END
WHEN fDir THEN
DO
NewFileMask = NewFileMask'\'Next
Found. = ''
Found.0 = 0
rcx = SysFileTree( NewFileMask, 'Found.', 'DO')
IF Found.0 > 0 THEN
NewFileMask = Found.1
END
END
END
ELSE
DO
/* Other segments */
NewFileMask = NewFileMask'\'Next
Found. = ''
Found.0 = 0
rcx = SysFileTree( NewFileMask, 'Found.', 'DO')
IF Found.0 > 0 THEN
NewFileMask = Found.1
END
END /* DO WHILE Rest <> '' */
SAY 'FileMask = 'FileMask', NewFileMask = 'NewFileMask
FileMask = NewFileMask
END
RETURN FileMask
/* ----------------------------------------------------------------------- */
FileExist: PROCEDURE EXPOSE (GlobalVars)
rc = ERROR.NO_ERROR
PARSE ARG Filename
IF FileName = '' THEN
RETURN( 0)
ELSE
RETURN( STREAM( Filename, 'C', 'QUERY EXISTS') <> '')
/* ------------------------------------------------------------------------- */
DirExist: PROCEDURE EXPOSE (GlobalVars)
rc = ERROR.NO_ERROR
PARSE ARG Dirname
Found.0 = 0
rcx = SysFileTree( Dirname, 'Found.', 'DO')
RETURN( Found.0 > 0)
--- End code ---
Navigation
[0] Message Index
[*] Previous page
Go to full version