home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
ii_98158.zip
/
ImgInfo.CMD
next >
Wrap
OS/2 REXX Batch file
|
1998-06-07
|
13KB
|
460 lines
/*
* Pgm Name : E:\DB\BATCH\CMD\PPWIZARD.CMD
* Pgm Version : 98.150
* Time : Sunday, 7 Jun 1998 6:04:12pm
* Input File : E:\DB\PROJECTS\OS2\imginfo\IMGINFO.x
* Output File : .\OUT\ImgInfo.CMD
*/
call RxFuncAdd 'SysFileTree', 'RexxUtil', 'SysFileTree'
call RxFuncAdd 'RxMessageBox', 'RexxUtil', 'RxMessageBox'
call RxFuncAdd 'SysTempFileName', 'RexxUtil', 'SysTempFileName'
call SayGarbage '[]-----------------------------------------------------------[]'
call SayGarbage '| GifInfo: Version 98.158, Reports GIF & JPG file information |'
call SayGarbage '| http://www.ozemail.com.au/~dbareis (db0@anz.com) |'
call SayGarbage '[]-----------------------------------------------------------[]'
call SayGarbage ''
Parameters = arg(1)
if Parameters = '' then
SyntaxError("No parameters supplied by caller")
parse var Parameters ImgMask ExtraParms
/*
* QSORT.XH Version 98.158 by Dennis Bareis
* The base code was not written by me (not sure where it came from
* http://www.ozemail.com.au/~dbareis (db0@anz.com)
*/
signal EndQsortXh_1
_ForwardsSort: PROCEDURE EXPOSE ImgFile.
parse arg top, down
if ( ( down-top ) < 2 ) then
do
if ( ( down - top ) > 0 ) then
/* if ( ImgFile.top > ImgFile.down ) then */
if ( FileNameSortRoutine( ImgFile.top, ImgFile.down ) > 0 ) then
do
tmpval = ImgFile.top
ImgFile.top = ImgFile.down
ImgFile.down = tmpval
end
end
else
do
l = top
r = down
m = top + trunc( ( down-top )/2 )
do while ( l<r )
m_val = ImgFile.m
/* do while ( ImgFile.l < m_val ) */
do while ( FileNameSortRoutine( ImgFile.l, m_val ) < 0 )
if ( l < m ) then
l=l+1
else
leave
end
/* do while ( ImgFile.r > m_val ) */
do while ( FileNameSortRoutine( ImgFile.r, m_val ) > 0 )
if ( m < r ) then
r=r-1
else
leave
end
if ( l < r ) then
do
tmpval = ImgFile.l
ImgFile.l = ImgFile.r
ImgFile.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 _ForwardsSort top, m-1
call _ForwardsSort m+1, down
end
else
do
call _ForwardsSort m+1, down
call _ForwardsSort top, m-1
end
end
return
ForwardsSort: PROCEDURE EXPOSE ImgFile.
call _ForwardsSort 1, ImgFile.0
return
EndQSORTXh_1:
DoSubdirs = ''
IgnoreUnknownImageExtensions = 'N'
Global.TagImgFiles = 'N'
Global.ExtendedTags = 'N'
Global.Dropped = 'N'
Global.ImportantOutput = stderr
if ImgMask = "*OBJECT_DROPPED*" then
exit( ObjectDropped(Parameters) )
do while ExtraParms <> ''
parse var ExtraParms ThisParm ExtraParms
ThisParm = translate(ThisParm)
select
when ThisParm = '/S' then
DoSubdirs = 'S'
when ThisParm = '/I' then
IgnoreUnknownImageExtensions = 'Y'
when ThisParm = '/T' then
do
Global.TagImgFiles = 'Y'
Global.ExtendedTags = 'Y'
end
otherwise
SyntaxError('Unknown command of "' || ThisParm || '" specified')
end
end
SearchRc = SysFileTree(ImgMask, 'ImgFile', 'FO' || DoSubdirs)
if SearchRc <> 0 | ImgFile.0 = 0 then
do
call SayGarbage 'ERROR: No files match "' || ImgMask || '"'
exit(900 + SearchRc)
end
call ForwardsSort
RoutineRc = 0
GifCount = 0
JpgCount = 0
call OutputHtmlHeader
do Index=1 to ImgFile.0
ThisFile = ImgFile.Index
LastDot = lastpos('.', ThisFile)
if LastPos = 0 then
ThisExtn = ''
else
ThisExtn = translate( substr(ThisFile, LastDot+1) )
select
when ThisExtn = 'GIF' then
do
GifCount = GifCount + 1
ImgRc = ReportGifInfo(ThisFile)
end
when ThisExtn = 'JPG' then
do
JpgCount = JpgCount + 1
ImgRc = ReportJpgInfo(ThisFile)
end
otherwise
do
if IgnoreUnknownImageExtensions = 'Y' then
ImgRc = 0
else
ImgRc = MyLineNumber()
end
end
if ImgRc <> 0 then
RoutineRc = ImgRc
end
call OutputHtmlTrailer
TotalImages = GifCount + JpgCount
Extras = ImgFile.0 - TotalImages
if Extras = 0 then
say 'Processed ' || GifCount || ' GIF file(s) & ' || JpgCount || ' JPEG file(s).'
else
say 'Processed ' || GifCount || ' GIF file(s) & ' || JpgCount || ' JPEG file(s) with ' || Extras || ' file(s) ignored.'
exit(RoutineRc)
HtmlFileName: procedure expose Global Global.
InFileName = arg(1)
ReasonableSize = arg(2)
OutFileName = ''
do while length(InFileName) > ReasonableSize
OutFileName = OutFileName || left(InFileName, ReasonableSize)
InFileName = substr(InFileName, ReasonableSize+1)
SlashPos = pos('\', InFileName)
if SlashPos <> 0 then
do
OutFileName = OutFileName || left(InFileName, SlashPos) || '<BR>'
InFileName = substr(InFileName, SlashPos+1)
end
end
return( OutFileName || InFileName )
OutputHtmlHeader: procedure expose Global Global.
if Global.ExtendedTags = 'Y' then
do
Title = arg(1)
if Title = '' then
Title = 'ImgInfo Output (' || date('Normal') || ' ' || time() || ')'
call SayImgInformation '<HTML><HEAD>'
call SayImgInformation '<TITLE>' || Title || '</TITLE></HEAD><BODY>'
call SayImgInformation ''
call SayImgInformation '<CENTER><TABLE COLS=2 BORDER=5 CELLSPACING=5>'
call SayImgInformation '<TR><TH ALIGN=CENTER>Details<TH ALIGN=CENTER>Image</B></TR>'
end
return
TagIt: procedure expose Global Global.
FileName = arg(1)
ImageWidth = arg(2)
ImageHeight = arg(3)
if Global.ExtendedTags = 'Y' then
do
ImageSize = AddCommasToDecimalNumber( stream(FileName, 'c', 'query size') )
call SayImgInformation '<TR><TD ALIGN=CENTER>' || HtmlFileName(FileName,20) || '<HR><B>' || ImageWidth || ' x ' || ImageHeight || '</B><BR>' || ImageSize || ' bytes<TD ALIGN=LEFT>'
end
call SayImgInformation '<IMG SRC="' || FileName || '" BORDER=0 WIDTH=' || ImageWidth || ' HEIGHT=' || ImageHeight || '>'
if Global.ExtendedTags = 'Y' then
call SayImgInformation '</TR>'
return
ImageInfoFailure: procedure expose Global Global.
ImgFile = arg(1)
ErrorText = arg(2)
call SayGarbage left(ErrorText, 23) || ImageFileName(ImgFile)
if Global.TagImgFiles = 'Y' then
do
if Global.ExtendedTags = 'Y' then
do
ImageSize = AddCommasToDecimalNumber( stream(ImgFile, 'c', 'query size') )
call SayImgInformation '<TR><TD ALIGN=CENTER>' || HtmlFileName(ImgFile,20) || '<HR>' || ImageSize || ' bytes<TD ALIGN=LEFT>'
call SayImgInformation ErrorText
call SayImgInformation '</TR>'
end
end
return
OutputHtmlTrailer: procedure expose Global Global.
if Global.ExtendedTags = 'Y' then
do
call SayImgInformation ''
call SayImgInformation '</TABLE></CENTER>'
call SayImgInformation ''
call SayImgInformation '</BODY></HTML>'
end
return
SyntaxError:
Reason = arg(1)
Location = SIGL
call SayGarbage 'CORRECT SYNTAX'
call SayGarbage '~~~~~~~~~~~~~~'
call SayGarbage ' ImgInfo[.CMD] [drive:][path][FileMask] [/s] [/t] [/i] [ 2 > Output]'
call SayGarbage ''
call SayGarbage 'WHERE'
call SayGarbage '~~~~~'
call SayGarbage ' /s = scan subdirectories.'
call SayGarbage ' /t = HTML tag the image references (sent to stderr). View generated HTML'
call SayGarbage ' in a browser to see image along with its details. Use from root dir'
call SayGarbage ' with /s to see all images on drive!'
call SayGarbage " /i = Don't set non-zero return code if unknown extensions found."
call SayGarbage ''
call SayGarbage 'THE PROBLEM'
call SayGarbage '~~~~~~~~~~~'
call SayGarbage ' ' || Reason || '.'
call SayGarbage ''
exit(Location)
MyLineNumber:
return(SIGL)
SayGarbage: procedure
say arg(1)
return
SayImgInformation: procedure expose Global Global.
call charout Global.ImportantOutput, arg(1) || d2c(13) || d2c(10)
CloseRc = stream(Global.ImportantOutput, 'c', 'close')
return
ImageFileName: procedure
FullFileName = arg(1)
FullFileNameUpper = translate( FullFileName )
ThisDir = translate( directory() )
if right(ThisDir, 1) <> '\' then
ThisDir = ThisDir || '\'
ThisDirLength = length( ThisDir )
if left(FullFileNameUpper, ThisDirLength) <> ThisDir then
return(FullFileName)
else
do
return( substr(FullFileName, ThisDirLength+1) )
end
ReportGifInfo: procedure expose Global Global.
GifFile = arg(1)
GifFormatId = charin(GifFile, 1, 6)
if left(GifFormatId,3) <> "GIF" then
do
call ImageInfoFailure GifFile, "Not a GIF file"
CloseRc = stream(GifFile, 'c', 'close')
return(MyLineNumber())
end
WidthLow = charin(GifFile,, 1)
WidthHigh = charin(GifFile,, 1)
ImageWidth = c2d(WidthHigh || WidthLow)
HeightLow = charin(GifFile,, 1)
HeightHigh = charin(GifFile,, 1)
ImageHeight = c2d(HeightHigh || HeightLow)
CloseRc = stream(GifFile, 'c', 'close')
if Global.TagImgFiles = 'N' then
call SayImgInformation right(ImageWidth, 4) || '*' || left(ImageHeight, 4) || ' | ' || GifFormatId || ' | ' || ImageFileName(GifFile)
else
call TagIt ImageFileName(GifFile), ImageWidth, ImageHeight
return(0)
ReportJpgInfo: procedure expose Global Global.
JpgFile = arg(1)
FileType = c2x(Charin(JpgFile, 1, 2))
if FileType <> "FFD8" then
do
call ImageInfoFailure JpgFile, "Not a JPEG file"
CloseRc = stream(GifFile, 'c', 'close')
return(MyLineNumber())
end
NxtSeg = 3
ImageHeight = "IMAGEHEIGHT"
do while (Type <> "D9") & (NxtSeg <> -1) & (Imageheight = "IMAGEHEIGHT")
NxtSeg = ReadJpgSegment(NxtSeg)
end
CloseRc = stream(JpgFile, 'c', 'close')
BitsMsg = ImageBPS || ' bits'
if Global.TagImgFiles = 'N' then
call SayImgInformation right(ImageWidth, 4) || '*' || left(ImageHeight, 4) || ' | ' || left(BitsMsg , 8) || ' | ' || ImageFileName(JpgFile)
else
call TagIt ImageFileName(JpgFile), ImageWidth, ImageHeight
return(0)
ReadJpgSegment:
SegPos = arg(1)
Marker = c2x( charIn(JpgFile, SegPos) )
if Marker <> "FF" then
return(-1)
Type = c2x( charIn(JpgFile) )
Res = SegPos + 2
select
when Type = "01" | Type >= "D0" & Type <= "D9" then
SegmentLength = 0
otherwise
SegmentLength = c2d( CharIn(JpgFile, , 2) )
End
Res = Res + SegmentLength
if Type = "C0" | Type = "C2" then
do
Imagebps = c2d( CharIn(JpgFile) )
Imageheight = c2d( CharIn(JpgFile, , 2) )
Imagewidth = c2d( CharIn(JpgFile, , 2) )
end
return(Res)
AddCommasToDecimalNumber: procedure
NoComma = strip( arg(1) )
if pos(',', NoComma) <> 0 then
return(NoComma)
DotPos = pos('.', NoComma)
if DotPos = 0 then
AfterDecimal = ''
else
do
if DotPos = 1 then
return("0" || NoComma)
AfterDecimal = substr(NoComma, DotPos+1)
NoComma = left(NoComma, DotPos-1)
end
NoComma = reverse(NoComma)
ResultWithCommas = ""
do while length(NoComma) > 3
ResultWithCommas = ResultWithCommas || left(NoComma, 3) || ','
NoComma = substr(NoComma, 4)
end
ResultWithCommas = ResultWithCommas || NoComma
ResultWithCommas = reverse(ResultWithCommas)
if AfterDecimal <> '' then
ResultWithCommas = ResultWithCommas || '.' || AfterDecimal
return(ResultWithCommas)
PmDebug:
Action = RxMessageBox(arg(1), "DEBUG: " || "At Line #" || SIGL, 'OK', 'INFORMATION')
return
ObjectDropped: procedure expose Global Global.
Global.Dropped = 'Y'
call Beep 2000,100
Parameters = arg(1)
parse var Parameters IgnoreCmd '"'ImgRootDir'"' ExtraParms
ExtraParms = strip(ExtraParms)
DoSubdirs = ''
TreeCmt = 'single directory'
do while ExtraParms <> ''
parse var ExtraParms ThisParm ExtraParms
ThisParm = translate(ThisParm)
select
when ThisParm = '/S' then
do
DoSubdirs = 'S'
TreeCmt = '+ subdirectories'
end
otherwise
SyntaxError('Unknown command of "' || ThisParm || '" specified')
end
end
NewDir = directory(ImgRootDir)
if translate(NewDir) <> translate(ImgRootDir) then
do
LastSlash = lastpos('\', ImgRootDir)
if LastSlash <> 0 then
ImgRootDir = left(ImgRootDir, LastSlash-1)
if length(ImgRootDir) = 2 then
ChangeDirName = ImgRootDir || '\'
else
ChangeDirName = ImgRootDir
NewDir = directory(ChangeDirName)
end
DropAmount = length(ImgRootDir) + 1 + 1
Global.ImportantOutput = SysTempFileName(ImgRootDir || '\' || 'ImgInfo.???')
Global.ExtendedTags = 'Y'
Global.TagImgFiles = 'Y'
ImgMask = ImgRootDir || '\*.*'
SearchRc = SysFileTree(ImgMask, 'ImgFile', 'FO' || DoSubdirs)
if SearchRc <> 0 | ImgFile.0 = 0 then
do
Action = RxMessageBox('No Files match "' || ImgMask || '".',, 'OK', 'ERROR')
exit(900 + SearchRc)
end
call ForwardsSort
call OutputHtmlHeader ImgRootDir || '\*.* (' || TreeCmt || ') - ' || AddCommasToDecimalNumber(ImgFile.0) || ' files found'
do Index=1 to ImgFile.0
ThisFile = ImgFile.Index
ThisFile = substr(ThisFile, DropAmount)
LastDot = lastpos('.', ThisFile)
if LastPos = 0 then
ThisExtn = ''
else
ThisExtn = translate( substr(ThisFile, LastDot+1) )
select
when ThisExtn = 'GIF' then
ImgRc = ReportGifInfo(ThisFile)
when ThisExtn = 'JPG' then
ImgRc = ReportJpgInfo(ThisFile)
otherwise
end
end
call OutputHtmlTrailer
call Beep 2200,100
NetscapeCmd = 'start /WIN /MIN "Netscape DB$" "cmd.exe /c netscape.exe "' || Global.ImportantOutput || '" & del "' || Global.ImportantOutput || '" & exit"'
address cmd NetscapeCmd
return
FileNameSortRoutine: PROCEDURE
parse arg p1, p2
p1Dir = filespec('drive', p1) || filespec('path', p1)
p2Dir = filespec('drive', p2) || filespec('path', p2)
if p1Dir < p2Dir then
return(-1)
else
do
if p1Dir > p2Dir then
return(1)
end
p1File = filespec('name', p1)
p2File = filespec('name', p2)
if p1File < p2File then
return(-1)
else
do
if p1File > p2File then
return(1)
end
return(0)