求VB程序转VBA

VERSION 5.00
Object = "{D95CB779-00CB-4B49-97B9-9F0B61CAB3C1}#3.5#0"; "Biokey.ocx"
Begin VB.Form Form1
Caption = "Biokey Demo"
ClientHeight = 7380
ClientLeft = 2385
ClientTop = 1755
ClientWidth = 9810
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
ScaleHeight = 492
ScaleMode = 3 'Pixel
ScaleWidth = 654
Begin ZKFPEngXControl.ZKFPEngX ZKFPEngX1
Left = 9000
Top = 480
EnrollCount = 3
SensorIndex = 0
Threshold = 10
VerTplFileName = ""
RegTplFileName = ""
OneToOneThreshold= 10
Active = 0 'False
IsRegister = 0 'False
EnrollIndex = 0
SensorSN = ""
FPEngineVersion = "3.5.00 For 1:N"
ImageWidth = 0
ImageHeight = 0
SensorCount = 0
TemplateLen = 1152
EngineValid = 0 'False
End
Begin https://www.360docs.net/doc/9617848992.html,mandButton Command1
Caption = "AddImage"
Height = 495
Left = 8400
TabIndex = 28
Top = 6480
Width = 1335
End
Begin https://www.360docs.net/doc/9617848992.html,mandButton cmdLoad
Caption = "Load form DB"
Height = 495
Left = 6360
TabIndex = 27
Top = 6480
Width = 1815
End
Begin https://www.360docs.net/doc/9617848992.html,mandButton cmdSave
Caption = "save template"
Height = 495
Left = 4200
TabIndex = 26
Top = 6480
Width = 1695
End
Begin VB.TextBox txtuserID
Height = 495
Left = 1320
TabIndex = 25
Top = 6480
Width = 2535
End
Begin VB.Frame FrameCommands
Height = 5775
Left = 0
TabIndex = 0
Top = 0
Width = 4815
Begin https://www.360docs.net/doc/9617848992.html,mandButton cmdEnroll
Caption = "Register"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 12
Top = 2520
Width = 1695
End

Begin https://www.360docs.net/doc/9617848992.html,mandButton cmdVerify
Caption = "Verify(1:1)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 11
Top = 3120
Width = 1695
End
Begin https://www.360docs.net/doc/9617848992.html,mandButton cmdIdentify
Caption = "identify(1:N)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2160
TabIndex = 10
Top = 3120
Width = 1695
End
Begin VB.TextBox TextFingerName
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 2640
TabIndex = 9
Text = "fingerprint1"
Top = 2520
Width = 1935
End
Begin https://www.360docs.net/doc/9617848992.html,mandButton cmdInit
Caption = "Initial Sensor"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 8
Top = 1200
Width = 1695
End
Begin VB.TextBox TextSensorCount
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 1560
TabIndex = 7
Top = 360
Width = 975

End
Begin VB.TextBox TextSensorIndex
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 3600
TabIndex = 6
Top = 360
Width = 855
End
Begin VB.TextBox TextSensorSN
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 1560
TabIndex = 5
Top = 720
Width = 2895
End
Begin VB.Frame Frame2
Caption = "Image Format"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 2040
TabIndex = 2
Top = 1680
Width = 1935
Begin VB.OptionButton OptionBmp
Caption = "BMP"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 4
Top = 240
Value = -1 'True
Width = 735
End
Begin VB.OptionButton OptionJpg
Caption = "JPEG"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 960
TabIndex = 3
Top

= 240
Width = 855
End
End
Begin https://www.360docs.net/doc/9617848992.html,mandButton cmdSaveImage
Caption = "Save Image"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 1
Top = 1800
Width = 1695
End
Begin VB.TextBox TextWrite
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 1440
TabIndex = 19
Text = "ZKSoftware Biokey SDK."
Top = 4560
Width = 3015
End
Begin VB.TextBox TextRead
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 1440
TabIndex = 20
Top = 4080
Width = 3015
End
Begin https://www.360docs.net/doc/9617848992.html,mandButton cmdReadMemory
Caption = "Read"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 21
Top = 4080
Width = 1095
End
Begin https://www.360docs.net/doc/9617848992.html,mandButton cmdSaveMemory
Caption = "Write"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 22

Top = 4560
Width = 1095
End
Begin VB.Frame Frame3
Caption = "Doggle demo"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1215
Left = 120
TabIndex = 23
Top = 3840
Width = 4455
End
Begin https://www.360docs.net/doc/9617848992.html,bel Label1
Caption = "Name"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2160
TabIndex = 18
Top = 2640
Width = 735
End
Begin https://www.360docs.net/doc/9617848992.html,bel StatusBar
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
TabIndex = 17
Top = 5160
Width = 4455
End
Begin https://www.360docs.net/doc/9617848992.html,bel Label3
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2280
TabIndex = 16
Top = 1200
Width = 975
End
Begin https://www.360docs.net/doc/9617848992.html,bel Label2
Caption = "Sensor Cnt"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 15
Top = 360
Width = 1095
End
Begin https://www.360docs.net/doc/9617848992.html,bel Label4
Caption

= "Current"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2640
TabIndex = 14
Top = 360
Width = 975
End
Begin https://www.360docs.net/doc/9617848992.html,bel Label5
Caption = "Serial Number"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 13
Top = 720
Width = 1335
End
End
Begin https://www.360docs.net/doc/9617848992.html,bel U
Caption = "User ID"
Height = 375
Left = 120
TabIndex = 24
Top = 6480
Width = 1095
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim FTempLen As Integer
Dim FRegTemplate As String
Dim FingerCount As Long

Dim FFingerNames() As String
Dim FMatchType As Integer
Dim ImgPath As String

Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long

Private Sub cmdEnroll_Click()
Dim strsql1 As String
Dim maxNum As Long

Set recFinger = New ADODB.Recordset
If TextFingerName.Text = "" Then
MessageBox 0, "Please enter ID", "Error", 0
Exit Sub
End If
ZKFPEngX1.BeginEnroll

StatusBar.Caption = "Begin Register"
strsql1 = "select max(ID) as maxnum from template "
'conn.Execute strsql1, recFinger, -1
recFinger.Open strsql1, conn, adOpenKeyset, adLockOptimistic
If recFinger.Fields("maxnum") <> 0 Then
txtuserID.Text = CStr(recFinger.Fields("maxnum") + 1)
recFinger.Close
Else
txtuserID.Text = "1"
End If
End Sub

Private Sub cmdIdentify_Click()
If ZKFPEngX1.IsRegister Then
ZKFPEngX1.CancelEnroll
End If
StatusBar.Caption = "Start Identification(1:N)"
FMatchType = 2
End Sub

Private Sub cmdInit_Click()
ZKFPEngX1.SensorIndex = 0
If ZKFPEngX1.InitEngine = 0 Then
MessageBox 0, "init success", "Hint", 0

StatusBar.Caption = "Sensor Connected"
TextSensorCount.Text = ZKFPEngX1.SensorCount & ""
TextSensorIndex.Text = ZKFPEngX

1.SensorIndex & ""
TextSensorSN.Text = ZKFPEngX1.SensorSN

cmdInit.Enabled = False
FMatchType = 0
End If
End Sub

Private Sub cmdLoad_Click()
Dim rectemp As ADODB.Recordset
Dim sqlstrLoad As String
Dim i As Long

Set rectemp = New ADODB.Recordset
sqlstrLoad = "select id,FingerTmplate from template"

rectemp.CursorLocation = adUseServer
rectemp.Open sqlstrLoad, conn 'adOpenKeyset, adLockOptimistic

' conn.Execute sqlstrLoad, rectemp, -1
' rectemp.MoveFirst

' For i = 1 To rectemp.RecordCount *** this sentence have some error for mysql,I think Microsoftware could modify they tool.haha.
Do While Not rectemp.EOF
ZKFPEngX1.AddRegTemplateStrToFPCacheDB FpcHandle, rectemp("ID"), rectemp("FingerTmplate")
rectemp.MoveNext
Loop
' Next
End Sub

Private Sub cmdReadMemory_Click()
Dim i, p1 As Long, p2 As Long
Dim p As Variant
Dim s As String

p1 = 0
p2 = 23
ZKFPEngX1.DongleMemRead p1, p2, p

s = ""
For i = LBound(p) To UBound(p)
's = s & Chr(p(i))
Next

TextRead.Text = s

End Sub

Private Sub cmdSave_Click()
Dim strsql As String

strsql = "insert into template values (" & CInt(txtuserID.Text) & ",'" & sTemp & "')"
conn.Execute strsql
cmdSave.Enabled = False
End Sub

Private Sub cmdSaveMemory_Click()
' Dim p1 As Long, p2 As Long
' Dim p() As Byte
' Dim i As Integer
' Dim s As String
'
' p1 = 0
' p2 = Len(TextWrite.Text)
' s = TextWrite.Text
' ReDim p(Len(s))
' For i = 0 To Len(s) - 1
' p(i) = Asc(Mid(s, i + 1))
' Next
' ZKFPEngX1.DongleMemWrite p1, p2, p
End Sub

Private Sub cmdSaveImage_Click()
Dim sFileName As String

sFileName = ImgPath + TextFingerName.Text
If OptionBmp.Value Then
ZKFPEngX1.SaveBitmap sFileName & ".bmp"
'ZKFPEngX1.SaveBitmap "c:\cwx.bmp"
Else
ZKFPEngX1.SaveJPG sFileName + ".jpg"
End If
MessageBox 0, "File Saved(" + sFileName + ")!", "", 0
End Sub

Private Sub cmdVerify_Click()
Dim sqlstr As String
Dim recxx As ADODB.Recordset

If txtuserID.Text = "" Then Exit Sub
Set recxx = New ADODB.Recordset
sqlstr = "select * from template where ID=" & CLng(txtuserID.Text) & ""
FRegTemplate = ""

If ZKFPEngX1.IsRegister Then
ZKFPEngX1.CancelEnroll
End If
StatusBar.Caption = "Start Verification(1:1)"
FMatchType = 1
recxx.Open sqlstr, conn, adOpenKeyset, adLockOptimistic
' If recxx.RecordCount = 0 Then Exit Sub
FRegTemplate = recxx.Fields("FingerTmplate")
End Sub

Private Sub Command1_Click()
ZKFPEngX1.AddImageFile ImgPath + TextFingerName.Text + ".bmp", 500
End Sub

Private Sub Form_Load()
FingerCount = 0
FpcHandle = ZKFPEngX1.CreateFPCacheDB
cmdSave.Enabled = False
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.

Path & "\mydb.mdb;Persist Security Info=False"
'of course ,you can connect with other DB,pls consult.
' conn.Open "DRIVER={MySQL ODBC 3.51 Driver};Server=localhost;UID=pei;PWD=;Database=aaa"
ImgPath = "c:\finger_collect_by3.5\"
End Sub

Private Sub Form_Unload(Cancel As Integer)
ZKFPEngX1.FreeFPCacheDB (FpcHandle)
End Sub

Private Sub ZKFPEngX1_OnCapture(ByVal ActionResult As Boolean, ByVal ATemplate As Variant)
Dim fi As Long, i As Long
Dim Score As Long, ProcessNum As Long
Dim RegChanged As Boolean
Dim sTemp As String
Dim tempxx As String

sTemp = ZKFPEngX1.GetTemplateAsString()
tempxx = ZKFPEngX1.GetTemplateAsString()

StatusBar.Caption = "Acqired Template"
If FMatchType = 1 Then '1:1
'If ZKFPEngX1.VerFinger(FRegTemplate, ATemplate, False, RegChanged) Then
If ZKFPEngX1.VerFingerFromStr(FRegTemplate, tempxx, False, False) Then
MessageBox 0, "Verify success", "information", 0
Else
MessageBox 0, "Verify Failed", "information", 0
End If
ElseIf FMatchType = 2 Then '1:N
Score = 12
fi = ZKFPEngX1.IdentificationFromStrInFPCacheDB(FpcHandle, tempxx, Score, ProcessNum)
If fi = -1 Then
MessageBox 0, "Identification failed！", "information", 0
Else
'MessageBox 0, "Identification Success Name= " & FFingerNames(fi) & " Score = " & Score & " Processed Number = " & ProcessNum & "", "information", 0
MsgBox "successful"
End If
End If
End Sub

Private Sub ZKFPEngX1_OnEnroll(ByVal ActionResult As Boolean, ByVal ATemplate As Variant)
Dim i As Long

If Not ActionResult Then
MessageBox 0, "Register failed", "Warning", 0
Else
MessageBox 0, "Regsiter success", "Information", 0

sTemp = ZKFPEngX1.GetTemplateAsString()
cmdSave.Enabled = True
' ZKFPEngX1.AddRegTemplateStrToFPCacheDB fpcHandle, FingerCount, sTemp
' ReDim Preserve FFingerNames(FingerCount + 1)
'FFingerNames(FingerCount) = TextFingerName.Text
FingerCount = FingerCount + 1
End If
End Sub

Private Sub ZKFPEngX1_OnFeatureInfo(ByVal AQuality As Long)
Dim sTemp As String

sTemp = ""
If ZKFPEngX1.IsRegister Then
sTemp = "Register status: still press finger " & ZKFPEngX1.EnrollIndex & " times"
End If
sTemp = sTemp & " Fingerprint quality"
If AQuality <> 0 Then
sTemp = sTemp & " no good " & AQuality
Else
sTemp = sTemp & " good"
End If
StatusBar.Caption = sTemp
End Sub

Private Sub ZKFPEngX1_OnImageReceived(AImageValid As Boolean)
ZKFPEngX1.PrintImageAt hDC, FrameCommands.Width + 6, FrameCommands.Top, ZKFPEngX1.ImageWidth, ZKFPEngX1.ImageHeight
End Sub