主界面.frm

IC卡信息采集系统

Text9.Enabled = True
Text10.Enabled = True
Text11.Enabled = True
Blag = 2
Command9.Enabled = True
End Sub

Private Sub Command11_Click()
Data1.Recordset.MoveNext
If Data1.Recordset.EOF = True Then
    Data1.Recordset.MoveLast
End If
End Sub

'上翻一个
Private Sub Command12_Click()

    Data1.Recordset.MovePrevious
If Data1.Recordset.BOF = True Then
    Data1.Recordset.MoveFirst
End If

    
End Sub

'读IC卡数据
Private Sub Command2_Click()
Dim St As Integer
If St_Ic <> 0 Then
  St = MsgBox("请检查读卡器连接是否正确或是否插入IC卡。", vbOKOnly, "错误提示")
  Exit Sub
End If
St = IC_InitType(IcDev, 64) '进行卡型设置
If St < 0 Then '0代表操作正确 ;<0代表操作不正确
    MsgBox ("卡型设置失败！")
    Exit Sub
End If

St = IC_Read_Hex(IcDev, 9, 1, Age)
If St < 0 Then
    MsgBox ("IC卡读取年龄失败！")
    Exit Sub
End If
Age = Val("&h" + Age)
Text3.Text = Age

St = IC_Read_Hex(IcDev, 59, 2, Sex)
If St < 0 Then
    MsgBox ("IC卡读取性别失败！")
    Exit Sub
End If
Sex = HexToGB(Sex)
Text2.Text = Sex

St = IC_Read_Hex(IcDev, 13, 2, CompanyNum)
If St < 0 Then
    MsgBox ("IC卡读取单位编号失败！")
    Exit Sub
End If
CompanyNum = Val("&h" + CompanyNum)
Text4.Text = CompanyNum

St = IC_Read_Hex(IcDev, 16, 3, Year)
If St < 0 Then
    MsgBox ("IC卡读取日期失败！")
    Exit Sub
End If
Year = Val("&h" + Year)
Text6.Text = Year

St = IC_Read_Hex(IcDev, 21, 1, Month)
If St < 0 Then
    MsgBox ("IC卡读取日期失败！")
    Exit Sub
End If
Month = Val("&h" + Month)
Text11.Text = Month

St = IC_Read_Hex(IcDev, 64, 20, WName)
If St < 0 Then
    MsgBox ("IC卡读取姓名失败！")
    Exit Sub
End If
WName = HexToGB(WName)
Text1.Text = WName

St = IC_Read_Hex(IcDev, 85, 2, Work)
If St < 0 Then
    MsgBox ("IC卡读取工种失败！")
    Exit Sub
End If
Work = HexToGB(Work)
Text5.Text = Work

St = IC_Read_Hex(IcDev, 32, 3, TimeM1)
If St < 0 Then
    MsgBox ("IC卡读取开关时间失败！")
    Exit Sub
End If
TimeM1 = Val("&h" + TimeM1)
Text8.Text = TimeM1

St = IC_Read_Hex(IcDev, 40, 3, TimeJ1)
If St < 0 Then
    MsgBox ("IC卡读取电机工作失败！")
    Exit Sub
End If
TimeJ1 = Val("&h" + TimeJ1)
Text10.Text = TimeJ1

St = IC_Read_Hex(IcDev, 24, 3, TimeJX)
If St < 0 Then
    MsgBox ("IC卡读取有效工作失败！")
    Exit Sub
End If
TimeJX = Val("&h" + TimeJX)
Text7.Text = TimeJX

St = IC_Read_Hex(IcDev, 4, 4, ICNum)
If St < 0 Then
    MsgBox ("IC卡读取IC卡号失败！")
    Exit Sub
End If
ICNum = Val("&h" + ICNum)
Text9.Text = ICNum

MsgBox "读取结束"
End Sub

'向IC卡写入数据
Private Sub Command3_Click()
Dim St As Integer
If St_Ic <> 0 Then
  St = MsgBox("请检查读卡器连接是否正确或是否插入IC卡。", vbOKOnly, "错误提示")
  Exit Sub
End If

St = IC_InitType(IcDev, 64) '进行卡型设置
If St < 0 Then '0代表操作正确 ;<0代表操作不正确
    MsgBox ("卡型设置失败！")
    Exit Sub
End If

Age = Hex(Val(Text3.Text)) '写入年龄
If Len(Age) = 1 Then
    Age = "0" & Age
End If
St = IC_Write24_Hex(IcDev, 9, 1, Age)
If St < 0 Then
    MsgBox ("IC卡写入年龄失败！")
    Exit Sub
End If

Sex = Text2.Text
Sex = GBToHex1(Sex)
St = IC_Write24_Hex(IcDev, 59, 2, Sex)
If St < 0 Then
    MsgBox ("IC卡写入性别失败！")
    Exit Sub
End If

CompanyNum = Hex(Val(Text4.Text))
If Len(CompanyNum) = 3 Then
   CompanyNum = "0" & CompanyNum
End If
St = IC_Write24_Hex(IcDev, 13, 2, CompanyNum)
If St < 0 Then
    MsgBox ("IC卡写入单位编号失败！")
    Exit Sub
End If

Year = Hex(Val(Text6.Text))
If Len(Year) = 3 Then
  Year = "000" & Year
End If
St = IC_Write24_Hex(IcDev, 16, 3, Year)
If St < 0 Then
    MsgBox ("IC卡写入日期失败！")
    Exit Sub
End If

Month = Hex(Val(Text11.Text))
If Len(Month) = 1 Then
 Month = "0" & Month
End If
St = IC_Write24_Hex(IcDev, 21, 1, Month)
If St < 0 Then
    MsgBox ("IC卡写入日期失败！")
    Exit Sub
End If
 
WName = Text1.Text
WName = GBToHex(WName)
St = IC_Write24_Hex(IcDev, 64, 20, WName)
If St < 0 Then
    MsgBox ("IC卡写入姓名失败！")
    Exit Sub
End If

Work = Text5.Text
Work = GBToHex2(Work)
St = IC_Write24_Hex(IcDev, 85, 2, Work)
If St < 0 Then
    MsgBox ("IC卡写入工种失败！")
    Exit Sub
End If

TimeM1 = Hex(Val(Text8.Text))
Dim i As Integer
For i = 0 To 5 - Len(TimeM1)
    TimeM1 = "0" & TimeM1
Next i
St = IC_Write24_Hex(IcDev, 32, 3, TimeM1)
If St < 0 Then
    MsgBox ("IC卡写入开关时间失败！")
    Exit Sub
End If

TimeJ1 = Hex(Val(Text10.Text))
For i = 0 To 5 - Len(TimeJ1)
    TimeJ1 = "0" & TimeJ1
Next i
St = IC_Write24_Hex(IcDev, 40, 3, TimeJ1)
If St < 0 Then
    MsgBox ("IC卡写入电机工作失败！")
    Exit Sub
End If

TimeJX = Hex(Val(Text7.Text))
For i = 0 To 5 - Len(TimeJX)
    TimeJX = "0" & TimeJX
Next i
St = IC_Write24_Hex(IcDev, 24, 3, TimeJX)
If St < 0 Then
    MsgBox ("IC卡写入有效工作失败！")
    Exit Sub
End If

ICNum = Hex(Val(Text9.Text))
For i = 0 To 7 - Len(ICNum)
    ICNum = "0" & ICNum
Next i
St = IC_Write24_Hex(IcDev, 4, 4, ICNum)
If St < 0 Then
    MsgBox ("IC卡写入IC卡号失败！")
    Exit Sub
End If

MsgBox "写入结束"
End Sub

'退出系统 并关闭COM 口
Private Sub Command5_Click()
    Call IC_ExitComm(IcDev) 'Close COM
    End
End Sub

Private Sub Command6_Click()
Dim msg As Integer
msg = MsgBox("是否确定删除", 36, "删除记录")
If msg = 6 Then
    With Data1
        .Recordset.Delete
        .Recordset.MoveLast
        .Refresh
    End With
End If
'Data1.Recordset.MoveLast
End Sub

Private Sub Command7_Click()
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Text5.Enabled = True
Text6.Enabled = True
Text7.Enabled = True
Text8.Enabled = True
Text9.Enabled = True
Text10.Enabled = True
Text11.Enabled = True
Blag = 1
Command9.Enabled = True

'Data1.Recordset.AddNew
End Sub

'系统设置
Private Sub Command8_Click()
SheZhi.Show
Unload CaiJi
End Sub

Private Sub Command9_Click()
  If Blag = 1 Then
     Data1.Recordset.AddNew
     Data1.Recordset("卡号") = Text9.Text
     Data1.Recordset("姓名") = Text1.Text
     Data1.Recordset("性别") = Text2.Text
     Data1.Recordset("年龄") = Text3.Text
     Data1.Recordset("单位编号") = Text4.Text
     Data1.Recordset("工种") = Text5.Text
     Data1.Recordset("年") = Text6.Text
     Data1.Recordset("月") = Text11.Text
     Data1.Recordset("开关时间") = Text8.Text
     Data1.Recordset("有效工作时间") = Text7.Text
     Data1.Recordset("电机工作时间") = Text10.Text
     Data1.Recordset.Update
     Data1.Recordset.MoveLast
     Command9.Enabled = False
     Text1.Enabled = False
    Text2.Enabled = False
    Text3.Enabled = False
    Text4.Enabled = False
    Text5.Enabled = False
    Text6.Enabled = False
    Text7.Enabled = False
    Text8.Enabled = False
    Text9.Enabled = False
    Text10.Enabled = False
    Text11.Enabled = False
     MsgBox ("记录保持成功！")
 ElseIf Blag = 2 Then  '修改记录
 Data1.Recordset.Edit
    Data1.Recordset.Update
    Command9.Enabled = False
    Text1.Enabled = False
    Text2.Enabled = False
    Text3.Enabled = False
    Text4.Enabled = False
    Text5.Enabled = False
    Text6.Enabled = False
    Text7.Enabled = False
    Text8.Enabled = False
    Text9.Enabled = False
    Text10.Enabled = False
    Text11.Enabled = False
   End If
End Sub

'窗口的初始化
Private Sub Form_Load()
Blag = 5
CaiJi.Hide
SheZhi.Show
SheZhi.Hide
CaiJi.Show
Dim Spath As String
Spath = App.Path
Data1.DatabaseName = Spath & "\database\IcData.mdb"
End Sub

'对读卡器检测
Sub IC_Jiance()

   IcDev = IC_InitComm(IcDev_Com) '调用通讯口初始化函数 其中0代表COM1口
    If IcDev <= 0 Then      ' >0 时初始化成功，返回串口标识符
      MsgBox ("串口初始化失败")
      Exit Sub
    End If
    St_Ic = IC_Status(IcDev) '获取设备当前状态（有卡或无卡），并且同时对卡片上电
    If St_Ic < 0 Then '<0 读写器连接错误，见错误码;'=0 连接正确，并且已经插卡;=1 连接正确，但读写器内没有插卡
      MsgBox ("读卡器连接错误！")
      Exit Sub
    End If
    If St_Ic = 0 Then

      MsgBox ("连接正确，并且已经插卡,可以进行一下操作啦。")
      Exit Sub
    End If
    If St_Ic = 1 Then
      MsgBox ("读卡器连接正确，但没有IC卡插入！")
    End If

End Sub
Sub IC_IC()
        Dim St As Integer
        St = IC_InitType(IcDev, 64) '进行卡型设置
        If St < 0 Then '0代表操作正确 ;<0代表操作不正确
            MsgBox ("卡型设置失败！")
            Exit Sub
        End If
        Dim ss As String
        Dim ss1 As String
        ss1 = "01FE55AA"
        St = IC_Read_Hex(IcDev, 0, 4, ss)
        If St < 0 Then
            MsgBox ("IC卡读取失败！")
            Exit Sub
        End If
        If Mid(ss, 1, 8) <> Mid(ss1, 1, 8) Then
            MsgBox ("无效卡。")
            Exit Sub
        End If

End Sub

'汉字转换成十六进制

Function GBToHex(sGB As String) As String
          Dim sResult     As String
          Dim j As Integer
          Dim iLoop     As Integer
          sResult = ""
          If Len(sGB) < 10 Then
            For j = 0 To 9 - Len(sGB)
                sGB = "#" & sGB
            Next j
          End If
          For iLoop = 1 To Len(sGB)
                  sResult = sResult + Right("0000" + Hex(Asc(Mid(sGB, iLoop, 1))), 4)
          Next iLoop
          GBToHex = sResult
  End Function
    
'十六进制转换成汉字
  Function HexToGB(sHex As String) As String
          Dim sResult     As String
          Dim iLoop     As Integer
          sResult = ""
          For iLoop = 1 To Len(sHex) \ 4
                  sResult = sResult + Chr(Val("&H" + Mid(sHex, iLoop * 4 - 3, 4)))
          Next iLoop
          Dim bResult() As String
          bResult = Split(sResult, "#")
          HexToGB = bResult(UBound(bResult))
  End Function
'汉字转换成十六进制

Function GBToHex1(sGB As String) As String
          Dim sResult     As String
          Dim j As Integer
          Dim iLoop     As Integer
          sResult = ""
          If Len(sGB) < 1 Then
                   sGB = "#" & sGB
          End If
          For iLoop = 1 To Len(sGB)
                  sResult = sResult + Right("0000" + Hex(Asc(Mid(sGB, iLoop, 1))), 4)
          Next iLoop
          GBToHex1 = sResult
  End Function
   

'汉字转换成十六进制

Function GBToHex2(sGB As String) As String
          Dim sResult     As String
          Dim j As Integer
          Dim iLoop     As Integer
          sResult = ""
          If Len(sGB) < 2 Then
            For j = 0 To 1 - Len(sGB)
                sGB = "#" & sGB
            Next j
          End If
          For iLoop = 1 To Len(sGB)
                  sResult = sResult + Right("0000" + Hex(Asc(Mid(sGB, iLoop, 1))), 4)
          Next iLoop
          GBToHex2 = sResult
  End Function
   
    Private Sub Data1_Validate(Action As Integer, Save As Integer)
      '′确定是否修改，如不修改恢复原先内容
     ' Dim mag
     ' If Save = True Then
     '   mag = MsgBox("是否保存数据？", vbYesNo, "保存报告")
     '   If mag = vbNo Then
     '     Save = False
     '     Data1.UpdateControls
     '   End If
     ' End If
    End Sub