There are about 4 types of hashing algorithms:
Difference Hash: DHash(Difference Hash)
Average Hash: AHash(Average Hash)
Perceptual Hash: PHash (Perceptual Hash)
Wavelet Hash: WHash (Wavelet Hash) I won't convert this, I'm so bad at math
If there are errors, fix them ?thanks
There are a lot of pearls in the forum, and we need to connect them together, thanks to every master of open source
Difference Hash: DHash(Difference Hash)
Average Hash: AHash(Average Hash)
Perceptual Hash: PHash (Perceptual Hash)
Wavelet Hash: WHash (Wavelet Hash) I won't convert this, I'm so bad at math
If there are errors, fix them ?thanks
There are a lot of pearls in the forum, and we need to connect them together, thanks to every master of open source
Code:
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function BitBlt _
Lib "gdi32" (ByVal hDestDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function GetClientRect _
Lib "user32" (ByVal hWnd As Long, _
lpRect As RECT) As Long '??????????????" ()
Private Declare Function GetWindowRect _
Lib "user32" (ByVal hWnd As Long, _
ByRef lpRect As RECT) As Long '??????????????
Private Declare Function SetForegroundWindow _
Lib "user32" (ByVal hWnd As Long) As Long '?????
Private Declare Function IsWindowVisible _
Lib "user32" (ByVal hWnd As Long) As Long '?????????????TRUE????
Private Declare Function FlashWindow _
Lib "user32" (ByVal hWnd As Long, _
ByVal bInvert As Long) As Long '???????
'????
'Private Type POINTAPI: X As Long: Y As Long: End Type '???????
Private Declare Function GetCursorPos _
Lib "user32" (lpPoint As POINTAPI) As Long '???????????????
Private Declare Function SetCursorPos _
Lib "user32" (ByVal x As Long, _
ByVal y As Long) As Long '??????????????????
'?????????????????????????
'????
Private Declare Function ClientToScreen _
Lib "user32" (ByVal hWnd As Long, _
lpPoint As POINTAPI) As Long '??????????
Private Declare Function ScreenToClient _
Lib "user32" (ByVal hWnd As Long, _
lpPoint As POINTAPI) As Long '??????????
Private Declare Function MapWindowPoints _
Lib "user32" (ByVal hwndFrom As Long, _
ByVal hwndTo As Long, _
lpPoint As POINTAPI, _
ByVal cPoints As Long) As Long '2????????’??lpPoint As POINTAPI?? lppt As RECT????cPoints=2
'?????????????????????????
'/////////////////////
'??
Private Declare Function timeGetTime Lib "winmm.dll" () As Long '??timeGetTime???????????
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) '????????
'????
'Private Declare PtrSafe Function MsgBoxEx Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long '??MsgBoxEx
Private Declare Function GetForegroundWindow Lib "user32" () As Long '???????????
Private Declare Function MsgBoxEx _
Lib "user32" _
Alias "MessageBoxTimeoutA" (ByVal hWnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As VbMsgBoxStyle, _
ByVal wlange As Long, _
ByVal dwTimeout As Long) As Long '??MsgBoxEx
'hwnd??????????0, lpText????????????MsgBox????????Prompt,lpCaption??????????MsgBox????????Caption
' wType??????????MsgBox????????Buttons, wlange???????????0??1????????, dwTimeout???????????
'?????????????????????????
#If Win64 Then
Private Declare PtrSafe Sub SetThreadExecutionState Lib "kernel32" (ByVal esFlags As Long) '????
#Else
Private Declare Sub SetThreadExecutionState _
Lib "kernel32" (ByVal esFlags As Long) '????
#End If
Private Enum Execution_State '????
ES_SYSTEM_REQUIRED = &H1
ES_DISPLAY_REQUIRED = &H2
ES_AWAYMODE_REQUIRED = &H4
ES_CONTINUOUS = &H80000000
End Enum
'???????????>>>>>>
'SetThreadExecutionState Execution_State.ES_SYSTEM_REQUIRED Or _
Execution_State.ES_DISPLAY_REQUIRED Or _
Execution_State.ES_CONTINUOUS '????
'SetThreadExecutionState Execution_State.ES_CONTINUOUS '????
'////////////////////////////////////////////////
'
'============
'ColorProcess
'============
'
'A global predeclared object providing the method:
'
' o ReplaceColor( _
' ByVal Original As StdPicture, _
' ByVal FromColor As Long, _
' ByVal ToColor As Long) As StdPicture
'
' The two colors are in COLORREF format, i.e. what VB6 calls an RGB color.
'
'Notes:
'
' o Not tested on a system with a display color depth < 24-bit color.
'
'=
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As Long
HBmp As Long
hPal As Long
Reserved As Long
End Type
Private Declare Function CreateCompatibleBitmap _
Lib "gdi32" (ByVal hdc As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long) As Long
Private Declare Function GetDeviceCaps _
Lib "gdi32" (ByVal hdc As Long, _
ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries _
Lib "gdi32" (ByVal hdc As Long, _
ByVal wStartIndex As Long, _
ByVal wNumEntries As Long, _
lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
Private Declare Function SelectObject _
Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function StretchBlt _
Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal nSrcWidth As Long, _
ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long
'Private Declare Function BitBlt _
Lib "gdi32" (ByVal hDCDest As Long, _
ByVal XDest As Long, _
ByVal YDest As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hDCSrc As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function SelectPalette _
Lib "gdi32" (ByVal hdc As Long, _
ByVal hPalette As Long, _
ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
' BitBlt ????
Private Const SRCCOPY = &HCC0020
Private Const SRCINVERT = &H660046
' PatBlt ????
Private Const DINV = 3
Private Const DSTINVERT = &H550009
Private Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
peFlags As Byte
End Type
Private Type LOGPALETTE
palVersion As Integer
palNumEntries As Integer
palPalEntry(255) As PALETTEENTRY
End Type
Private Declare Function OleCreatePictureIndirect2 _
Lib "olepro32.dll" _
Alias "OleCreatePictureIndirect" (PicDesc As PicBmp, _
RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
iPic As IPicture) As Long
'=============================
Private Const WIN32_FALSE As Long = 0
Private Const WIN32_TRUE As Long = 1
Private Const WIN32_NULL As Long = 0
Private Const S_OK As Long = 0
Private Const DIB_RGB_COLORS As Long = 0
Private Enum BiCompressionValues
BI_RGB = 0 'We're only using this value here.
End Enum
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As BiCompressionValues
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BITMAPINFO_NOPALETTE
bmiHeader As BITMAPINFOHEADER
End Type
Private Type PICTDESC_BMP
Size As Long
Type As Long
HBmp As Long
hPal As Long
Reserved As Long
End Type
Private Type IID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Declare Function CLSIDFromString _
Lib "ole32" (ByVal lpsz As Long, _
ByRef clsid As IID) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection _
Lib "gdi32" (ByVal hdc As Long, _
ByRef BMI As Any, _
ByVal iUsage As Long, _
ByRef pvBits As Long, _
Optional ByVal hSection As Long = WIN32_NULL, _
Optional ByVal dwOffset As Long = 0) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDIBits _
Lib "gdi32" (ByVal hdc As Long, _
ByVal hBitmap As Long, _
ByVal nStartScan As Long, _
ByVal nNumScans As Long, _
ByRef Bits As Any, _
ByRef BMI As Any, _
ByVal wUsage As Long) As Long
Private Declare Sub MoveMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" (ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)
Private Declare Function OleCreatePictureIndirect _
Lib "oleaut32" (ByRef PICTDESC As Any, _
ByRef RefIID As IID, _
ByVal fPictureOwnsHandle As Long, _
ByRef iPic As IPicture) As Long
Private Declare Function ReleaseDC _
Lib "user32" (ByVal hWnd As Long, _
ByVal hdc As Long) As Long
Private hMemDC As Long
Private IID_IPicture As IID
Private Enum InterpolationMode
InterpolationModeDefault = &H0
InterpolationModeLowQuality = &H1
InterpolationModeHighQuality = &H2
InterpolationModeBilinear = &H3
InterpolationModeBicubic = &H4
InterpolationModeNearestNeighbor = &H5
InterpolationModeHighQualityBilinear = &H6
InterpolationModeHighQualityBicubic = &H7
End Enum
Private Enum PictureTypeConstants
vbPicTypeNone = 0
vbPicTypeBitmap = 1
vbPicTypeMetafile = 2
vbPicTypeIcon = 3
vbPicTypeEMetafile = 4
End Enum
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
'Private Type GUID
' Data1 As Long
' Data2 As Integer
' Data3 As Integer
' Data4(0 To 7) As Byte
'End Type
'Private Type RECT
' Left As Long
' Top As Long
' Right As Long
' Bottom As Long
'End Type
'Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
'Private Declare Function GetClientRect _
Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long
'Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
'Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
'Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As Any, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
'Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OleCreatePictureIndirectAut _
Lib "oleAut32.dll" _
Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, _
RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
iPic As IPicture) As Long
'Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
'Private Declare Function GetDC Lib "User32" (ByVal hWnd As Long) As Long
'Private Declare Function ReleaseDC Lib "User32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function GdiplusStartup _
Lib "gdiplus" (Token As Long, _
inputbuf As GdiplusStartupInput, _
Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipDeleteGraphics _
Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long
Private Declare Function GdipCreateFromHDC _
Lib "gdiplus" (ByVal hdc As Long, _
hGraphics As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP _
Lib "GdiPlus.dll" (ByVal hbm As Long, _
ByVal hPal As Long, _
ByRef pbitmap As Long) As Long
Private Declare Function GdipSetInterpolationMode _
Lib "GdiPlus.dll" (ByVal hGraphics As Long, _
ByVal Interpolation As Long) As Long
Private Declare Function GdipDrawImageRectRect _
Lib "GdiPlus.dll" (ByVal hGraphics As Long, _
ByVal hImage As Long, _
ByVal dstX As Single, _
ByVal dstY As Single, _
ByVal dstWidth As Single, _
ByVal dstHeight As Single, _
ByVal srcX As Single, _
ByVal srcY As Single, _
ByVal srcWidth As Single, _
ByVal srcHeight As Single, _
ByVal srcUnit As Long, _
ByVal imageAttributes As Long, _
ByVal Callback As Long, _
ByVal callbackData As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
'Private Declare Function StretchBlt ' Lib "gdi32" (ByVal hdc As Long, ' ByVal x As Long, ' ByVal y As Long, ' ByVal nWidth As Long, ' ByVal nHeight As Long, ' ByVal hSrcDC As Long, ' ByVal xSrc As Long, ' ByVal ySrc As Long, ' ByVal nSrcWidth As Long, ' ByVal nSrcHeight As Long, ' ByVal dwRop As Long) As Long
Private Declare Function SetStretchBltMode _
Lib "gdi32.dll" (ByVal hdc As Long, _
ByVal nStretchMode As Long) As Long
Private Const STRETCH_HALFTONE As Long = 4
'Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'Private Const SRCCOPY = &HCC0020
'Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
'Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long
'Private Declare Function GetWindowDC Lib "user32.dll" (ByVal hWnd As Long) As Long
'Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
'Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SetBkMode _
Lib "gdi32.dll" (ByVal hdc As Long, _
ByVal nBkMode As Long) As Long
Private Const TRANSPARENT As Long = 1
' Variable to hold 'HBmp' property value
Private m_LonHBmp As Long
'????????????????????stdpicture ??????????
Public Property Get HBmp() As Long
HBmp = m_LonHBmp
End Property
'?????
Public Sub DeleteObjectHBmp()
DeleteObject m_LonHBmp
End Sub
Private Function ScaleStdPicture(thePicturehandle As Long, _
thePictureWidth As Long, _
thePictureheight As Long, _
NewWidth As Single, _
NewHeight As Single) As StdPicture
' Pass dimensions in Pixels only
Dim GDIsi As GdiplusStartupInput, gToken As Long
Dim BIH(0 To 9) As Long ' FAUX BitmapInfoHeader structure
Dim hGraphics As Long, hBitmap As Long
Dim tDC As Long, tHandle As Long
Dim hdc As Long
Dim cX As Single, cY As Single
Dim lDPI As Long
GDIsi.GdiplusVersion = 1&
GdiplusStartup gToken, GDIsi ' initialize GDI+
If gToken = 0 Then Exit Function
BIH(0) = 40
BIH(1) = NewWidth: BIH(2) = NewHeight
BIH(3) = &H180001 ' planes & 24 bit
hdc = GetDC(0)
tDC = CreateCompatibleDC(hdc) ' create buffer
ReleaseDC 0, hdc
tHandle = SelectObject(tDC, CreateDIBSection(tDC, BIH(0), 0&, ByVal 0&, 0&, 0&))
If tHandle = 0 Then
GdiplusShutdown gToken ' failed to create DIB section
DeleteDC tDC ' clean up
Exit Function
Else
Call GdipCreateFromHDC(tDC, hGraphics) ' get graphics context
If hGraphics Then ' set stretch quality & copy stdPicture bitmap/jpg
GdipSetInterpolationMode hGraphics, InterpolationModeHighQualityBicubic
Call GdipCreateBitmapFromHBITMAP(thePicturehandle, 0&, hBitmap)
If hBitmap Then ' render to the buffer
lDPI = pvGetDPI()
cX = thePictureWidth '* lDPI / 2540!
cY = thePictureheight '* lDPI / 2540!
GdipDrawImageRectRect hGraphics, hBitmap, 0, 0, NewWidth, NewHeight, 0, 0, cX, cY, 2, 0, 0, 0
GdipDisposeImage hBitmap ' clean up
End If
GdipDeleteGraphics hGraphics ' clean up
End If
End If
GdiplusShutdown gToken ' clean up
tHandle = SelectObject(tDC, tHandle) ' remove our DIB section
DeleteDC tDC
' clean up & create stdPicture from DIB section
Set ScaleStdPicture = pvHandleToStdPicture(tHandle, vbPicTypeBitmap)
End Function
Private Function pvHandleToStdPicture(ByVal hImage As Long, _
ByVal imgType As PictureTypeConstants) As IPicture
Dim IID_IDispatch As GUID, uPicinfo As uPicDesc
Dim R As Long
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With uPicinfo
.Size = Len(uPicinfo)
.Type = PictureTypeConstants.vbPicTypeBitmap
.hPic = hImage
.hPal = 0
End With
R = OleCreatePictureIndirectAut(uPicinfo, IID_IDispatch, True, pvHandleToStdPicture)
If R <> 0 Then
DeleteObject hImage
Err.Raise R, TypeName(Me), "OleCreatePictureIndirect() error 0x" & Hex$(R)
End If
End Function