/* REXX
|
| Name: IMGINFO
|
| Author: David Alcock
| dalcock@csw.com (work)
| davea@ticnet.com (home)
|
| Purpose: Web page creation tool. Generates "" line into your edit dataset.
|
| More than likely, ISRCUT and ISRPASTE have been copied as
| as commands CUT and PASTE at your shop. If the PASTE
| command does not add a "" line into your edit
| dataset, you may be using a different CUT and PASTE. You
| will then want to copy ISRPASTE into your SYSPROC or
| SYSEXEC concatenation (as something other than PASTE like
| IPASTE or ISRPASTE) to get this CUT function.
|
| Verified: This REXX exec has been verified in April 1997 on:
| OS/390-TSO/E 2.5; VM/ESA 1.1; OS/2 Warp 3.0; and
| Object Windows beta (6.00 6 Aug 1996);
|
| Disclaimer: This REXX exec is FREEWARE. Use at your own risk. It
| is provided for your enjoyment and neither David
| Alcock or his employer provides any warranty for it's
| use. I'd like to hear how it works on your system.
|
| More notes:
| - GIF comments will only be displayed if it is in one of the "GIF
| extension blocks" immediately following the global color map.
| - GIF terms mostly taken from GIF 87a standards which was easier
| to follow.
*/
/**********************************************************************
* M o d i f i c a t i o n H i s t o r y
*
* Person Date Description
* ---------- ----------- ---------------------------------------------
* DGAlcock 05-NOV-1999 v1.5:
* - PNG support added in honor of "Burn All
* GIFs" day;
* - Added Regina Rexx on Windows 95 support;
* DGAlcock 21-APR-1998 v1.4 - Misc cleanup;
* DGAlcock 21-NOV-1997 v1.3 - Allow Batch REXX execution;
* DGAlcock 16-SEP-1997 v1.2 - Change to use CECP 1047 code page
* translate table for ASCII translation on
* EBCDIC systems;
* DGAlcock 03-APR-1997 v1.1 Corrected CUT problem and added message;
* DGAlcock 01-APR-1997 v1.0 Added GIF pixel, animation and comment
* display; Added VERBOSE and DEBUG options;
* DGAlcock 31-MAR-1997 v0.9 Initial exec written;
**********************************************************************/
vrm = '1.5'
mtype = address()
PARSE SOURCE s1 s2 s3 s4 s5 s6 s7 s8 s9
if mtype == "TSO" | mtype == "MVS" then ,
if sysvar(systsoe) > "2040" then systemid = mvsvar(syssmfid)
else do
cvt = storage(10,4)
dcvt = c2d(cvt)
smca = storage(c2x(d2c(dcvt+x2d(c5))),3)
dsmca = c2d(smca)
systemid = storage(c2x(d2c(dsmca+x2d(10))),4)
end
else systemid = ""
say "IMGINFO - version "vrm "- Freeware - Image file info utility"
say "Copyright 1997-2000 by David Alcock. All rights reserved."
say " "
say ". Executing in Environment: "s1 "-" mtype
if systemid <> "" then say ". Executing on system: "systemid
say " "
/*---------------------------------------------------------------------
| Read in the input file based on the environment
------------------------------------------------------------------- */
ebcdic = 0
select
/*--------------------------------------------------------------
| PC: OS/2, Windows 95, Windows NT, etc.
------------------------------------------------------------ */
when mtype == "CMD" | , /* Object Rexx: OS/2, Win */
mtype == "COMMAND" | , /* PC/DOS 7.0 */
mtype == "SYSTEM" then do /* Regina Rexx */
arg imgfile options
filesize = chars(imgfile)
if filesize == 0 then do
say "Error reading input file: "imgfile
exit
end
file = charin(imgfile,1,filesize)
name = strip(imgfile)
end
/*--------------------------------------------------------------
| MVS (PGM=IRXJCL)
------------------------------------------------------------ */
when mtype == "MVS" then do
arg options
ebcdic = 1
"EXECIO * DISKR SYSUT1 (FINIS STEM imgfile."
erc = rc
if erc <> 0 then do
say "Error reading //SYSUT1 file"
exit
end
if imgfile.0 == 0 then do
say "//SYSUT1 file is empty"
exit
end
name = "SYSUT1"
end
/*--------------------------------------------------------------
| TSO (but not batch "MVS")
------------------------------------------------------------ */
when mtype == "TSO" then do
ebcdic = 1
arg imgfile_dsn options
if imgfile_dsn == "" then do
"Missing input dataset name, terminating"
exit
end
x = LISTDSI(imgfile_dsn)
if x <> 0 then do
say "Error accessing DSN:" imgfile_dsn
say "> "sysmsglvl1
say "> "sysmsglvl2
say "> SYSREASON: "sysreason
exit
end
imgfile_pdsn = sysdsname
parse value imgfile_dsn with . "(" member ")" .
if member <> "" then do
imgfile_pdsn = imgfile_pdsn"("strip(member)")"
end
say "Processing input file "imgfile_pdsn
imgfile_dd = "SYU1"random()
address TSO "ALLOCATE FILE("imgfile_dd")" ,
"DA('"imgfile_pdsn"') SHR REUSE"
"EXECIO * DISKR "imgfile_dd ,
"(FINIS STEM imgfile."
erc = rc
address TSO "FREE FILE("imgfile_dd")"
if erc <> 0 then do
say "Error reading input file: "imgfile_pdsn
exit
end
if imgfile.0 == 0 then do
say "Input file is empty: "imgfile_pdsn
exit
end
if member == "" then name = "UNKNOWN"
else name = member
end
/*--------------------------------------------------------------
| VM files
------------------------------------------------------------ */
when mtype == "CMS" then do
ebcdic = 1
parse arg fn ft fm "(" options
fn = strip(fn)
ft = strip(ft)
fm = strip(fm)
if fm == "" then fm = "A"
address command
"STATE" fn ft fm
if rc <> 0 then do
upper fn ft fm
"STATE" fn ft fm
if rc <> 0 then do
say "File" fn ft fm "not found"
exit
end
end
vmfclear
"FINIS" fn ft fm
"EXECIO * DISKR "fn ft fm" (STEM IMGFILE. FINIS"
erc = rc
if erc <> 0 then do
say "Error reading input file: "fn ft fm
exit
end
if imgfile.0 == 0 then do
say "Input file is empty: "fn ft fm
exit
end
name = fn"."ft
end
/*--------------------------------------------------------------
| Other systems that we don't support
------------------------------------------------------------ */
otherwise
say "Not written to support system type: "mtype
say "We do support: COMMAND, CMD, CMS, MVS and TSO"
exit
end /* of "select" */
/*---------------------------------------------------------------------
| Parse options
------------------------------------------------------------------- */
debug = 0
cut = 0
verbose = 0
options = translate(options)
do i = 1 to words(options)
select
when word(options,i) == "DEBUG" then debug = 1
when word(options,i) == "VERBOSE" then verbose = 1
when word(options,i) == "CUT" then cut = 1
when word(options,i) == "NAME" then do
j = i + 1
if j > words(options) then ,
say "Name not given"
else do
name = word(options,j)
i = j
end
end
otherwise
say "Option '"word(options,i)"'",
"unknown and was ignored"
end /* of select */
end
/*---------------------------------------------------------------------
| Perform functions for Mainframe environments
------------------------------------------------------------------- */
if ebcdic then do
/*
| ISO 8859-1 to CECP 1047 (Extended de-facto EBCDIC):
*/
toEBCDIC = '00010203372D2E2F1605250B0C0D0E0F'x /* 00 */
toEBCDIC = toEBCDIC||'101112133C3D322618193F271C1D1E1F'x /* 10 */
toEBCDIC = toEBCDIC||'405A7F7B5B6C507D4D5D5C4E6B604B61'x /* 20 */
toEBCDIC = toEBCDIC||'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x /* 30 */
toEBCDIC = toEBCDIC||'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x /* 40 */
toEBCDIC = toEBCDIC||'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x /* 50 */
toEBCDIC = toEBCDIC||'79818283848586878889919293949596'x /* 60 */
toEBCDIC = toEBCDIC||'979899A2A3A4A5A6A7A8A9C04FD0A107'x /* 70 */
toEBCDIC = toEBCDIC||'202122232415061728292A2B2C090A1B'x /* 80 */
toEBCDIC = toEBCDIC||'30311A333435360838393A3B04143EFF'x /* 90 */
toEBCDIC = toEBCDIC||'41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x /* A0 */
toEBCDIC = toEBCDIC||'908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x /* B0 */
toEBCDIC = toEBCDIC||'6465626663679E687471727378757677'x /* C0 */
toEBCDIC = toEBCDIC||'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x /* D0 */
toEBCDIC = toEBCDIC||'4445424643479C485451525358555657'x /* E0 */
toEBCDIC = toEBCDIC||'8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x /* F0 */
hextable = '000102030405060708090A0B0C0D0E0F'x /* 00 */
hextable = hextable || '101112131415161718191A1B1C1D1E1F'x /* 10 */
hextable = hextable || '202122232425262728292A2B2C2D2E2F'x /* 20 */
hextable = hextable || '303132333435363738393A3B3C3D3E3F'x /* 30 */
hextable = hextable || '404142434445464748494A4B4C4D4E4F'x /* 40 */
hextable = hextable || '505152535455565758595A5B5C5D5E5F'x /* 50 */
hextable = hextable || '606162636465666768696A6B6C6D6E6F'x /* 60 */
hextable = hextable || '707172737475767778797A7B7C7D7E7F'x /* 70 */
hextable = hextable || '808182838485868788898A8B8C8D8E8F'x /* 80 */
hextable = hextable || '909192939495969798999A9B9C9D9E9F'x /* 90 */
hextable = hextable || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x /* A0 */
hextable = hextable || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x /* B0 */
hextable = hextable || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x /* C0 */
hextable = hextable || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x /* D0 */
hextable = hextable || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x /* E0 */
hextable = hextable || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x /* F0 */
filesize = 0
file = ""
do i = 1 to imgfile.0
file = file||imgfile.i
filesize = filesize + length(imgfile.i)
drop imgfile.i
end
drop imgfile.0
/* After here, imgfile.x vars are not needed and aren't valid */
end
/*---------------------------------------------------------------------
| Determine file type and call image routine
------------------------------------------------------------------- */
cl1 = ""
select
when substr(file,1,8) == '89504E470D0A1A0A'x then ,
call Show_PNG_info /* ---------------- Standard PNG signature */
when substr(file,1,3) == '474946'x then ,
call Show_Gif_info /* ---------------- 'GIF' in ASCII */
when substr(file,7,4) == '4A464946'x then ,
call Show_JPEG_info /* -------------- 'JFIF' in ASCII */
/* We could add PNG, XBM, etc file types here */
otherwise
say "Unknown file type"
end
/*---------------------------------------------------------------------
| If the CUT option is specified, save the cut line for later PASTE
------------------------------------------------------------------- */
if cut then do
if mtype <> "TSO" then do
say "CUT ignored for non-TSO environments"
exit
end
if cl1 == "" then exit
if sysvar(sysispf) <> "ACTIVE" then do
say "Can't cut line since we are not in ISPF"
exit
end
address ispexec
/* Attempt to delete old profile vars */
'VGET (CUTCNT) PROFILE'
if cutcnt == "" then cutcnt = 0
do i = 1 to cutcnt
'VERASE (CL'i') PROFILE'
end
/* Save our new cut line */
cutcnt = 1
address ispexec
'VPUT (CUTCNT) PROFILE'
'VPUT (CL1) PROFILE'
vputrc = rc
if vputrc == 0 then say " 0 then data = substr(file,i+8,l)
select
when type == '49454e44'x then leave /* IEND */
when type == '49484452'x then do /* IHDR */
width = substr(data,1,4)
height = substr(data,5,4)
end
otherwise
nop
end
if debug then call Hex_Dump i+8 l 'Chunk Data'
i = i + l + chunkl - 1
end
if width == 0 then say "PNG IHDR chunk not found!"
else do
say " "
say "HTML PNG specification:"
cl1 = ''
say ' ' cl1
end
return
/*---------------------------------------------------------------------
| Show JPEG information
|
| JPEG stands for Joint Photographic Experts Group
|
| The logic to look inside the JPEG file was modeled after the PERL
| script written by Alex Knowles (alex@ed.ac.uk) found at URL:
| http://www.avs.com/~ark/wwwis/
|
| Sample JPEG Header:
|
| Marker: FFD8
| ?: FFE00010
| J F I F (JPEG File Interchange Format)
| ID: 4A464946 (Remember: this is in ASCII)
|
|
------------------------------------------------------------------- */
Show_JPEG_Info:
say "JPEG file found"
call Show_Byte_Count
width = 0
do i = 1 to length(file)
if substr(file,i,1) == 'ff'x then do
/* debug: say "Found marker="c2x(substr(file,i,2)) */
j = i + 1
if substr(file,j,1) >= 'C0'x then ,
if substr(file,j,1) <= 'C3'x then do
/* debug: say "Found length marker="c2x(substr(file,i,16)) */
width = substr(file,i+7,2)
height = substr(file,i+5,2)
end
end
end
if mtype == "TSO" | mtype == "MVS" then name = name".JPG"
if width == 0 then say "JPEG length marker not found"
else do
say "HTML JPEG specification:"
cl1 = ''
say ' ' cl1
end
return
/*---------------------------------------------------------------------
| Show GIF information
|
| GIF stands for Graphic Interchange Format
|
| Remember that GIF uses "little endian" format so the binary values
| like for Screen_Width are "backwards". This is also known as LSB,
| Least Significant Byte. INTEL processors use this byte addressing
| scheme. Examples of computers that use the alternative "big endian"
| byte addressing format are IBM mainframes and Apple Macintoshs
| (both PowerPC and 68K).
|
|
|
| GIF file format:
|
| G I F 8 7 a
| GIF Signature: 474946383761 (Remember: this is in ASCII)
|
| Screen Descriptor -----------------------------------------------+
| Screen_Width: 6600 (should be '0066'x = 102) |
| Screen_Depth: 2400 (should be '0024'x = 36) |
| Global_Flag: F7 |
| Background_Color: 00 |
| Header_End: 00 (should always be zero |
| ----------------------------------------------+
|
| Global Color Map (optional, based on Global_Flag having x'80' on)
|
| Image Descriptor ---- +
| Local Color Map ---- | Repeated 1 to n times
| Raster Data ---- +
|
| GIF Terminator
|
------------------------------------------------------------------- */
Show_Gif_Info:
GIF_Signature = substr(file,1,6)
if ebcdic then ,
GIF_Signature = translate(GIF_Signature,toEBCDIC,hextable)
Screen_Descriptor = substr(file,7,7)
w1 = substr(Screen_Descriptor,1,1)
w2 = substr(Screen_Descriptor,2,1)
screen_width = w2||w1
h1 = substr(Screen_Descriptor,3,1)
h2 = substr(Screen_Descriptor,4,1)
screen_depth = h2||h1
say "GIF file found - Signature: "GIF_Signature
call Show_Byte_Count
if mtype == "TSO" | mtype == "MVS" then name = name".GIF"
say "HTML GIF specification:"
cl1 = ''
say ' '
say ' ' cl1
/* The rest of this code is not needed for the output */
say ' '
if debug then call Hex_Dump 1 13 'GIF signature and Screen Descriptor'
Global_Flag = substr(Screen_Descriptor,5,1)
if debug then say "Global_Flag="c2x(Global_Flag)
if bitand(Global_Flag,'80'x) = '80'x then m = 1
else m = 0
bits = 0
if bitand(Global_Flag,'04'x) = '04'x then bits = bits + 4
if bitand(Global_Flag,'02'x) = '02'x then bits = bits + 2
if bitand(Global_Flag,'01'x) = '01'x then bits = bits + 1
bits = bits + 1
pixels = 2 ** bits
/* Note: The pixels value is NOT necessarily the number of pixels
in the GIF, this is used for the calculation of the Global
Color Map length */
if debug then say "Number of pixels is "pixels ,
"bits="bits "(Global Color Map)"
curloc = 6 + 7 + 1
gcmlen = 0
if m == 1 then do
gcmlen = pixels * 3
if debug then ,
if verbose then ,
call Hex_Dump curloc gcmlen 'Global Color Map'
end
curloc = curloc + gcmlen
eblkl = 0
have_extensions = 1
do while have_extensions
/* See if we have a GIF extension block */
if substr(file,curloc,1) == '21'x then do
if debug then say "Found GIF Extension Block -",
"code="c2x(substr(file,curloc+1,1))
/* Note: Do I need a test for "Netscape" (mixed case) here? */
agifc ='4E45545343415045322E30'x /* "NETSCAPE2.0" in ASCII */
select
when substr(file,curloc+1,1) == 'ff'x then do
if substr(file,curloc+3,11) == agifc then do
say "This is an Animated GIF"
say " "
end
end
when substr(file,curloc+1,1) == 'fe'x then do
say "GIF comments found:"
say " "
clen = c2d(substr(file,curloc+2,1))
line = ""
off = curloc + 3
do i = 1 to clen
if substr(file,off,2) == '0D0A'x then do
if ebcdic then line = translate(line,toEBCDIC,hextable)
say line
line = ""
i = i + 1
off = off + 2
end
else do
line = line""substr(file,off,1)
off = off + 1
end
end
if line <> "" then do
if ebcdic then line = translate(line,toEBCDIC,hextable)
say line
end
say " "
end
otherwise
nop
end
eblkl = 3
eblko = curloc + 2
bc = 1
do while bc <> 0
bc = c2d(substr(file,eblko,1))
eblkl = eblkl + bc
eblko = eblko + bc + 1
end
eblkl = eblkl + 1
if debug then call Hex_Dump curloc eblkl 'GIF Extension Block'
end
else do
if debug then call Hex_Dump curloc 32 'Next Section'
have_extensions = 0
end
curloc = (curloc + eblkl) + 1
end
return
/*---------------------------------------------------------------------
| Hex dump of portions of the file
------------------------------------------------------------------- */
Hex_Dump:
parse arg dstart dlen dtitle
say ' '
say 'Dump of: 'dtitle
say '+offset 0 1 2 3 4 5 6 7 8 9 a b c d e f'
doffset = dstart
dleft = dlen
do h = 1 to dlen by 16
doff = '+'right(d2x(doffset-1),6,'0')
if dleft < 16 then dgrab = dleft
else dgrab = 16
dline = substr(file,doffset,dgrab)
dhex = ""
do dj = 1 to dgrab
if dj == 4 | dj == 8 | dj == 12 then dspace = " "
else dspace = ""
dhex = dhex""c2x(substr(dline,dj,1))""dspace
end
if ebcdic then do
dchars = translate(dline,toEBCDIC,hextable)
dchars = translate(dchars,copies('.',32),xrange('00'x,'1f'x))
end
else dchars = translate(dline,copies('.',32),xrange('00'x,'1f'x))
say doff left(dhex,35) "*"left(dchars,16)"*"
doffset = doffset + 16
dleft = dleft - 16
end
return
/*---------------------------------------------------------------------
| Show byte count
|
| Question: Should I use 1000 or 1024????????
------------------------------------------------------------------- */
Show_Byte_Count:
if filesize < 1000 then say "Byte count:" filesize
else do
filesizek = filesize % 1000
say "Byte count:" filesizek"k ("filesize")"
end
return
/*---------------------------------------------------------------------
| END END END END END - End of IMGINFO exec - END END END END END
------------------------------------------------------------------- */