/* 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) | | sample ------------------------------------------------------------------- */ 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). | | sample | | 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 ------------------------------------------------------------------- */