Saturday, 17 August 2013

How to Perform Image Comparison

‘Function Name : BinaryImageCompare()
‘Arguments : 1. Source File with path, 2. Destination File to be compared with path
‘Description : The function compares the source and destination files in the binary mode. This
can be used for any type of files.
‘Return Type : If the files are identical then function return true else false
‘*************************************************************************************************************
Function BinaryImageCompare(fileA,fileB)
Dim sFileA, sFileB
Dim bMatched
Dim nSize
Dim bufA, bufB
Dim lengthA, lengthB
Const adTypeBinary = 1
Set fso = CreateObject(”Scripting.FileSystemObject”)
Set streamA = CreateObject(”ADODB.Stream”)
Set streamB = CreateObject(”ADODB.Stream”)
FileCompare = null
if vartype(fileA) vbString then
on error resume next
sFileA = fileA.path
if err then exit function
on error goto 0
else
if not fso.fileexists(fileA) then
exit function
else
sFileA = fileA
end if
end if
if vartype(FileB) vbString then
on error resume next
sFileB = FileB.path
if err then exit function
on error goto 0
else
if not fso.fileexists(FileB) then
exit function
else
sFileB = FileB
end if
end if
streamA.type = adTypeBinary
streamB.type = adTypeBinary
streamA.open
streamB.open
on error resume next
streamA.loadfromfile sFileA
if err then exit function
streamB.loadfromfile sFileB
if err then exit function
on error goto 0
bMatched = true
nSize = 2^15 ‘32K
do until streamA.eos or streamB.eos
bufA = streamA.read(nSize)
bufb = streamB.read(nSize)
lengthA = lenB(bufA)
lengthB = lenB(bufB)
if lengthA lengthB then
bMatched = false
exit do
elseif MidB(bufA,1,lengthA) MidB(bufB,1,lengthB) then
bMatched = false
exit do
end if
loop
if not (streamA.eos and streamB.eos) then
bMatched = false
end if
streamA.close
streamB.close
BinaryFileCompare = bMatched
End Function

No comments:

Post a Comment