home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
ifd98149.zip
/
INIDUMP.CMD
Wrap
OS/2 REXX Batch file
|
1998-05-29
|
14KB
|
504 lines
/*
* Pgm Name : E:\DB\BATCH\CMD\HTMLPP.CMD
* Pgm Version : 98.144
* Time : Friday, 29 May 1998 8:29:12pm
* Input File : E:\DB\PROJECTS\OS2\inidump\INIDUMP.X
* Output File : .\OUT\INIDUMP.CMD
*/
/*
* $Header: E:/DB/PVCS.IT/OS2/INIDUMP/INIDUMP.X_V 1.3 29 May 1998 20:29:04 Dennis_Bareis $/htmlpp/HtmlPP.cmv 1.4 07 Nov 1997 15:40:04 Dennis_Bareis $/htmlpp/HtmlPP.cmv 1.3 07 Nov 1997 15:18:38 Dennis_Bareis $/htmlpp/HtmlPP.cmv 1.2 07 Nov 1997 10:57:22 Dennis_Bareis $/PLATFORM/PLATFRM.X_V 1.5 11 Oct 1996 16:40:40 Dennis_Bareis $/PLATFORM/PLATFRM.X_V 1.4 11 Oct 1996 16:26:28 Dennis_Bareis $/PLATFORM/PLATFRM.X_V 1.3 17 Sep 1996 10:51:38 Dennis_Bareis $
*/
call RxFuncAdd 'SysIni', 'RexxUtil', 'SysIni'
call RxFuncAdd 'SysFileTree', 'RexxUtil', 'SysFileTree'
NewSingleQuote = "' || " || '"' || "'" || '" || ' || "'"
ExitRc = 0
PGM_VERSION = "98.149"
/*
* FASTINI.XH Version 98.147 by Dennis Bareis
* http://www.ozemail.com.au/~dbareis (db0@anz.com)
*/
_FiOpenCount = 0
call RxFuncAdd 'FastIniStart', 'FastIni', 'FastIniStart'
call RxFuncAdd 'FastIniEnd', 'FastIni', 'FastIniEnd'
call RxFuncAdd 'FastIniVersion', 'FastIni', 'FastIniVersion'
_fiAvailable = _FastIniOk()
signal EndFASTINIXh
FastIniIsFast:
return(_fiAvailable)
FastIniOpenIni:
_fiFile = arg(1)
_fiHandleVar = arg(2)
if _fiAvailable = 'N' then
do
interpret _fiHandleVar || ' = 0'
return('OK')
end
interpret _fiHandleVar || ' = ""'
_fiFastRc = FastIniStart(_fiFile, _fiHandleVar)
interpret '_FiHandle = ' || _fiHandleVar
if _FiHandle <> '' then
do
_FiOpenCount = _FiOpenCount + 1
_FiOpenedList._FiOpenCount = _FiHandle
end
return(_fiFastRc)
FastIniCloseIni:
if _fiAvailable = 'N' then
return('OK')
return( FastIniEnd(arg(1)) )
FastIniGetVersion:
if _fiAvailable = 'Y' then
return( FastIniVersion(arg(1)) )
else
do
interpret arg(1) || ' = "00.000 http://www.ozemail.com.au/~dbareis db0@anz.com Dennis Bareis"'
return('OK')
end
FastIniCleanup:
if _fiAvailable = 'N' then
return('OK')
do _fi = 1 to _FiOpenCount
call FastIniEnd(_FiOpenedList._fi)
_FiOpenedList._fi = 0
end
_FiOpenCount = 0
return('OK')
_FastIniOk:
signal on SYNTAX name _FastIniNotOk
interpret "_fiRc = FastIniVersion('_fiVersion')"
return('Y')
_FastIniNotOk:
return('N')
EndFASTINIXh:
/*
* BIN2REXP.XH Version 98.149 by Dennis Bareis
* http://www.ozemail.com.au/~dbareis (db0@anz.com)
*/
b2rNewSingleQuote = "' || " || '"' || "'" || '" || ' || "'"
b2rAllHexCodes = ''
b2rAllAsciiCodes = ''
do b2rCharCode = 0 to 31
b2rAllHexCodes = b2rAllHexCodes || d2c(b2rCharCode)
end
do b2rCharCode = 32 to 126
b2rAllAsciiCodes = b2rAllAsciiCodes || d2c(b2rCharCode)
end
do b2rCharCode = 127 to 255
b2rAllHexCodes = b2rAllHexCodes || d2c(b2rCharCode)
end
signal EndBIN2REXPXh
_QuoteAscii:
b2rAscii2Quote = arg(1)
if pos("'", b2rAscii2Quote) = 0 then
return("'" || b2rAscii2Quote || "'")
else
do
if pos('"', b2rAscii2Quote) = 0 then
return('"' || b2rAscii2Quote || '"')
else
do
return("'" || ReplaceString(b2rAscii2Quote, "'", b2rNewSingleQuote) || "'")
end
end
_FormatHex:
b2rHexString = arg(1)
b2rLengthHex = length(b2rHexString)
b2rFormattedHex = "'"
if b2rLengthHex > 7 then
do
b2rLeft1 = left(b2rHexString, 1)
b2rLeft1Pos = verify(b2rHexString, b2rLeft1)
if b2rLeft1Pos = 0 then
return( "copies('" || c2x(b2rLeft1) || "'x, " || b2rLengthHex || ")" )
else
do
if b2rLeft1Pos > 7 then
do
b2rFormattedHex = "copies('" || c2x(b2rLeft1) || "'x, " || b2rLeft1Pos-1 || ") || '"
b2rHexString = substr(b2rHexString, b2rLeft1Pos)
b2rLengthHex = b2rLengthHex - (b2rLeft1Pos-1)
end
end
end
do b2rCharPosn = 1 to b2rLengthHex
if (b2rCharPosn // 8) = 1 then
do
if b2rCharPosn <> 1 then
b2rFormattedHex = b2rFormattedHex || ' '
end
b2rFormattedHex = b2rFormattedHex || c2x(substr(b2rHexString, b2rCharPosn, 1))
end
b2rFormattedHex = b2rFormattedHex || "'x"
return(b2rFormattedHex)
_QuoteAsciiBreakIfRequired:
qabAscii = arg(1)
qabLength = length(qabAscii)
qabReturn = ''
do while qabLength > 256
qabLeft = left(qabAscii, 256)
qabAscii = substr(qabAscii, 256+1)
qabLength = qabLength - 256
if qabReturn = '' then
qabReturn = _QuoteAscii(qabLeft)
else
qabReturn = qabReturn || " || " || _QuoteAscii(qabLeft)
end
if qabLength = 0 then
return(qabReturn)
else
do
if qabReturn = '' then
return( _QuoteAscii(qabAscii) )
else
return( qabReturn || " || " || _QuoteAscii(qabAscii) )
end
_FormatHexBreakIfRequired:
fhbHex = arg(1)
fhbLength = length(fhbHex)
fhbReturn = ''
do while fhbLength > 80
fhbLeft = left(fhbHex, 80)
fhbHex = substr(fhbHex, 80+1)
fhbLength = fhbLength - 80
if fhbReturn = '' then
fhbReturn = _FormatHex(fhbLeft)
else
fhbReturn = fhbReturn || " || " || _FormatHex(fhbLeft)
end
if fhbLength = 0 then
return(fhbReturn)
else
do
if fhbReturn = '' then
return( _FormatHex(fhbHex) )
else
return( fhbReturn || " || " || _FormatHex(fhbHex) )
end
BIN2REXP:
call BIN2REXP_START
b2rValue = arg(1)
b2rValueLength = length(b2rValue)
if b2rValueLength = 0 then
call BIN2REXP_ONEBIT '""'
else
do
do while b2rValue \== ''
b2rEndAsciiPos = verify(b2rValue, b2rAllAsciiCodes)
if b2rEndAsciiPos = 0 then
do
call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(b2rValue)
b2rValue = ''
end
else
do
if b2rEndAsciiPos <> 1 then
do
call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(left(b2rValue, b2rEndAsciiPos-1))
b2rValue = substr(b2rValue, b2rEndAsciiPos)
end
else
do
b2rEndBinaryPos = verify(b2rValue, b2rAllHexCodes)
if b2rEndBinaryPos = 0 then
do
call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(b2rValue)
b2rValue = ''
end
else
do
call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(left(b2rValue, b2rEndBinaryPos-1))
b2rValue = substr(b2rValue, b2rEndBinaryPos)
end
end
end
end
end
call BIN2REXP_END
return
EndBIN2REXPXh:
signal on HALT name RexxCtrlC
signal on NOVALUE name RexxTrapUninitializedVariable
signal on SYNTAX name RexxTrapSyntaxError
TooLongToDump = 10000
AllHexCodes = ''
AllAsciiCodes = ''
do CharCode = 0 to 31
AllHexCodes = AllHexCodes || d2c(CharCode)
end
do CharCode = 32 to 126
AllAsciiCodes = AllAsciiCodes || d2c(CharCode)
end
do CharCode = 127 to 255
AllHexCodes = AllHexCodes || d2c(CharCode)
end
IniFile = translate( strip(arg(1)) )
if IniFile = "" then
call SyntaxError 'ERROR: Expected "USER", "SYSTEM", "BOTH", or the name of an .INI file...'
if IniFile <> "USER" & IniFile <> "SYSTEM" & IniFile <> "BOTH" then
do
TreeRc = SysFileTree(IniFile, 'FileBase', 'FO')
if TreeRc <> 0 | FileBase.0 = 0 then
do
call ToStderr 'ERROR: The INI file "' || IniFile || '" does not exist.'
PgmExit( SourceLine() )
end
end
FastRc = FastIniOpenIni(IniFile, "IniHandle")
if FastRc <> 'OK' then
call ToStderr "FASTINI.DLL can not be accessed (" || FastRc || ').'
call DumpWholeIni IniFile
PgmExit(ExitRc)
PgmExit:
call FastIniCleanup
exit( arg(1) )
CommonTrapHandler:
FailingLine = arg(1)
TrapHeading = 'BUG: ' || arg(2)
TextDescription = arg(3)
Text = arg(4)
parse source . . SourceFileName
call ToStderr "
" || copies('=+', 39)
call ToStderr TrapHeading
call ToStderr copies('~', length(TrapHeading))
call ToStderr substr(TextDescription, 1 , 16) || ': ' || Text
call ToStderr 'Failing Module : ' || SourceFileName
call ToStderr 'Failing Line # : ' || FailingLine
call ToStderr 'Failing Command : ' || strip(SourceLine(FailingLine))
call ToStderr copies('=+', 39) || ""
PgmExit(FailingLine)
RexxTrapUninitializedVariable:
call CommonTrapHandler SIGL, 'NoValue Abort!', 'Unknown Variable', condition('D')
RexxTrapSyntaxError:
call CommonTrapHandler SIGL, 'Syntax Error!', 'Reason', errortext(Rc)
RexxCtrlC:
LineCtrlC = SIGL
call ToStderr ''
call ToStderr "
" || copies('=+', 39)
call ToStderr "Come on, you pressed Ctrl+C or Break didn't you!"
call ToStderr copies('=+', 39) || ""
PgmExit(LineCtrlC)
SyntaxError:
ErrorLine = SIGL
call ToStderr "[]----------------------------------------------------------[]"
call ToStderr "| INIDUMP.CMD, Version " || PGM_VERSION || " (C)opyright Dennis Bareis 1998 |"
call ToStderr '| http://www.ozemail.com.au/~dbareis (db0@anz.com) |'
call ToStderr "[]----------------------------------------------------------[]"
call ToStderr ""
call ToStderr "This program allows you to dump a whole INI file in the same format that my"
call ToStderr "INIWRITE.CMD program uses. This allows you to maintain the contents of a"
call ToStderr "binary INI file as TEXT, which means you can use any text editor, difference"
call ToStderr "programs or source management programs such as PVCS."
call ToStderr ""
call ToStderr "The dump would normally only be required ONCE to get a text form of an INI"
call ToStderr "from an external source as you would maintain the text file as TEXT adding"
call ToStderr "or commenting out bits as required."
call ToStderr ""
call ToStderr ""
call ToStderr "CORRECT SYNTAX"
call ToStderr "~~~~~~~~~~~~~~"
call ToStderr " INIDUMP[.CMD] USER|SYSTEM|BOTH|IniFileName >Output.IU"
call ToStderr ""
call ToStderr ARG(1)
PgmExit(ErrorLine)
ToStderr:
call lineout 'STDERR', arg(1)
return
DisplayError:
ExitRc = SourceLine()
say ''
say ';ERROR: ' || arg(1)
call ToStderr 'ERROR: ' || arg(1) || ''
say ''
say ''
return
DumpWholeIni:
call SysIni ARG(1), 'All:', 'aTmp.'
if Result = 'ERROR:' then
do
call DisplayError 'Could not obtain list of APPLICATION keys.'
return
end
if aTmp.0 = 0 then
do
call DisplayError 'INI file "'ARG(1)'" does not exist, or contains no data.'
return
end
call quicksort 1, aTmp.0
do i = 0 to aTmp.0
Apps.i = aTmp.i
end
do i = 1 to Apps.0
if i <> 1 then
do
say ""
say ""
say ';'copies('#', 78)
end
call SysIni ARG(1), Apps.i, 'All:', 'aTmp'
if Result = 'ERROR:' then
do
call DisplayError 'Could not obtain List of Keys for APPLICATION = 'Apps.i
iterate
end
if aTmp.0 = 0 then
do
call DisplayError 'There are no keys for application "'Apps.i'".'
iterate
end
call quicksort 1, aTmp.0
do j = 0 to aTmp.0
Keys.j = aTmp.j
end
LongestKeyName = 0
do j=1 to Keys.0
LengthKeyName = length(SubstituteStandardCodes(Keys.j))
if LengthKeyName > LongestKeyName then
LongestKeyName = LengthKeyName
end
do j=1 to Keys.0
call DumpIniValue ARG(1), Apps.i, Keys.j
end
end
return
SubstituteStandardCodes:
return( ReplaceString(arg(1), " ", "{Space}") )
BIN2REXP_START:
FormattedValue = ''
return
BIN2REXP_ONEBIT:
ToAdd = arg(1)
if FormattedValue = '' then
FormattedValue = ToAdd
else
FormattedValue = FormattedValue || " || " || ToAdd
return
BIN2REXP_END:
if pos(';' || ';', FormattedValue) = 0 then
say FormattedValue
else
say FormattedValue || ' ;' || ';Warning Leave this!'
return
DumpIniValue:
dipIniName = arg(1)
dipAppName = arg(2)
dipKeyName = arg(3)
FirstPart = SubstituteStandardCodes(dipIniName) || ' ' || SubstituteStandardCodes(dipAppName) || ' ' || left(SubstituteStandardCodes(dipKeyName), LongestKeyName) || ' '
Value = SysIni(dipIniName, dipAppName, dipKeyName)
if Value = "ERROR:" then
do
say ';' || FirstPart || '<<INI READ FAILED>>'
call DisplayError 'Could not read key = ' || dipKeyName
return
end
ValueLength = length(Value)
if ValueLength > TooLongToDump then
do
ErrorMsg = "At " || ValueLength || ' the value is too large to dump (>' || TooLongToDump || ' bytes)'
say ';' || FirstPart || ErrorMsg
call DisplayError ErrorMsg
return
end
call charout ,FirstPart || ' '
call BIN2REXP Value
return
ReplaceString:
TheString = arg(1)
ChangeFrom = arg(2)
ChangeTo = arg(3)
ChangeCntVar = arg(4)
ChangeFromLength = length(ChangeFrom)
ChangeToLength = length(ChangeTo)
FoundPosn = pos(ChangeFrom, TheString)
ReplaceStringCounter = 0
do while FoundPosn <> 0
TheString = left(TheString, FoundPosn-1) || ChangeTo || substr(TheString, FoundPosn+ChangeFromLength)
FoundPosn = pos(ChangeFrom, TheString, FoundPosn+ChangeToLength)
ReplaceStringCounter = ReplaceStringCounter + 1
end
if ChangeCntVar <> "" then
interpret ChangeCntVar || " = ReplaceStringCounter + " || ChangeCntVar
return(TheString)
SourceLine:
return(SIGL)
qsCompFunc: PROCEDURE
parse arg a, b
select
when ( a < b ) then
return(-1)
when ( a > b ) then
return(1)
otherwise
return(0)
end
QuickSort: PROCEDURE EXPOSE atmp.
parse arg top, down
if ( ( down-top ) < 2 ) then
do
if ( ( down - top ) > 0 ) then
/* if ( atmp.top > atmp.down ) then */
if ( qsCompFunc( atmp.top, atmp.down ) > 0 ) then
do
tmpval = atmp.top
atmp.top = atmp.down
atmp.down = tmpval
end
end
else
do
l = top
r = down
m = top + trunc( ( down-top )/2 )
do while ( l<r )
m_val = atmp.m
/* do while ( atmp.l < m_val ) */
do while ( qsCompFunc( atmp.l, m_val ) < 0 )
if ( l < m ) then
l=l+1
else
leave
end
/* do while ( atmp.r > m_val ) */
do while ( qsCompFunc( atmp.r, m_val ) > 0 )
if ( m < r ) then
r=r-1
else
leave
end
if ( l < r ) then
do
tmpval = atmp.l
atmp.l = atmp.r
atmp.r = tmpval
select
when ( m=r ) then
do
r = r-1
m = l
end
when ( m=l ) then
do
l = l+1
m = r
end
otherwise
do
l = l+1
r = r-1
end
end
end
end
if ( ( r-top ) < ( down-l ) ) then
do
call quicksort top, m-1
call quicksort m+1, down
end
else
do
call quicksort m+1, down
call quicksort top, m-1
end
end
return