Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long '獲取剪貼板內容
Public Declare Function CloseClipboard Lib "user32" () As Long '關閉剪貼板
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long '打開剪貼板
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long '鎖定全域記憶體物件中指定的記憶體塊，并回傳一個地址值，令其指向記憶體塊的起始處
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long '取得剪貼板資料大小
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long '解除被鎖定的全域記憶體物件
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) '將一塊記憶體的資料從一個位置復制到另一個位置
Public Declare Function EmptyClipboard Lib "user32" () As Long '清空剪貼板并釋放剪貼板內資料的句柄。
'剪貼版資料格式定義
Public Const CF_TEXT = 1
Public Const CF_BITMAP = 2
Public Const CF_DIB = 8 '位圖，這是我們下面要用到的
'DIB的結構
Public Type BITMAPINFOHEADER '檔案資訊頭——BITMAPINFOHEADER
biSize As Long 'biSize BITMAPINFOHEADER結構的大小。BMP有多個版本，就靠biSize來區別：BMP3.0：BITMAPINFOHEADER（=40）,BMP4.0：BITMAPV4HEADER（=108）,BMP5.0：BITMAPV5HEADER（=124）
biWidth As Long 'biWidth 位圖的寬度，單位是像素
biHeight As Long 'biHeight 位圖的高度，單位是像素
biPlanes As Integer 'biPlanes 設備的位平面數。現在都是1
biBitCount As Integer 'biBitCount 影像的顏色位數:0：當biCompression=BI_JPEG時必須為0（BMP 5.0）, 1：單色位圖,4：16色位圖,8：256色位圖,16：增強色位圖，默認為555格式,24：真彩色位圖,32：32位位圖，默認情況下Windows不會處理最高8位，可以將它作為自己的Alpha通道
biCompression As Long 'biCompression 壓縮方式:BI_RGB：無壓縮,BI_RLE8：行程編碼壓縮，biBitCount必須等于8,BI_RLE4：行程編碼壓縮，biBitCount必須等于4,BI_BITFIELDS：指定RGB掩碼，biBitCount必須等于16、32,BI_JPEG：JPEG壓縮（BMP 5.0）,BI_PNG：PNG壓縮（BMP 5.0）
biSizeImage As Long 'biSizeImage# 實際的位圖資料所占位元組（biCompression=BI_RGB時可以省略）
biXPelsPerMeter As Long 'biXPelsPerMeter# 目標設備的水平解析度，單位是每米的像素個數
biYPelsPerMeter As Long 'biYPelsPerMeter# 目標設備的垂直解析度，單位是每米的像素個數
biClrUsed As Long 'biClrUsed# 使用的顏色數（當biBitCount等于1、4、8時才有效）。如果該項為0，表示顏色數為2^biBitCount
biClrImportant As Long 'biClrImportant# 重要的顏色數。如果該項為0，表示所有顏色都是重要的
End Type
Public Type RGBQUAD '調色板,只有biBitCount等于1、4、8時才有調色板。調色板實際上是一個陣列，元素的個數由biBitCount和biClrUsed決定。
rgbBlue As Byte 'rgbBlue 藍色分量
rgbGreen As Byte 'rgbGreen 綠色分量
rgbRed As Byte 'rgbRed 紅色分量
rgbReserved As Byte 'rgbReserved# 保留，=0
End Type
Public Type bitmapinfo 'bitmapinfoheader結構和調色板資料合在一起就構成了bitmapinfo結構，這個結構在顯示位圖檔案時能夠用到
bmiheader As BITMAPINFOHEADER
bmicolors(0 To 255) As RGBQUAD
End Type
Sub 驗證碼相似法()
Dim img '定義目標圖片物件
Dim CtrlRange '定義非文本物件
Dim bytClipData() As Byte '定義陣列（一維）
Dim arr() As String '定義陣列（一維）
Dim brr() '定義二值化陣列
Dim ts As Integer '定義整數
Dim wjxxt As BITMAPINFOHEADER '定義檔案資訊頭——BITMAPINFOHEADER
Dim tsb As RGBQUAD '定義調色板
Dim xt As bitmapinfo '定義bitmapinfo結構
On Error Resume Next
With CreateObject("InternetExplorer.application") '創建一個空的ie
.Visible = True '讓ie可見
.Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
Do Until .ReadyState = 4 '等待ie完畢加載
DoEvents
Loop
Set img = .Document.getElementById("ctl00_MainContent_imagecheck") '指定（驗證碼）目標圖片
Set CtrlRange = .Document.body.createControlRange() '創建非文本物件 ControlRange 集合
CtrlRange.Add img '向非文本物件 ControlRange 集合中添加 img 物件
CtrlRange.execCommand "Copy", True '從 ControlRange 集合中copy img 物件（圖片）到剪貼板,這樣子讀取的圖片是不包含“位圖檔案頭”的。也就是說，是從位圖檔案的第二部分開始讀取的
Dim hMem As Long, lpData As Long
OpenClipboard 0& '打開剪貼板
hMem = GetClipboardData(8) '獲得剪貼板資料，指定格式為：CF_DIB = 8
If CBool(hMem) Then '判斷hMem是否存在，也就是說是否復制了圖片
lpData = GlobalLock(hMem) '鎖定記憶體物件hMen
lClipSize = GlobalSize(hMem) '獲得剪貼板資料位元組數
If lpData <> 0 And lClipSize > 0 Then
ReDim bytClipData(0 To lClipSize - 1) '重新定義位元組陣列大小
CopyMemory bytClipData(0), ByVal lpData, lClipSize '把剪貼板資料轉移到位元組陣列
CopyMemory wjxxt, ByVal lpData, bytClipData(0) '把剪貼板資料轉移到檔案資訊頭——BITMAPINFOHEADER的wjxxt陣列
With wjxxt
tsbcd = lClipSize - .biSizeImage - .biSize '調色板長度,tsbcd=0則無調色板
txmhzjs = .biSizeImage / .biHeight '影像每行位元組數(肯定是4的倍數)
txmxszjs = Int(txmhzjs / .biWidth) '影像每像素位元組數
txmd0 = txmhzjs - txmxszjs * .biWidth '影像末端填充“0”的位元組數
If tsbcd = 1024 Then
CopyMemory xt, ByVal lpData, tsbcd + .biSize '把剪貼板資料轉移到bitmapinfo的xt陣列
End If
End With
End If
GlobalUnlock hMem '解除鎖定記憶體物件hMen
End If
EmptyClipboard '使用了剪貼板后，就要記著清空它，
CloseClipboard '關閉剪貼板
a1 = wjxxt.biSize '把biSize賦給a1
If tsbcd > 0 Then '如果有調色板
a1 = lClipSize - wjxxt.biSizeImage '就從wjxxt.biSizeImage開始
txmxszjs = 1 '并且一個位元組表示一個點
End If
'-----------------------以下二值化
ReDim arr(1 To wjxxt.biWidth * wjxxt.biHeight) '重新定義arr陣列大小
ReDim brr(1 To wjxxt.biHeight, 1 To wjxxt.biWidth) '重新定義brr陣列大小
For i = 1 To wjxxt.biWidth * wjxxt.biHeight '沒有調色板的話就從第40個位元組開始
arr(i) = "" '1或空（就是沒有）的設定，是圖片顯示方式不同，可以更改這個設定，來看看效果，不過要把下面的arr(i) = "1"一起改。
If tsbcd = 0 Then '沒有調色板
ts = 0 '置初值
For j = 0 To txmxszjs - 1
ts = ts + Val(bytClipData((i - 1) * txmxszjs + a1 + j)) '累加每一點的BGR值，從第lClipSize - wjxxt.biSizeImage個位元組開始
Next j
ts = ts / txmxszjs '影像的BGR的均值（不一定），有調色板的話就不是這個意思。應該說成是圖片點的資訊均值更貼切些，
Else '有調色板
ts = 0
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue) '從調色板取B值
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbGreen) '從調色板取G值
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbRed) '從調色板取R值
ts = ts / 3
End If
If ts < 185 Then '如果影像的BGR的均值<185，那么就把“1”賦給陣列arr(i)，否則arr(i)＝0
arr(i) = "1" '其實就是二值化 0，1
End If
If i / wjxxt.biWidth = Int(i / wjxxt.biWidth) Then a1 = a1 + txmd0 '跳過影像每行末端的附加“0”，因為biSizeImage必須是4的整倍數
Next i
For i = 1 To wjxxt.biHeight
For j = 1 To wjxxt.biWidth
brr(wjxxt.biHeight + 1 - i, j) = arr((i - 1) * wjxxt.biWidth + j) '把一維陣列arr寫入二維陣列brr，注意：要倒過來，從下往上寫，比直接寫入單元格要快些。
Next j
Next i
Dim b(0 To 9)
Dim a(0 To 4)
Dim c(0 To 4)
b(0) = "001111100111111011100111110000111100001111000011110000111100001111000011111001110111111000111100" '這就是所謂的字模“０”
b(1) = "000011000001110000111100011111000100110000001100000011000000110000001100000011000000110000001100"
b(2) = "001111000111111111100011110000110000001100000111000011100001110000111000011100001111111111111111"
b(3) = "001111101111111111000011000000110001111000011110000001110000001111000011111001110111111000111100"
b(4) = "000001100000111000011110000111100011011000110110011001101110011011111111111111110000011000000110"
b(5) = "011111100111111001100000111000001111110011111111110001110000001111000011111001110111111000111100"
b(6) = "001111100111111101100011110000001101110011111110111001111100001111000011111001110111111100111100"
b(7) = "111111111111111100000110000011000000110000011100000110000001100000111000001100000011000000110000"
b(8) = "011111001111111011000011110000111100001101111110011111101100001111000011111001111111111101111100"
a(1) = ""
For i = 6 To 17 '表示第6～17行，驗證碼 c(1)的位置
For j = 4 To 11 '表示第4～11列，驗證碼 c(1)的位置
a(1) = a(1) & Val(brr(i, j)) '形成對比字模 a(1)
Next j
Next i
a(2) = ""
For i = 8 To 19
For j = 17 To 24
a(2) = a(2) & Val(brr(i, j)) '形成對比字模 a(2)
Next j
Next i
a(3) = ""
For i = 6 To 17
For j = 30 To 37
a(3) = a(3) & Val(brr(i, j)) '形成對比字模 a(3)
Next j
Next i
a(4) = ""
For i = 8 To 19
For j = 43 To 50
a(4) = a(4) & Val(brr(i, j)) '形成對比字模 a(4)
Next j
Next i
For i = 1 To 4 '對比，因為有4個驗證碼數字
c(i) = 0
xs1 = 0
For j = 0 To 8 '因為有9個字模
xs = 0
For k = 1 To 96 '96＝8*12就是字模的長度
If Val(Mid(a(i), k, 1)) = Val(Mid(b(j), k, 1)) Then xs = xs + 1 '進行比較，如果相同就累加1
Next k
If xs > xs1 Then '取得最大
c(i) = j
xs1 = xs
Else
xs = 0
End If
Next j
Next i
.Document.getElementById("ctl00_MainContent_txtCode").Value = "123456789123456789"
.Document.getElementById("ctl00_MainContent_code_op").Value = Format(c(1) & c(2) & c(3) & c(4), "0000") '寫入驗證碼
'.Quit
End With
Erase arr() '清空陣列，釋放記憶體
Erase bytClipData()
Erase brr()
End Sub
uj5u.com熱心網友回復：
這代碼主要部分應該和ie+excel無關吧，你檢查一下圖片復制和最后輸出的時候的相關資料......uj5u.com熱心網友回復：
這是EH論壇上藍天大師前年的作品，當時他就說他的程式只在IE8上測驗通過，他的有關驗證碼識別的作品（都是基于IE8的）很多，很遺憾他已經兩年不露面了。
uj5u.com熱心網友回復：
很遺憾，我的也是ie8 + win7 64 家庭普通版，無法安裝ie9以及以上的（曾用網上的方法升級過旗艦版，沒多久系統變非法的.....所以還是老老實實用ie8吧）還是那句話，那影像識別部分應該是與ie無關的，你自己除錯下，應該是可以的。
uj5u.com熱心網友回復：
我這水平太低，挑來挑去也沒效果，老師您能抽空幫我調調嗎？我就是想在新系統下能正常識別，然后再一點一點地研究學習，這個確實有點太難了
uj5u.com熱心網友回復：
不過我很想知道，在ie8 + win7 64 家庭普通版 里，這段代碼能正常識別嗎？我只在 xp+ie8下測驗，把這段代碼放在excel2007中是正常運行的，老師您能幫我在你的系統下試一試嗎？謝謝
uj5u.com熱心網友回復：
哇哈 好神器uj5u.com熱心網友回復：
在ie8 + win7 64 家庭普通版+excel2003/2007都是可以的而且在vb里，修改了一下圖片來源（用loadpicture加載保存在本地的驗證碼圖片）也是可以識別的。
所以說你那代碼的主要識別部分應該與ie是無關的，所以你按照下面2個步驟來除錯：
1、看看是不是圖片復制部分的問題（我沒有ie11，不過就算是ie11那種復制應該也是可以的吧）。方法是在CtrlRange.execCommand "Copy", True 后面添加一句：Sheet1.Paste
運行完成后看看sheet1的表格中是否有圖片(當然要提前清除所有的圖片)
2、最后輸出部分在End With 后面添加：debug.print c(1),c(2),c(3),c(4)。看看結果是什么
如果第1步能得到圖片，那就應該沒有問題的
uj5u.com熱心網友回復：
圖片沒有，反而這段代碼 “Sheet1.Paste” 出現在sheet1里面了，在我的系統里雖然沒有報錯，但識別出來的全是 1111
uj5u.com熱心網友回復：
好吧，你用下面的代碼試試：如果sheet1表格中沒有圖片，那就是獲取圖片部分的代碼有問題。'Option Explicit
Sub 驗證碼相似法()
Dim img '定義目標圖片物件
Dim CtrlRange '定義非文本物件
Dim bytClipData() As Byte '定義陣列（一維）
Dim arr() As String '定義陣列（一維）
Dim brr() '定義二值化陣列
Dim ts As Integer '定義整數
Dim wjxxt As BITMAPINFOHEADER '定義檔案資訊頭——BITMAPINFOHEADER
Dim tsb As RGBQUAD '定義調色板
Dim xt As bitmapinfo '定義bitmapinfo結構
On Error Resume Next
With CreateObject("InternetExplorer.application") '創建一個空的ie
.Visible = True '讓ie可見
.Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
Do Until .ReadyState = 4 '等待ie完畢加載
DoEvents
Loop
Set img = .Document.getElementById("ctl00_MainContent_imagecheck") '指定（驗證碼）目標圖片
Set CtrlRange = .Document.body.createControlRange() '創建非文本物件 ControlRange 集合
CtrlRange.Add img '向非文本物件 ControlRange 集合中添加 img 物件
CtrlRange.execCommand "Copy", True '從 ControlRange 集合中copy img 物件（圖片）到剪貼板,這樣子讀取的圖片是不包含“位圖檔案頭”的。也就是說，是從位圖檔案的第二部分開始讀取的
Sheet1.Paste
Dim hMem As Long, lpData As Long
OpenClipboard 0& '打開剪貼板
hMem = GetClipboardData(8) '獲得剪貼板資料，指定格式為：CF_DIB = 8
If CBool(hMem) Then '判斷hMem是否存在，也就是說是否復制了圖片
lpData = GlobalLock(hMem) '鎖定記憶體物件hMen
lClipSize = GlobalSize(hMem) '獲得剪貼板資料位元組數
If lpData <> 0 And lClipSize > 0 Then
ReDim bytClipData(0 To lClipSize - 1) '重新定義位元組陣列大小
CopyMemory bytClipData(0), ByVal lpData, lClipSize '把剪貼板資料轉移到位元組陣列
CopyMemory wjxxt, ByVal lpData, bytClipData(0) '把剪貼板資料轉移到檔案資訊頭——BITMAPINFOHEADER的wjxxt陣列
With wjxxt
tsbcd = lClipSize - .biSizeImage - .biSize '調色板長度,tsbcd=0則無調色板
txmhzjs = .biSizeImage / .biHeight '影像每行位元組數(肯定是4的倍數)
txmxszjs = Int(txmhzjs / .biWidth) '影像每像素位元組數
txmd0 = txmhzjs - txmxszjs * .biWidth '影像末端填充“0”的位元組數
If tsbcd = 1024 Then
CopyMemory xt, ByVal lpData, tsbcd + .biSize '把剪貼板資料轉移到bitmapinfo的xt陣列
End If
End With
End If
GlobalUnlock hMem '解除鎖定記憶體物件hMen
End If
EmptyClipboard '使用了剪貼板后，就要記著清空它，
CloseClipboard '關閉剪貼板
a1 = wjxxt.biSize '把biSize賦給a1
If tsbcd > 0 Then '如果有調色板
a1 = lClipSize - wjxxt.biSizeImage '就從wjxxt.biSizeImage開始
txmxszjs = 1 '并且一個位元組表示一個點
End If
'-----------------------以下二值化
ReDim arr(1 To wjxxt.biWidth * wjxxt.biHeight) '重新定義arr陣列大小
ReDim brr(1 To wjxxt.biHeight, 1 To wjxxt.biWidth) '重新定義brr陣列大小
For i = 1 To wjxxt.biWidth * wjxxt.biHeight '沒有調色板的話就從第40個位元組開始
arr(i) = "" '1或空（就是沒有）的設定，是圖片顯示方式不同，可以更改這個設定，來看看效果，不過要把下面的arr(i) = "1"一起改。
If tsbcd = 0 Then '沒有調色板
ts = 0 '置初值
For j = 0 To txmxszjs - 1
ts = ts + Val(bytClipData((i - 1) * txmxszjs + a1 + j)) '累加每一點的BGR值，從第lClipSize - wjxxt.biSizeImage個位元組開始
Next j
ts = ts / txmxszjs '影像的BGR的均值（不一定），有調色板的話就不是這個意思。應該說成是圖片點的資訊均值更貼切些，
Else '有調色板
ts = 0
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue) '從調色板取B值
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbGreen) '從調色板取G值
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbRed) '從調色板取R值
ts = ts / 3
End If
If ts < 185 Then '如果影像的BGR的均值<185，那么就把“1”賦給陣列arr(i)，否則arr(i)＝0
arr(i) = "1" '其實就是二值化 0，1
End If
If i / wjxxt.biWidth = Int(i / wjxxt.biWidth) Then a1 = a1 + txmd0 '跳過影像每行末端的附加“0”，因為biSizeImage必須是4的整倍數
Next i
For i = 1 To wjxxt.biHeight
For j = 1 To wjxxt.biWidth
brr(wjxxt.biHeight + 1 - i, j) = arr((i - 1) * wjxxt.biWidth + j) '把一維陣列arr寫入二維陣列brr，注意：要倒過來，從下往上寫，比直接寫入單元格要快些。
Next j
Next i
Dim b(0 To 9)
Dim a(0 To 4)
Dim c(0 To 4)
b(0) = "001111100111111011100111110000111100001111000011110000111100001111000011111001110111111000111100" '這就是所謂的字模“０”
b(1) = "000011000001110000111100011111000100110000001100000011000000110000001100000011000000110000001100"
b(2) = "001111000111111111100011110000110000001100000111000011100001110000111000011100001111111111111111"
b(3) = "001111101111111111000011000000110001111000011110000001110000001111000011111001110111111000111100"
b(4) = "000001100000111000011110000111100011011000110110011001101110011011111111111111110000011000000110"
b(5) = "011111100111111001100000111000001111110011111111110001110000001111000011111001110111111000111100"
b(6) = "001111100111111101100011110000001101110011111110111001111100001111000011111001110111111100111100"
b(7) = "111111111111111100000110000011000000110000011100000110000001100000111000001100000011000000110000"
b(8) = "011111001111111011000011110000111100001101111110011111101100001111000011111001111111111101111100"
a(1) = ""
For i = 6 To 17 '表示第6～17行，驗證碼 c(1)的位置
For j = 4 To 11 '表示第4～11列，驗證碼 c(1)的位置
a(1) = a(1) & Val(brr(i, j)) '形成對比字模 a(1)
Next j
Next i
a(2) = ""
For i = 8 To 19
For j = 17 To 24
a(2) = a(2) & Val(brr(i, j)) '形成對比字模 a(2)
Next j
Next i
a(3) = ""
For i = 6 To 17
For j = 30 To 37
a(3) = a(3) & Val(brr(i, j)) '形成對比字模 a(3)
Next j
Next i
a(4) = ""
For i = 8 To 19
For j = 43 To 50
a(4) = a(4) & Val(brr(i, j)) '形成對比字模 a(4)
Next j
Next i
For i = 1 To 4 '對比，因為有4個驗證碼數字
c(i) = 0
xs1 = 0
For j = 0 To 8 '因為有9個字模
xs = 0
For k = 1 To 96 '96＝8*12就是字模的長度
If Val(Mid(a(i), k, 1)) = Val(Mid(b(j), k, 1)) Then xs = xs + 1 '進行比較，如果相同就累加1
Next k
If xs > xs1 Then '取得最大
c(i) = j
xs1 = xs
Else
xs = 0
End If
Next j
Next i
.Document.getElementById("ctl00_MainContent_txtCode").Value = "123456789123456789"
.Document.getElementById("ctl00_MainContent_code_op").Value = Format(c(1) & c(2) & c(3) & c(4), "0000") '寫入驗證碼
'.Quit
End With
Debug.Print c(1), c(2), c(3), c(4)
Erase arr() '清空陣列，釋放記憶體
Erase bytClipData()
Erase brr()
End Sub
uj5u.com熱心網友回復：
沒有圖片，我去xp里面試了，那里有圖片，看來還是獲取圖片出問題了
uj5u.com熱心網友回復：
我跟蹤了一下，這句 ：CtrlRange.Add img 沒有添加成功uj5u.com熱心網友回復：
這句就沒成功：Set CtrlRange = .Document.body.createControlRange()在XP里面這些玩這句后，有個length=0（執行完下一句，就=1），而在新系統里什么也沒有
uj5u.com熱心網友回復：
那沒轍了，沒有ie11，不知道啥情況。不過你可以用webbrowser試一試（不知結果如何）：在sheet1中添加一個webbrowser(Microsoft Web Browser)并改名WB，然后復制下面代碼到模塊里（api以及常數，結構定義單獨復制），運行test
Sub Test()
''用webbrowser加載圖片
Dim img, CtrlRange
With Sheet1.WB
.Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
Do Until .ReadyState = 4 '等待ie完畢加載
DoEvents
Loop
Set img = .Document.getElementById("ctl00_MainContent_imagecheck") '指定（驗證碼）目標圖片
Set CtrlRange = .Document.body.createControlRange() '創建非文本物件 ControlRange 集合
CtrlRange.Add img '向非文本物件 ControlRange 集合中添加 img 物件
CtrlRange.execCommand "Copy", True '從 ControlRange 集合中copy img 物件（圖片）到剪貼板,這樣子讀取的
End With
驗證碼相似法1
End Sub
Sub 驗證碼相似法1()
Dim bytClipData() As Byte '定義陣列（一維）
Dim arr() As String '定義陣列（一維）
Dim brr() '定義二值化陣列
Dim ts As Integer '定義整數
Dim wjxxt As BITMAPINFOHEADER '定義檔案資訊頭——BITMAPINFOHEADER
Dim tsb As RGBQUAD '定義調色板
Dim xt As bitmapinfo '定義bitmapinfo結構
On Error Resume Next
Dim hMem As Long, lpData As Long
OpenClipboard 0& '打開剪貼板
hMem = GetClipboardData(8) '獲得剪貼板資料，指定格式為：CF_DIB = 8
If CBool(hMem) Then '判斷hMem是否存在，也就是說是否復制了圖片
lpData = GlobalLock(hMem) '鎖定記憶體物件hMen
lClipSize = GlobalSize(hMem) '獲得剪貼板資料位元組數
If lpData <> 0 And lClipSize > 0 Then
ReDim bytClipData(0 To lClipSize - 1) '重新定義位元組陣列大小
CopyMemory bytClipData(0), ByVal lpData, lClipSize '把剪貼板資料轉移到位元組陣列
CopyMemory wjxxt, ByVal lpData, bytClipData(0) '把剪貼板資料轉移到檔案資訊頭——BITMAPINFOHEADER的wjxxt陣列
With wjxxt
tsbcd = lClipSize - .biSizeImage - .biSize '調色板長度,tsbcd=0則無調色板
txmhzjs = .biSizeImage / .biHeight '影像每行位元組數(肯定是4的倍數)
txmxszjs = Int(txmhzjs / .biWidth) '影像每像素位元組數
txmd0 = txmhzjs - txmxszjs * .biWidth '影像末端填充“0”的位元組數
If tsbcd = 1024 Then
CopyMemory xt, ByVal lpData, tsbcd + .biSize '把剪貼板資料轉移到bitmapinfo的xt陣列
End If
End With
End If
GlobalUnlock hMem '解除鎖定記憶體物件hMen
End If
EmptyClipboard '使用了剪貼板后，就要記著清空它，
CloseClipboard '關閉剪貼板
a1 = wjxxt.biSize '把biSize賦給a1
If tsbcd > 0 Then '如果有調色板
a1 = lClipSize - wjxxt.biSizeImage '就從wjxxt.biSizeImage開始
txmxszjs = 1 '并且一個位元組表示一個點
End If
'-----------------------以下二值化
ReDim arr(1 To wjxxt.biWidth * wjxxt.biHeight) '重新定義arr陣列大小
ReDim brr(1 To wjxxt.biHeight, 1 To wjxxt.biWidth) '重新定義brr陣列大小
For i = 1 To wjxxt.biWidth * wjxxt.biHeight '沒有調色板的話就從第40個位元組開始
arr(i) = "" '1或空（就是沒有）的設定，是圖片顯示方式不同，可以更改這個設定，來看看效果，不過要把下面的arr(i) = "1"一起改。
If tsbcd = 0 Then '沒有調色板
ts = 0 '置初值
For j = 0 To txmxszjs - 1
ts = ts + Val(bytClipData((i - 1) * txmxszjs + a1 + j)) '累加每一點的BGR值，從第lClipSize - wjxxt.biSizeImage個位元組開始
Next j
ts = ts / txmxszjs '影像的BGR的均值（不一定），有調色板的話就不是這個意思。應該說成是圖片點的資訊均值更貼切些，
Else '有調色板
ts = 0
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue) '從調色板取B值
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbGreen) '從調色板取G值
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbRed) '從調色板取R值
ts = ts / 3
End If
If ts < 185 Then '如果影像的BGR的均值<185，那么就把“1”賦給陣列arr(i)，否則arr(i)＝0
arr(i) = "1" '其實就是二值化 0，1
End If
If i / wjxxt.biWidth = Int(i / wjxxt.biWidth) Then a1 = a1 + txmd0 '跳過影像每行末端的附加“0”，因為biSizeImage必須是4的整倍數
Next i
For i = 1 To wjxxt.biHeight
For j = 1 To wjxxt.biWidth
brr(wjxxt.biHeight + 1 - i, j) = arr((i - 1) * wjxxt.biWidth + j) '把一維陣列arr寫入二維陣列brr，注意：要倒過來，從下往上寫，比直接寫入單元格要快些。
Next j
Next i
Dim b(0 To 9)
Dim a(0 To 4)
Dim c(0 To 4)
b(0) = "001111100111111011100111110000111100001111000011110000111100001111000011111001110111111000111100" '這就是所謂的字模“０”
b(1) = "000011000001110000111100011111000100110000001100000011000000110000001100000011000000110000001100"
b(2) = "001111000111111111100011110000110000001100000111000011100001110000111000011100001111111111111111"
b(3) = "001111101111111111000011000000110001111000011110000001110000001111000011111001110111111000111100"
b(4) = "000001100000111000011110000111100011011000110110011001101110011011111111111111110000011000000110"
b(5) = "011111100111111001100000111000001111110011111111110001110000001111000011111001110111111000111100"
b(6) = "001111100111111101100011110000001101110011111110111001111100001111000011111001110111111100111100"
b(7) = "111111111111111100000110000011000000110000011100000110000001100000111000001100000011000000110000"
b(8) = "011111001111111011000011110000111100001101111110011111101100001111000011111001111111111101111100"
a(1) = ""
For i = 6 To 17 '表示第6～17行，驗證碼 c(1)的位置
For j = 4 To 11 '表示第4～11列，驗證碼 c(1)的位置
a(1) = a(1) & Val(brr(i, j)) '形成對比字模 a(1)
Next j
Next i
a(2) = ""
For i = 8 To 19
For j = 17 To 24
a(2) = a(2) & Val(brr(i, j)) '形成對比字模 a(2)
Next j
Next i
a(3) = ""
For i = 6 To 17
For j = 30 To 37
a(3) = a(3) & Val(brr(i, j)) '形成對比字模 a(3)
Next j
Next i
a(4) = ""
For i = 8 To 19
For j = 43 To 50
a(4) = a(4) & Val(brr(i, j)) '形成對比字模 a(4)
Next j
Next i
For i = 1 To 4 '對比，因為有4個驗證碼數字
c(i) = 0
xs1 = 0
For j = 0 To 8 '因為有9個字模
xs = 0
For k = 1 To 96 '96＝8*12就是字模的長度
If Val(Mid(a(i), k, 1)) = Val(Mid(b(j), k, 1)) Then xs = xs + 1 '進行比較，如果相同就累加1
Next k
If xs > xs1 Then '取得最大
c(i) = j
xs1 = xs
Else
xs = 0
End If
Next j
Next i
MsgBox c(1) & c(2) & c(3) & c(4)
Erase arr() '清空陣列，釋放記憶體
Erase bytClipData()
Erase brr()
End Sub
uj5u.com熱心網友回復：
加載時，webbrowser的內容總是不變，識別出的驗證碼不對，總是888，看來IE升級后，可能需要大改動
uj5u.com熱心網友回復：
驗證碼圖片在IE臨時檔案夾可以找到，不過是jpg格式的uj5u.com熱心網友回復：
看來太費勁，算了，我也裝個IE8吧，你那里套用這段代碼能識別這個驗證碼嗎？ http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447
看起來差不多，但不知道應該怎么改
uj5u.com熱心網友回復：
1、ie11據說是可以當成ie10，9，8，7等來使用，應該沒有必要再安裝一個ie8；2、想用你那個代碼來識別http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447，是不行的，雖然都是純數字，但是亦增加了旋轉，難度增加........
uj5u.com熱心網友回復：
我試了試，如果創建好IE后，按F12，可以選擇IE8，IMG就可以加載進ControlRange中了，但是接下來這句 If CBool(hMem) Then '判斷hMem是否存在，也就是說是否復制了圖片 ，是false，說明圖片還是沒有復制成功，不知道又哪里不兼容了，看來太難了
uj5u.com熱心網友回復：
可以嘗試ie11手動打開網站，找到驗證碼圖片，然后右鍵復制，再運行#13樓的【 Sub 驗證碼相似法1()】 程序，如果還是不能讀取出來，那就放棄吧，只能從檔案著手了（快取檔案）......uj5u.com熱心網友回復：
執行到：ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue) '從調色板取B值
提示：下標越界
uj5u.com熱心網友回復：
Structure FILETIME
Dim dwLowDateTime As Int32
Dim dwHighDateTime As Int32
End Structure
Structure INTERNET_CACHE_ENTRY_INFO
Dim dwStructSize As Int32 ' version of cache system.
Dim lpszSourceUrlName As Int32 ' embedded pointer to the URL name string.
Dim lpszLocalFileName As Int32 ' embedded pointer to the local file name.
Dim CacheEntryType As Int32 ' cache type bit mask.
Dim dwUseCount As Int32 ' current users count of the cache entry.
Dim dwHitRate As Int32 ' num of times the cache entry was retrieved.
Dim dwSizeLow As Int32 ' low DWORD of the file size.
Dim dwSizeHigh As Int32 ' high DWORD of the file size.
Dim LastModifiedTime As FILETIME ' last modified time of the file in GMT format.
Dim ExpireTime As FILETIME ' expire time of the file in GMT format
Dim LastAccessTime As FILETIME ' last accessed time in GMT format
Dim LastSyncTime As FILETIME ' last time the URL was synchronized
' with the source
Dim lpHeaderInfo As Int32 ' embedded pointer to the header info.
Dim dwHeaderInfoSize As Int32 ' size of the above header.
Dim lpszFileExtension As Int32 ' File extension used to retrive the urldata as a file.
Dim dwExemptDelta As Int32 ' Exemption delta from last access
End Structure
Declare Unicode Function GetUrlCacheEntryInfo Lib "wininet.dll" Alias "GetUrlCacheEntryInfoW" (ByVal lpszUrlName As String, ByRef lpCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByRef lpcbCacheEntryInfo As Int32) As Int32
Dim bmp As Drawing.Bitmap
Dim g As Graphics
Dim data As Imaging.BitmapData
Dim urlinfo(10) As INTERNET_CACHE_ENTRY_INFO
Dim fok As Int32
Dim dw As Int32
Dim url As String
Dim web As SHDocVw.WebBrowser
Dim doc As mshtml.HTMLDocument
Dim eimg As mshtml.HTMLImg
web = CreateObject("InternetExplorer.Application")
web.Visible = True
web.Navigate("http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx")
While web.Busy Or Not web.ReadyState = SHDocVw.tagREADYSTATE.READYSTATE_COMPLETE
Application.DoEvents()
End While
doc = web.Document
eimg = doc.GetElementById("ctl00_MainContent_imagecheck")
dw = Len(urlinfo(0)) * 11
fok = GetUrlCacheEntryInfo(eimg.src, urlinfo(0), dw)
url = Runtime.InteropServices.Marshal.PtrToStringUni(urlinfo(0).lpszLocalFileName)
bmp = New Bitmap(url)
data = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format1bppIndexed)
Dim p1 As IntPtr
Dim np As Int32
Dim b As Byte
p1 = data.Scan0
np = 0
For r As Int32 = 1 To data.Height
For c As Int32 = 1 To data.Width / 8
b = Runtime.InteropServices.Marshal.ReadByte(p1, np)
np += 1
For m As Int32 = 7 To 0 Step -1
Debug.Write(IIf(b And (2 ^ m), "-", "0"))
Next
Next
If data.Width Mod 8 > 0 Then
b = Runtime.InteropServices.Marshal.ReadByte(p1, np)
np += 1
For m As Int32 = 7 To 8 - data.Width Mod 8 Step -1
Debug.Write(IIf(b And (2 ^ m), "-", "0"))
Next
End If
Debug.Write(vbCrLf)
If np Mod 8 > 0 Then np += 8
Next
bmp.UnlockBits(data)
'bmp.Save("D:\Administrator\desktop\aa.bmp")
g = Graphics.FromHwnd(Me.Handle)
g.DrawImage(bmp, 0, 0) '視窗顯示黑白數字影像
----------------------------------------------------------
----------------------------------------------------------
----------------------------------------------------------
----------------------------------------------------------
----------------------------------------------------------
-----0000---------------------000000----------------------
----000000--------------------000000----------------------
---000---00-------0000--------00------------0000----------
---00----00------000000-------0------------000000---------
---------00-----00----00-----000000-------000---00--------
--------00------------00-----0000000------00----00--------
-------000---------0000------00---000-----------00--------
------000----------0000------------00----------00---------
-----000-------------000-----00----00---------000---------
----00----------------00-----000--000--------000----------
---00000000-----00----00------000000--------000-----------
---00000000-----000--000-------0000--------00-------------
-----------------000000-------------------00000000--------
------------------0000--------------------00000000--------
----------------------------------------------------------
----------------------------------------------------------
----------------------------------------------------------
----------------------------------------------------------
----------------------------------------------------------
----------------------------------------------------------
uj5u.com熱心網友回復：
你這種識別驗證碼方式沒有容錯，判斷不出機率很高你這種識別驗證碼方式沒有容錯，判斷不出機率很高
我來一個：
參考VerifyCodeIdentify.dll， 下載地址：http://pan.baidu.com/s/1mgJtYTq
將字模庫.txt和你的應用程式放在同一檔案夾下。
Sub 驗證碼相似法2()
Dim img '定義目標圖片物件
Dim CtrlRange '定義非文本物件
On Error Resume Next
With CreateObject("InternetExplorer.application") '創建一個空的ie
.Visible = True '讓ie可見
.Navigate "http://www.haiguan.info/onlinesearch/gateway/Gatewaystate.aspx"
Do Until .ReadyState = 4 '等待ie完畢加載
DoEvents
Loop
Set img = .Document.getElementById("ctl00_MainContent_imagecheck") '指定（驗證碼）目標圖片
Set CtrlRange = .Document.body.createControlRange() '創建非文本物件 ControlRange 集合
CtrlRange.Add img '向非文本物件 ControlRange 集合中添加 img 物件
CtrlRange.execCommand "Copy", True '從 ControlRange 集合中copy img 物件（圖片）到剪貼板,這樣子讀取的圖片是不包含“位圖檔案頭”的。也就是說，是從位圖檔案的第二部分開始讀取的
''''''''''''''''''''''''''''
Dim vci As New clsVCI
Dim p As StdPicture
Set p = Clipboard.GetData
Set vci.vc_picture = p
vci.Similarity = 0.8
vci.ReadTemplate Replace(App.Path & "\字模庫.txt", "\\", "\")
.Document.getElementById("ctl00_MainContent_txtCode").Value = "123456789123456789"
.Document.getElementById("ctl00_MainContent_code_op").Value = vci.VerifyCode(185, 185, 185, 4, 5, 8, 1) '寫入驗證碼
Set vci = Nothing
''''''''''''''''''''''''''''''''''''''
'.Quit
End With
End Sub
uj5u.com熱心網友回復：
在我的資源里也能下載到VerifyCodeIdentify.dlluj5u.com熱心網友回復：
你的這段代碼能識別我的驗證碼嗎，我的驗證碼有點傾斜，但是純數字應該不算難吧
http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447
uj5u.com熱心網友回復：
CtrlRange.Add img
運行時錯誤 438，物件不支持該屬性或方法，是不是非要IE8才行？
uj5u.com熱心網友回復：
換成IE8，上面通過了，但這句Set p = Clipboard.GetData又提示錯誤 424，要求物件，是不是要參考什么？
uj5u.com熱心網友回復：
你不是在vb6下運行嗎？是在VBA下？uj5u.com熱心網友回復：
我沒裝VB6，我是在excel里面的VBA里運行，我的系統win7-64,+IE11+excel2010，實在找不到能運行的驗證碼識別例子，只能切換到 xp+ie8+excel2007里，才可以識別
uj5u.com熱心網友回復：
這個我直接復制到VBA里面，不能運行，好多紅字，是不是只能在VB環境里運行？
uj5u.com熱心網友回復：
這是vb.net寫的，直接取檔案，ie11應該可以用uj5u.com熱心網友回復：
這么說vba不能用？我是想在excel里面呼叫識別驗證碼
uj5u.com熱心網友回復：
可以生成com讓vba呼叫uj5u.com熱心網友回復：
你的這段代碼能識別下面的驗證碼嗎，這個驗證碼有點傾斜，但是純數字
http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447
你代碼中的點陣莊的字符，怎么變成可以用的數字？我網上也找到一段點啊能把上面網址中的驗證碼在excel中顯示出點陣狀的字符，但我不知道怎么把他提取成可以使用的數字
uj5u.com熱心網友回復：
Sub 驗證碼識別()
Dim img '定義目標圖片物件
Dim CtrlRange '定義非文本物件
Dim bytClipData() As Byte '定義陣列（一維）
Dim arr() As String '定義陣列（一維）
Dim brr() '定義二值化陣列
Dim ts As Integer '定義整數
Dim wjxxt As BITMAPINFOHEADER '定義檔案資訊頭——BITMAPINFOHEADER
Dim tsb As RGBQUAD '定義調色板
Dim xt As bitmapinfo '定義bitmapinfo結構
Dim b
Dim c
Dim a(1 To 4)
Dim tmp()
Dim temp As String
Cells.Clear '清空作業表
b = Split(",69b9768a84,567667975,99668986,246866543,444ddd222,79b6446b97,46669d96,48a8679b96,38cb77bc83,344554ddd22", ",")
c = Split(",6,2,5,7,1,0,3,9,8,4", ",")
On Error Resume Next
Cells.Clear
With CreateObject("InternetExplorer.application") '創建一個空的ie
.Visible = True '讓ie可見
.Navigate "http://www.waheaven.com/Service/VerifyCodeForUserControl.aspx?time=1418612374447"
Do Until .ReadyState = 4 '等待ie完畢加載
DoEvents
Loop
Set img = .Document.All.tags("img")(0) '指定（驗證碼）目標圖片
Set CtrlRange = .Document.body.createControlRange() '創建非文本物件 ControlRange 集合
CtrlRange.Add img '向非文本物件 ControlRange 集合中添加 img 物件
CtrlRange.execCommand "Copy", True '從 ControlRange 集合中copy img 物件（圖片）到剪貼板,這樣子讀取的圖片是不包含“位圖檔案頭”的。也就是說，是從位圖檔案的第二部分開始讀取的
Dim hMem As Long, lpData As Long
OpenClipboard 0& '打開剪貼板
hMem = GetClipboardData(8) '獲得剪貼板資料，指定格式為：CF_DIB = 8
If CBool(hMem) Then '判斷hMem是否存在，也就是說是否復制了圖片
lpData = GlobalLock(hMem) '鎖定記憶體物件hMen
lClipSize = GlobalSize(hMem) '獲得剪貼板資料位元組數
If lpData <> 0 And lClipSize > 0 Then
ReDim bytClipData(0 To lClipSize - 1) '重新定義位元組陣列大小
CopyMemory bytClipData(0), ByVal lpData, lClipSize '把剪貼板資料轉移到位元組陣列
CopyMemory wjxxt, ByVal lpData, bytClipData(0) '把剪貼板資料轉移到檔案資訊頭——BITMAPINFOHEADER的wjxxt陣列
With wjxxt
tsbcd = lClipSize - .biSizeImage - .biSize '調色板長度,tsbcd=0則無調色板
txmhzjs = .biSizeImage / .biHeight '影像每行位元組數(肯定是4的倍數)
txmxszjs = Int(txmhzjs / .biWidth) '影像每像素位元組數
txmd0 = txmhzjs - txmxszjs * .biWidth '影像末端填充“0”的位元組數
If tsbcd = 1024 Then
CopyMemory xt, ByVal lpData, tsbcd + .biSize '把剪貼板資料轉移到bitmapinfo的xt陣列
End If
End With
End If
GlobalUnlock hMem '解除鎖定記憶體物件hMen
End If
EmptyClipboard '使用了剪貼板后，就要記著清空它，
CloseClipboard '關閉剪貼板
a1 = wjxxt.biSize '把biSize賦給a1
If tsbcd > 0 Then '如果有調色板
a1 = lClipSize - wjxxt.biSizeImage '就從wjxxt.biSizeImage開始
txmxszjs = 1 '并且一個位元組表示一個點
End If
ReDim arr(1 To wjxxt.biWidth * wjxxt.biHeight) '重新定義arr陣列大小
ReDim brr(1 To wjxxt.biHeight, 1 To wjxxt.biWidth) '重新定義brr陣列大小
For i = 1 To wjxxt.biWidth * wjxxt.biHeight '沒有調色板的話就從第40個位元組開始
arr(i) = "" '1或空（就是沒有）的設定，是圖片顯示方式不同，可以更改這個設定，來看看效果，不過要把下面的arr(i) = "1"一起改。
If tsbcd = 0 Then '沒有調色板
ts = 0 '置初值
For j = 0 To txmxszjs - 1
ts = ts + Val(bytClipData((i - 1) * txmxszjs + a1 + j)) '累加每一點的BGR值，從第lClipSize - wjxxt.biSizeImage個位元組開始
Next j
ts = ts / txmxszjs '影像的BGR的均值（不一定），有調色板的話就不是這個意思。應該說成是圖片點的資訊均值更貼切些，
Else '有調色板
ts = 0
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbBlue) '從調色板取B值
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbGreen) '從調色板取G值
ts = ts + Val(xt.bmicolors(Val(bytClipData((i - 1) * txmxszjs + a1 + j))).rgbRed) '從調色板取R值
ts = ts / 3
End If
If ts < 205 Then '如果影像的BGR的均值>10，那么就把“1”賦給陣列arr(i)
arr(i) = "1" '其實就是二值化
End If
If i / wjxxt.biWidth = Int(i / wjxxt.biWidth) Then a1 = a1 + txmd0 '跳過影像每行末端的附加“0”，因為biSizeImage必須是4的整倍數
Next i
For i = 1 To wjxxt.biHeight
For j = 1 To wjxxt.biWidth
brr(wjxxt.biHeight + 1 - i, j) = arr((i - 1) * wjxxt.biWidth + j) '把一維陣列arr寫入二維陣列brr，注意：要倒過來，從下往上寫，比直接寫入單元格要快些。
Next j
Next i
Range(Cells(1, 1), Cells(wjxxt.biHeight, wjxxt.biWidth)) = brr '把二維陣列brr一次性寫入單元格。
temp = ""
For i = 1 To wjxxt.biWidth
For j = 1 To wjxxt.biHeight
Cells(wjxxt.biHeight + 1, i) = Cells(wjxxt.biHeight + 1, i) + arr((j - 1) * wjxxt.biWidth + i) '累加，就是所謂的“壓壓扁”，寫入wjxxt.biWidth+1行。
Next j
If Cells(wjxxt.biHeight + 1, i) = 10 Then Cells(wjxxt.biHeight + 1, i) = "a" '把10用ａ表示、11用ｂ表示…………
If Cells(wjxxt.biHeight + 1, i) = 11 Then Cells(wjxxt.biHeight + 1, i) = "b"
If Cells(wjxxt.biHeight + 1, i) = 12 Then Cells(wjxxt.biHeight + 1, i) = "c"
If Cells(wjxxt.biHeight + 1, i) = 13 Then Cells(wjxxt.biHeight + 1, i) = "d"
If Cells(wjxxt.biHeight + 1, i) <> "" Then
temp = temp & Cells(wjxxt.biHeight + 1, i) '把wjxxt.biWidth+1行的數串起來
Else
temp = temp & ","
temp = Replace(temp, ",,", ",")
End If
Next i
Rows(wjxxt.biHeight + 1 & ":" & wjxxt.biHeight + 1).ClearContents
temp = Right(temp, Len(temp) - 1)
temp = Left(temp, Len(temp) - 1)
'下面的回圈才是真正的識別
For j = 1 To UBound(b)
temp = Replace(temp, b(j), c(j)) '裁減字串
Next j
ttp = Split(temp, ",")
p = 0
For i = 0 To UBound(ttp)
If Len(ttp(i)) = 1 Then
p = p + 1
a(p) = ttp(i)
Else
If Len(tmp(i)) > 1 Then
For j = 1 To UBound(b)
ttp(i) = Replace(ttp(i), Left(b(j), Len(b(j)) - 3), c(j)) '裁減字串
ttp(i) = Replace(ttp(i), Right(b(j), Len(b(j)) - 3), c(j)) '裁減字串
Next j
p = p + 1
a(p) = Left(ttp(i), 1)
p = p + 1
a(p) = Right(ttp(i), 1)
End If
End If
Next i
Range("A1:A1").NumberFormatLocal = "@"
Cells(1, 1) = Format(a(1) & a(2) & a(3) & a(4), "0000") '這就是識別后的驗證碼
.Quit
End With
End Sub
這個在excel中的Cells(1, 1)中提取出來數字不對，但點陣中顯示的是對的，我這個只能在IE8中顯示出來，ie11不行
uj5u.com熱心網友回復：
任意傾斜的字體就不用想了，如果那么容易識別就不用找人打碼了uj5u.com熱心網友回復：
在“云人件”面前，任何形式的驗證碼形同虛設！轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/103762.html
標籤：VBA