Snitz Forums 2000
Snitz Forums 2000
Home | Profile | Register | Active Topics | Members | Search | FAQ
Username:
Password:
Save Password
Forgot your Password?

 All Forums
 Snitz Forums 2000 MOD-Group
 MOD Add-On Forum (W/Code)
 Topic Image Preview
 New Topic  Reply to Topic
 Printer Friendly
Previous Page
Author Previous Topic Topic Next Topic
Page: of 3

AnonJr
Moderator

United States
5768 Posts

Posted - 01 July 2009 :  17:17:40  Show Profile  Visit AnonJr's Homepage  Reply with Quote
I needed something similar for a local .vbs to generate an XML file with image specs. I've used the following functions in that project - context is provided. Can't remember where I originaly got them though...

'collect the image information into an array
Dim blnGfxSpex, width, height, colors, strType
intCount = 0
For Each objFile In objFS.GetFolder(".\images").Files
	'As per the readme, images need to be 'non-progressive' JPGs
	If LCase(Right(objFile.Name, 4)) = ".jpg" and intCount <= intNumOfFiles Then
		blnGfxSpex = gfxSpex((".\images\" & objFile.Name), width, height, colors, strType)
		MsgIE Now() & " - Now getting information on " & (intCount + 1) & " of " & intNumOfFiles & "."
		arrImages(intCount) = "<image>" & vbNewLine & _
								"<filename>" & objFile.Name & "</filename>" & vbNewLine & _
								"<caption></caption>" & vbNewLine & _
								"<width>" & width & "</width>" & vbNewLine & _
								"<height>" & height & "</height>" & vbNewLine & _
								"</image>" & vbNewLine
		intCount = intCount + 1
	End If
Next

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  This routine will attempt to identify any filespec passed  :::
':::  as a graphic file (regardless of the extension). This will :::
':::  work with BMP, GIF, JPG and PNG files.                     :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::          Based on ideas presented by David Crowell          :::
':::                   (credit where due)                        :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah     Copyright *c* MM,  Mike Shaffer     blah blah :::
'::: blah blah      ALL RIGHTS RESERVED WORLDWIDE      blah blah :::
'::: blah blah  Permission is granted to use this code blah blah :::
'::: blah blah   in your projects, as long as this     blah blah :::
'::: blah blah      copyright notice is included       blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  This function gets a specified number of bytes from any    :::
':::  file, starting at the offset (base 1)                      :::
':::                                                             :::
':::  Passed:                                                    :::
':::       flnm        => Filespec of file to read               :::
':::       offset      => Offset at which to start reading       :::
':::       bytes       => How many bytes to read                 :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function GetBytes(flnm, offset, bytes)

 Dim objFSO
 Dim objFTemp
 Dim objTextStream
 Dim lngSize

 on error resume next

 Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 ' First, we get the filesize
 Set objFTemp = objFSO.GetFile(flnm)
 lngSize = objFTemp.Size
 set objFTemp = nothing

 fsoForReading = 1
 Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)

 if offset > 0 then
	strBuff = objTextStream.Read(offset - 1)
 end if

 if bytes = -1 then		' Get All!

	GetBytes = objTextStream.Read(lngSize)  'ReadAll

 else

	GetBytes = objTextStream.Read(bytes)

 end if

 objTextStream.Close
 set objTextStream = nothing
 set objFSO = nothing

end function


':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  Functions to convert two bytes to a numeric value (long)   :::
':::  (both little-endian and big-endian)                        :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function lngConvert(strTemp)
 lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
end function

function lngConvert2(strTemp)
 lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
end function


':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  This function does most of the real work. It will attempt  :::
':::  to read any file, regardless of the extension, and will    :::
':::  identify if it is a graphical image.                       :::
':::                                                             :::
':::  Passed:                                                    :::
':::       flnm        => Filespec of file to read               :::
':::       width       => width of image                         :::
':::       height      => height of image                        :::
':::       depth       => color depth (in number of colors)      :::
':::       strImageType=> type of image (e.g. GIF, BMP, etc.)    :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function gfxSpex(flnm, width, height, depth, strImageType)

 dim strPNG 
 dim strGIF
 dim strBMP
 dim strType
 strType = ""
 strImageType = "(unknown)"

 gfxSpex = False

 strPNG = chr(137) & chr(80) & chr(78)
 strGIF = "GIF"
 strBMP = chr(66) & chr(77)

 strType = GetBytes(flnm, 0, 3)

 if strType = strGIF then				' is GIF

	strImageType = "GIF"
	Width = lngConvert(GetBytes(flnm, 7, 2))
	Height = lngConvert(GetBytes(flnm, 9, 2))
	Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
	gfxSpex = True

 elseif left(strType, 2) = strBMP then		' is BMP

	strImageType = "BMP"
	Width = lngConvert(GetBytes(flnm, 19, 2))
	Height = lngConvert(GetBytes(flnm, 23, 2))
	Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
	gfxSpex = True

 elseif strType = strPNG then			' Is PNG

	strImageType = "PNG"
	Width = lngConvert2(GetBytes(flnm, 19, 2))
	Height = lngConvert2(GetBytes(flnm, 23, 2))
	Depth = getBytes(flnm, 25, 2)

	select case asc(right(Depth,1))
	   case 0
		  Depth = 2 ^ (asc(left(Depth, 1)))
		  gfxSpex = True
	   case 2
		  Depth = 2 ^ (asc(left(Depth, 1)) * 3)
		  gfxSpex = True
	   case 3
		  Depth = 2 ^ (asc(left(Depth, 1)))  '8
		  gfxSpex = True
	   case 4
		  Depth = 2 ^ (asc(left(Depth, 1)) * 2)
		  gfxSpex = True
	   case 6
		  Depth = 2 ^ (asc(left(Depth, 1)) * 4)
		  gfxSpex = True
	   case else
		  Depth = -1
	end select


 else

	strBuff = GetBytes(flnm, 0, -1)		' Get all bytes from file
	lngSize = len(strBuff)
	flgFound = 0

	strTarget = chr(255) & chr(216) & chr(255)
	flgFound = instr(strBuff, strTarget)

	if flgFound = 0 then
	   exit function
	end if

	strImageType = "JPG"
	lngPos = flgFound + 2
	ExitLoop = false

	do while ExitLoop = False and lngPos < lngSize

	   do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
		  lngPos = lngPos + 1
	   loop

	   if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
		  lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
		  lngPos = lngPos + lngMarkerSize  + 1
	   else
		  ExitLoop = True
	   end if

   loop
   '
   if ExitLoop = False then

	  Width = -1
	  Height = -1
	  Depth = -1

   else

	  Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
	  Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
	  Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
	  gfxSpex = True

   end if
			   
 end if

end function

Edited by - AnonJr on 01 July 2009 17:19:58
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 01 July 2009 :  17:45:54  Show Profile  Reply with Quote
I've tested that routine before for local files - there's a similar one for remote files, but the portion for .jpg fails.

Edited by - Carefree on 01 July 2009 17:49:47
Go to Top of Page

AnonJr
Moderator

United States
5768 Posts

Posted - 02 July 2009 :  11:25:36  Show Profile  Visit AnonJr's Homepage  Reply with Quote
I'd love to dig in and help trouble-shoot but I've overbooked myself a tad and have been working furiously to un-bury myself...
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 02 July 2009 :  12:32:17  Show Profile  Reply with Quote
No problem. It's not really necessary for the mod, just would improve it a bit.
Go to Top of Page
Page: of 3 Previous Topic Topic Next Topic  
Previous Page
 New Topic  Reply to Topic
 Printer Friendly
Jump To:
Snitz Forums 2000 © 2000-2021 Snitz™ Communications Go To Top Of Page
This page was generated in 0.09 seconds. Powered By: Snitz Forums 2000 Version 3.4.07