Re: How to write a diff in VB6 for comparing two xml files?
- From: "Mike D Sutton" <EDais@xxxxxxxx>
- Date: Wed, 12 Apr 2006 10:25:33 +0100
Many thanks for giving me advice! Is there a method in VB6 that can be
called directly to compare two XML files to see if they are exactly the
same?
No, the best you could do is to read both into string and use StrComp() but it's inefficient and, but using the hash
instead, unnecessary.
Do I have to loop through each line in the XML file? I'll only need to
find out if the two files are exactly the same. I don't need to know
what changed.
As for hash, could you kindly give me a piece of sample code in VB6 to
illustrate the idea? Many thanks!
I'm sure you could probably find lots of VB routines that would give you a hash of some sorts, however here's one which
uses the CryptoAPI to calculate the MD5 hash for a file (although it's very easy to change this to use a different
hashing algorithm instead):
'***
Private Declare Function CryptAcquireContext Lib "AdvAPI32.dll" Alias _
"CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, _
ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "AdvAPI32.dll" ( _
ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "AdvAPI32.dll" ( _
ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, _
ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "AdvAPI32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "AdvAPI32.dll" ( _
ByVal hHash As Long, ByRef pbData As Any, ByVal dwDataLen As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "AdvAPI32.dll" ( _
ByVal hHash As Long, ByVal dwParam As Long, ByRef pbData As Any, _
ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Const MS_DEF_PROV As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const CRYPT_NEWKEYSET As Long = &H8
Private Const PROV_RSA_FULL As Long = &H1
Private Const ALG_CLASS_HASH As Long = &H8000&
Private Const ALG_TYPE_ANY As Long = &H0
Private Const ALG_SID_MD5 As Long = &H3
Private Const CALG_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
Private Const HP_HASHVAL As Long = &H2 ' Hash value
Private Function HashFile(ByRef inFile As String, ByRef outHash() As Byte) As Long
Dim hCryptProv As Long
Dim hCryptHash As Long
Dim FNum As Integer
Dim FBuf() As Byte, BufLen As Long
Dim BytesLeft As Long
Dim HashError As Boolean
' Default chunk size to use when hashing file data
Const ChunkSize As Long = 1024 ' 1Kb
FNum = FreeFile() ' Get free file handle and open file
Open inFile For Binary As #FNum
ReDim FBuf(0 To ChunkSize - 1) As Byte
' Attempt to open default cryptographic context
If (CryptAcquireContext(hCryptProv, vbNullString, _
MS_DEF_PROV, PROV_RSA_FULL, 0&) = 0) Then
If (CryptAcquireContext(hCryptProv, vbNullString, MS_DEF_PROV, _
PROV_RSA_FULL, CRYPT_NEWKEYSET) = 0) Then
Exit Function ' Failed to acquire cryptographic context
Close #FNum
End If
End If
' Create new MD5 hash
If (CryptCreateHash(hCryptProv, CALG_MD5, 0&, 0&, hCryptHash)) Then
BytesLeft = LOF(FNum)
BufLen = ChunkSize
Do
If (BytesLeft < ChunkSize) Then ' Last chunk
ReDim FBuf(0 To BytesLeft - 1) As Byte
BufLen = BytesLeft
End If
' Read chunk from file
Get #FNum, , FBuf()
' Add this data to the hash
If (CryptHashData(hCryptHash, FBuf(0), BufLen, 0&) = 0) Then
HashError = True
Exit Do
End If
' Decrement read count
BytesLeft = BytesLeft - BufLen
Loop While BytesLeft > 0
If (Not HashError) Then
BufLen = 0
' Get buffer length for hash
If (CryptGetHashParam(hCryptHash, HP_HASHVAL, ByVal 0&, BufLen, 0&)) Then
ReDim FBuf(0 To BufLen - 1) As Byte
If (CryptGetHashParam(hCryptHash, HP_HASHVAL, FBuf(0), BufLen, 0&)) Then
HashFile = BufLen ' Return final hash buffer
outHash = FBuf
End If
End If
End If
' Done with hash object
Call CryptDestroyHash(hCryptHash)
End If
' Done with provider
Call CryptReleaseContext(hCryptProv, 0&)
Close #FNum
End Function
Private Function GetFileHash(ByRef inFile As String) As String
Dim Hash() As Byte, HashLen As Long, LoopHash As Long
' Perform hash on file
HashLen = HashFile(inFile, Hash())
If (HashLen > 0) Then
' Allocate return buffer
GetFileHash = String$(HashLen * 2, "0")
For LoopHash = 0 To HashLen - 1
If (Hash(LoopHash) < &H10) Then ' Single digit
Mid$(GetFileHash, (LoopHash * 2) + 2, 1) = Hex$(Hash(LoopHash))
Else ' Double digit
Mid$(GetFileHash, (LoopHash * 2) + 1, 2) = Hex$(Hash(LoopHash))
End If
Next LoopHash
End If
End Function
Private Function IdenticalFiles(ByRef inFileA As String, ByRef inFileB As String) As Boolean
Dim HashA() As Byte, HashLenA As Long
Dim HashB() As Byte, HashLenB As Long
Dim LoopHash As Long
' Hash first file
HashLenA = HashFile(inFileA, HashA())
If (HashLenA > 0) Then ' Hash second file
HashLenB = HashFile(inFileB, HashB())
' Compare hashes
If (HashLenB = HashLenA) Then
For LoopHash = 0 To HashLenA - 1 ' Compare values
If (HashA(LoopHash) <> HashB(LoopHash)) Then Exit For
Next LoopHash
' If we got to the end of the loop, the hashes match
IdenticalFiles = LoopHash = HashLenA
End If
End If
End Function
'***
The GetFileHash() function returns a string containing the hex representation of a file's hash, while the
IdenticalFiles() function will simply hash two files and compare the results.
Hope this helps,
Mike
- Microsoft Visual Basic MVP -
E-Mail: EDais@xxxxxxxx
WWW: Http://EDais.mvps.org/
.
- Follow-Ups:
- References:
- How to write a diff in VB6 for comparing two xml files?
- From: Emily
- Re: How to write a diff in VB6 for comparing two xml files?
- From: Mike D Sutton
- Re: How to write a diff in VB6 for comparing two xml files?
- From: Emily
- How to write a diff in VB6 for comparing two xml files?
- Prev by Date: Re: Select Case for Option values
- Next by Date: Re: Worth checking out - J French
- Previous by thread: Re: How to write a diff in VB6 for comparing two xml files?
- Next by thread: Re: How to write a diff in VB6 for comparing two xml files?
- Index(es):
Relevant Pages
|
