Dim answer As String
On Error GoTo delerror
answer = MsgBox("確定要刪除嗎？", vbYesNo, "")
If answer = vbYes Then
   DataGrid1.AllowDelete = True
   rs.Delete
   rs.Update
   DataGrid1.Refresh
   MsgBox "成功刪除！", vbOKOnly + vbExclamation, ""
   DataGrid1.AllowDelete = False
Else
   Exit Sub
End If

delerror:
If Err.number <> 0 Then
   frmmsg.msg.MsgChar = Err.Description
   frmmsg.Show
   
End If
End Sub

Private Sub cmdmodify_Click(Cancel As Boolean)
On Error GoTo cmdmodify1

Dim answer As String
DataGrid1.AllowAddNew = False
DataGrid1.AllowUpdate = True
If rs.EOF = True And rs.BOF = True Then
Else
rs.MoveFirst
End If



cmddel.Enabled = False
cmdmodify.Enabled = False
cmdupdate.Enabled = True
cmdupdate.BackColor = cmdmodify.BackColor



cmdmodify1:
If Err.number <> 0 Then
   frmmsg.msg.MsgChar = Err.Description
End If
End Sub
Private Sub cmdupdate_Click(Cancel As Boolean)
On Error Resume Next
If rs.EOF And rs.BOF Then
Else
rs.MoveFirst
Do While rs.EOF <> True
rs.Update
rs.MoveNext
Loop

End If



   
   TimeDelay 50
   

   cmdmodify.Enabled = True
   cmddel.Enabled = True
   cmdupdate.Enabled = False
   DataGrid1.AllowUpdate = False
   DataGrid1.AllowAddNew = False
    MsgBox "更新成功！", vbOKOnly + vbExclamation, ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next

Set rs = Nothing

Set conn1 = Nothing
End Sub

Public Sub GetDisplayText()

    Dim n As Integer
    Dim intValue As Integer
    Dim intHighHex As Integer
    Dim intLowHex As Integer
    Dim strSingleChr As String * 1
    
    Dim intAddress As Integer
    Dim intAddressArray(8) As Integer
    Dim intHighAddress As Integer
    
    Dim strhex, strAscii  As String
    Dim result(16) As String
    Dim i As Integer
    Dim time1 As String
    i = 0
    
    
     '設(shè)置初值
    strhex = ""
    
    
    
    
    
    
    For n = 1 To 8
 
        intValue = receive(n - 1)
        
       
        
        intHighHex = intValue \ 16
        intLowHex = intValue - intHighHex * 16
        
        If intHighHex < 10 Then
            intHighHex = intHighHex + 48
        Else
            intHighHex = intHighHex + 55
        End If
        If intLowHex < 10 Then
            intLowHex = intLowHex + 48
        Else
            intLowHex = intLowHex + 55
        End If
        
        strhex = strhex + Chr$(intHighHex) + Chr$(intLowHex)
        If i < 16 Then
       result(i) = Chr$(intHighHex)
       
       i = i + 1
       result(i) = Chr$(intLowHex)
       i = i + 1
       End If
              
    Next n
   
    
    
    
    
    bang_num = result(0) & result(1) & result(2) & result(3)
   
   
     
    
    
 
    
    
    
End Sub

'**********************************
'字符表示的十六進(jìn)制數(shù)轉(zhuǎn)化為相應(yīng)的整數(shù)
'錯誤則返回  -1
'**********************************

Function ConvertHexChr(str As String) As Integer
    
    Dim test As Integer
    
    test = Asc(str)
    If test >= Asc("0") And test <= Asc("9") Then
        test = test - Asc("0")
    ElseIf test >= Asc("a") And test <= Asc("f") Then
        test = test - Asc("a") + 10
    ElseIf test >= Asc("A") And test <= Asc("F") Then
        test = test - Asc("A") + 10
    Else
        test = -1                                       '出錯信息
    End If
    ConvertHexChr = test
    
End Function

'**********************************
'字符串表示的十六進(jìn)制數(shù)據(jù)轉(zhuǎn)化為相應(yīng)的字節(jié)串
'返回轉(zhuǎn)化后的字節(jié)數(shù)
'**********************************

Function strHexToByteArray(strText As String, bytByte() As Byte) As Integer
    
    Dim HexData As Integer          '十六進(jìn)制(二進(jìn)制)數(shù)據(jù)字節(jié)對應(yīng)值
    Dim hstr As String * 1          '高位字符
    Dim lstr As String * 1          '低位字符
    Dim HighHexData As Integer      '高位數(shù)值
    Dim LowHexData As Integer       '低位數(shù)值
    Dim HexDataLen As Integer       '字節(jié)數(shù)
    Dim StringLen As Integer        '字符串長度
    Dim Account As Integer          '計數(shù)
     Dim n As Integer
    'strTestn = ""                   '設(shè)初值
    HexDataLen = 0
    strHexToByteArray = 0
    
    StringLen = Len(strText)
    Account = StringLen \ 2
    ReDim bytByte(Account)
    
    For n = 1 To StringLen
    
        Do                                              '清除空格
            hstr = Mid(strText, n, 1)
            n = n + 1
            If (n - 1) > StringLen Then
                HexDataLen = HexDataLen - 1
                
                Exit For
            End If
        Loop While hstr = " "
        
        Do
            lstr = Mid(strText, n, 1)
            n = n + 1
            If (n - 1) > StringLen Then
                HexDataLen = HexDataLen - 1
                
                Exit For
            End If
        Loop While lstr = " "
        n = n - 1
        If n > StringLen Then
            HexDataLen = HexDataLen - 1
            Exit For
        End If
        
        HighHexData = ConvertHexChr(hstr)
        LowHexData = ConvertHexChr(lstr)
        
        If HighHexData = -1 Or LowHexData = -1 Then     '遇到非法字符中斷轉(zhuǎn)化
            HexDataLen = HexDataLen - 1
            
            Exit For
        Else
            
            HexData = HighHexData * 16 + LowHexData
            bytByte(HexDataLen) = HexData
            HexDataLen = HexDataLen + 1
            
            
        End If
                        
    Next n
    
    If HexDataLen > 0 Then                              '修正最后一次循環(huán)改變的數(shù)值
        HexDataLen = HexDataLen - 1
        ReDim Preserve bytByte(HexDataLen)
    Else
        ReDim Preserve bytByte(0)
    End If
    
    
    If StringLen = 0 Then                               '如果是空串,則不會進(jìn)入循環(huán)體
        strHexToByteArray = 0
    Else
        strHexToByteArray = HexDataLen + 1
    End If
    
    
End Function
Public Sub liqin(strtxt As String)
Dim length As Integer
Dim strsendtext As String
Dim bytsendbyte() As Byte


strsendtext = strtxt

 length = strHexToByteArray(strsendtext, bytsendbyte())
        
        If length > 0 Then
           MSComm1.Output = bytsendbyte
        End If
End Sub

Public Sub Display()
    Dim n As Integer
    Dim intValue As Integer
    Dim intHighHex As Integer
    Dim intLowHex As Integer
    Dim strSingleChr As String * 1
    
    Dim intAddress As Integer
    Dim intAddressArray(8) As Integer
    Dim intHighAddress As Integer
    
    Dim strhex, strAscii  As String
    Dim result(16) As String
    Dim i As Integer
    Dim time1 As String
    Dim number_str As String
    i = 0
    
    
     '設(shè)置初值
    strhex = ""
    
    
    '*****************************************
    '獲得16進(jìn)制碼
    '*****************************************
    
    
    
    For n = 1 To 8
 
        intValue = receive(n - 1)
        
      
        
        intHighHex = intValue \ 16
        intLowHex = intValue - intHighHex * 16
        
        If intHighHex < 10 Then
            intHighHex = intHighHex + 48
        Else
            intHighHex = intHighHex + 55
        End If
        If intLowHex < 10 Then
            intLowHex = intLowHex + 48
        Else
            intLowHex = intLowHex + 55
        End If
        
        strhex = strhex + " " + Chr$(intHighHex) + Chr$(intLowHex) + " "
        If i < 16 Then
       result(i) = Chr$(intHighHex)
       
       
       i = i + 1
       result(i) = Chr$(intLowHex)
       i = i + 1
       End If
              
    Next n
    If result(0) = "F" And result(1) = "F" Then
    OutDate
    flag_end = True
    
    Exit Sub
    
    End If
    
    
    time1 = result(6) & result(7) & "月" & result(4) & result(5) & "日" & result(2) & result(3) & "時" & result(0) & result(1) & "分"
    number_str = result(14) & result(15) & result(12) & result(13) & result(10) & result(11) & result(8) & result(9)
   ' MsgBox time1
   ' MsgBox number_str
    
    Time_Date(Xia_Biao) = time1
    Niu(Xia_Biao) = number_str
    Xia_Biao = Xia_Biao + 1
    
    
   
  
   
    
End Sub

Public Sub OutDate()
Dim YM As String
Dim hm As String
Dim strtxt As String
Dim str1 As String
Dim i As Integer
Dim rs1 As New ADODB.Recordset
Dim txtsql As String

YM = Date
hm = Time



If Mid(hm, 3, 1) = ":" Then
strtxt = Mid(hm, 4, 2)
strtxt = strtxt + Mid(hm, 1, 2)
Else
strtxt = Mid(hm, 3, 2)
strtxt = strtxt + "0" + Mid(hm, 1, 1)
End If

 Dim newdate As Date
    Dim strtime As String
    Dim daytime, montime As String
    
    newdate = Now
     
     daytime = Day(newdate)
     montime = Month(newdate)
  
     
     If Len(daytime) = 1 Then
     strtxt = strtxt & "0" & daytime
    
     
      Else
     strtxt = strtxt & daytime
     End If
     If Len(montime) = 1 Then
    
     strtxt = strtxt & "0" & montime
     Else
     strtxt = strtxt & montime
     End If
liqin (strtxt)


End Sub

Public Sub Niu_Hao()



Dim i As Integer
Dim byTinput1() As Byte

 
MSComm1.InBufferCount = 0
MSComm1.Output = "0"
TimeDelay 30

MSComm1.InputMode = comInputModeBinary


 MSComm1.InputLen = 9
 inTinputlen = 9
 ReDim byTinput1(9) As Byte
  byTinput1 = MSComm1.Input
 For i = 2 To 9
 receive(i - 2) = byTinput1(i - 1)
 Next
 DoEvents
  
End Sub









Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
On Error Resume Next

Dim conn4 As New ADODB.Connection
Dim rs4 As New ADODB.Recordset
Dim txtsql As String

   
connectionstring = "provider=Microsoft.Jet.oledb.4.0;" & _
                   "data source=" & App.path & "\jk.mdb"
conn4.Open connectionstring



  
    
     If Chr(KeyAscii) = Chr(13) Or Len(Text1.Text) = 4 Then
      tmpnh = Trim(Text1.Text)
        '======================================================
     
   '======================================================
   tmpnh = UCase(tmpnh)
   txtsql = "select * from 棒號設(shè)置表 where 棒號='" & tmpnh & "'"
   Set rs4 = conn4.Execute(txtsql)
   If rs4.EOF <> True And rs4.BOF <> True Then
   MsgBox "與以前的有重復(fù)"
   Exit Sub
   End If
   DataGrid1.Columns(0).Text = UCase(tmpnh)
                     
End If
DataGrid1.AllowAddNew = False
Set conn4 = Nothing
End Sub