Czy obrazy są takie same? MD5   strona główna:
A po co ten Excel ;-)
 
No właśnie :-) Mamy takie 3 obrazy w Arkuszu.  
Czy obraz 1 i 3 są takie same?? Jak to sprawdzić?  
 
"Piksel po pikselu" choć realne to jednak zajęło by  
pewnie sporo czasu. Coś szybszego a zarazem dającego  
zadowalające prawdopodobieństwo NIE popełnienia   
błędu jest np.: sprawdzenie sum kontrolnych MD5   wikipedia.org MD5
tych obrazków. Jak coś takiego zrobić? :-)  
 
Należy zapisać obrazek na dysku, odczytać zawartość  
binarną utworzonego pliku, okreslić "skrót" generowany  
funkcja MD5 i porównać wyniki dla wybranych obrazków.  
 
 
Procedura realizująca takie zadania może wygladać następująco:  
 
Option Explicit  
 
Sub Start()  
    Dim xlShp As Excel.Shape  
    Dim xlWks As Excel.Worksheet  
    Dim strFilePath As String: strFilePath = ThisWorkbook.Path & "\test.jpg"  
      
    Set xlWks = ThisWorkbook.Worksheets("Arkusz1")  
    Set xlShp = xlWks.Shapes("Obraz 3")  
 
    xlShp2JPG xlShp, strFilePath  
      
    Dim nr: nr = VBA.FreeFile  
    Dim strBinFile As String  
      
    Open strFilePath For Binary Access Read As nr  
        strBinFile = String(LOF(nr), " ")  
        Get nr, , strBinFile  
    Close nr  
    VBA.Kill strFilePath  
      
Debug.Print xlShp.Name, MD5Hash(strBinFile)  
 
End Sub  
 
Sub xlShp2JPG(xlShp As Excel.Shape, strPath As String)  
    Application.ScreenUpdating = False  
    xlShp.Copy  
    With xlShp.Parent.ChartObjects.Add(Left:=100, _  
                                Top:=100, _  
                                Width:=xlShp.Width, _  
                                Height:=xlShp.Height)  
        With .Chart  
            .Paste  
            .Export strPath  
        End With  
        .Delete  
    End With  
    Application.CutCopyMode = False  
    Application.ScreenUpdating = True  
End Sub  
 
Na ścieżce: ThisWorkbook.Path & "\test.jpg" zapisuję xlWks.Shapes("Obraz 3"). Wykorzystuję do tego polecenie .Export strPath  
tymczasowego Wykresu do którego kopiuję dany obraz (Excel.Shape).  
Nastpenie odczytuję o zmiennej strBinFile zawartosć pliku test.jpg i funkcją MD5Hash odczytuję skrót (sumę kontrolną) tego pliku.  
Procedura, dla ww obrazków w arkuszu zwraca:  
 
 
 
 
 
 
więc… obraz 1 i 3 są TAKIE SAME :D  
  tu wersja dla vbs
czego brakuje?? Ano funkcji MD5Hash :-) Fajną znalazłem na xtremevbtalk:   (bez API)
  VBScript MD5
Option Explicit  
'http://www.xtremevbtalk.com/showthread.php?t=109394  
 
Private Const ALG_TYPE_ANY As Long = 0  
Private Const ALG_SID_MD5 As Long = 3  
Private Const ALG_CLASS_HASH As Long = 32768  
 
Private Const HP_HASHVAL As Long = 2  
Private Const HP_HASHSIZE As Long = 4  
 
Private Const CRYPT_VERIFYCONTEXT = &HF0000000  
 
Private Const PROV_RSA_FULL As Long = 1  
Private Const MS_ENHANCED_PROV As String = "Microsoft Enhanced Cryptographic Provider v1.0"  
 
 
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 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 CryptGetHashParam Lib "advapi32.dll" ( _  
                  ByVal pCryptHash As Long, _  
                  ByVal dwParam As Long, _  
                  ByRef pbData As Any, _  
                  ByRef pcbData As Long, _  
                  ByVal dwFlags As Long) As Long  
Private Declare Function CryptGenRandom Lib "advapi32.dll" ( _  
                  ByVal pCryptHash As Long, _  
                  ByVal dwLength As Long, _  
                  ByRef pbData As Any) As Long  
Private Declare Function CryptHashData Lib "advapi32.dll" ( _  
                  ByVal hHash As Long, _  
                  ByVal pbData As String, _  
                  ByVal dwDataLen 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  
 
Public Function MD5Hash(ByVal sKey As String) As String  
  Dim hHash  As Long  
  Dim hCrypt As Long  
  Dim lLen   As Long  
  Dim b()    As Byte  
  Dim i As Long  
 
  Const BUFFER_SIZE As Long = 256  
 
  ReDim b(BUFFER_SIZE - 1)  
 
  If CryptAcquireContext(hCrypt, vbNullString, MS_ENHANCED_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then  
    If CryptCreateHash(hCrypt, ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5, 0, 0, hHash) Then  
      If CryptHashData(hHash, sKey, Len(sKey), 0) Then  
        If CryptGetHashParam(hHash, HP_HASHSIZE, b(0), BUFFER_SIZE, 0) Then  
          lLen = b(0)  
          If CryptGetHashParam(hHash, HP_HASHVAL, b(0), BUFFER_SIZE, 0) Then  
            For i = 0 To lLen - 1  
                MD5Hash = LCase(MD5Hash & Right$("0" & Hex$(b(i)), 2))  
            Next i  
          End If  
        End If  
      End If  
    End If  
  End If  
 
  If hHash Then CryptDestroyHash hHash  
  If hCrypt Then CryptReleaseContext hCrypt, 0  
End Function