Use FSO to get image file information

xiaoxiao2021-03-06  96

Use FSO to get image file information

<% ': ::::::::::::::::::::::::: :::::::::::::::::::::: :::::::::::::::::::: ::: BMP, GIF, JPG AND PNG: :::::: :::::::::::::::: :::::::::::::::::::::: :::: ::: '::::::' :::. Function gets from any ::: ':::::' ::: passed: ::: '::: flm :::' ::: flnm => Filespec of File to read ::: '::::: :::' ::::: ::: '::: :::': ::::: :::::::::::::::::::::: :::::::::::::::: function GetBytes (flnm, offset, bytes) Dim objFSODim objFTempDim objTextStreamDim lngSizeon error resume nextSet objFSO = CreateObject ( "Scripting.FileSystemObject") 'First, we get the filesizeSet Objftemp = objfso.getfile (flnm) LNGSIZE = Objftemp.sizSet Objftemp = Nothingfsoforreading = 1set ObjtextStream = Objfso.opentextFile (flnm, fsoforreadin g) if offset> 0 thenstrBuff = objTextStream.Read (offset - 1) end ifif bytes = -1 then '! Get All GetBytes = objTextStream.Read (lngSize)' ReadAllelseGetBytes = objTextStream.Read end ifobjTextStream.Closeset objTextStream (bytes) = NothingSet objfso = nothingend function

': :::::::::::::::::::::::::: ::: ::: '::: :::: :::' ::: (BOTH Little-endian and big-endian ::: '::::::::::::::::: :::::::::::::::::::::::::::::::::::::::0emp "LNGCONVERT = ClNG (ASC 1)) ((ASC (Right (straTemp, 1)) * 256))))))))) End FunctionFunction LNGCONVERT2 (STRTEMP) LNGCONVERT2 = ClNG (ASC (Right (strTemp, 1)) ((ASC (strave (straTemp, 1) )) * 256))) End function ': ::::::::::::::::::::::: :::::::::::::::: ':::::' ::: This function does MOST OF THE REAL WORK. IT WILL ATTETEMPT :: d w i i a::::::::::::: ::: '::: width => width of image :::' ::: => height of image ::: '::: Depth = > Color Depth ::: '::: StrimageType => Type of Image (eg gif, bmp, etc.) :::' ::: ::: '::::: ::::: :::::::::::::::::::::: ::::::::::: function gfxSpex (flnm, width, height, depth, strImageType) dim strPNG dim strGIFdim strBMPdim strTypestrType = "" strImageType = "(unknown)" gfxSpex = FalsestrPNG = chr (137) & chr (80) & chr (78) strgif = "gif" strbmp = chr (66) & chr (77) strtype = getBytes (FLNM, 0, 3) if strkeype = strgif kil1n 'is gifstrimageType = "gif" width = LNGCONVERT Gettes (FLNM, 7, 2)) HEIGHT = LNGCONVERT (Gettes (FLNM, 9, 2)) Depth = 2 ^ ((ASC (Gettes (FLNM, 11, 1)) and 7) 1) GFXSPEX =

Trueelseif Left (Strtype, 2) = strbmp t 'is bmpstrimageType = "BMP" width = LNGCONVERT (Gettes (FLNM, 19, 2)) HEIGHT = LNGCONVERT (GetBytes (FLNM, 23, 2)) Depth = 2 ^ (ASC GetBytes (flnm, 29, 1))) gfxSpex = Trueelseif strType = strPNG then 'Is PNGstrImageType = "PNG" Width = lngConvert2 (GetBytes (flnm, 19, 2)) Height = lngConvert2 (GetBytes (flnm, 23, 2)) Depth = Gettes (FLNM, 25, 2) SELECT CASE ASC (Right (depth, 1)) Case 0Depth = 2 ^ (ASC (Left (depth, 1))) GFXSPEX = truecase 2Depth = 2 ^ (ASC (defrm (defrm) , 1) * 3) GFXSPEX = Truecase 3Depth = 2 ^ (ASC (Left (depth, 1))) '8gfxspex = truecase 4Depth = 2 ^ (ASC (Left (depth, 1)) * 2) GFXSPEX = truecase 6Depth = 2 ^ (asc (left (Depth, 1)) * 4) gfxSpex = Truecase elseDepth = -1end selectelsestrBuff = GetBytes (flnm, 0, -1) 'Get all bytes from filelngSize = len flgFound = 0strTarget (strBuff) = chr (255) & chr (216) & chr (255) Flgfound = instr (strbuff, strtarget) if flgfound = 0 THENEXIT FUNCTIONEND IFSTRIMAGETYPE = "jpg" LNGPOS = FLGFOUND 2EXITLOOP = FALSEDO while EXIT Loop = false and lngpos

Do WHILE ASC (MID (Strbuff, LNGPOS, 1)) = 255 and LNGPOS 195 thenlngMarkerSize = lngConvert2 (mid (strBuff, lngPos 1, 2)) lngPos = lngPos lngMarkerSize 1elseExitLoop = Trueend ifloop'if ExitLoop = False thenWidth = -1Height = -1Depth = -1elseHeight = lngConvert2 (mid (strBuff, lngPos 4 , 2)) Width = LNGCONVERT2 (MID (Strbuff, LNGPOS 6, 2)) Depth = 2 ^ (ASC (MID (Strbuff, LNGPOS 8, 1)) * 8) GFXSPEX = TrueEnd IFEND Function

': :::::::::::::::::::::::::: ::::: test harness ::: ':::::::::: :::: :::::::::::::::::::::: ' To test, we'll Just Try to show all files with a .gif extension in the root of c: set objfso = createObject ("scripting.filesystemObject") set objf = objfso.getfolder ("c: /") set objfc = Objf.filesResponse.write "

"for Each F1 in objfcif instr (ucase (f1.name)," .gif ") ThenResponse.write"
"& f1.name &" "& f1.datecreated &" "& f1.size &" "IF GFXSPEX (F1 .Path, w, h, c, strtype) = True ThenRESPONSE.WRITE W & "X" & H & "" Elseresponse.write "" end ifresponse.write " "end ifNextresponse.write" "set objFC = nothingset objF = nothingset objFSO = nothing%> (author: continent)

转载请注明原文地址:https://www.9cbs.com/read-100392.html

New Post(0)
CopyRight © 2020 All Rights Reserved
Processed: 0.038, SQL: 9