主题：【有偿项目，自行带价，要的是速度】vb 转狐表Delphi Vfp也有

Public Declare Function tem_writemsdata Lib "rfwrcom32.dll" (ByVal buffer1$, ByVal buffer2$, ByVal xh As Long, ByVal sjdw As Long, ByVal sjlenght As Long, ByVal gs As Long) As Long

Public Declare Function tem_writemsdata1 Lib "rfwrcom32.dll" (ByVal buffer1$, ByVal buffer2$, ByVal xh As Long, ByVal sjdw As Long, ByVal sjlenght As Long, ByVal gs As Long) As Long

Public Declare Function tem_readmsdata Lib "rfwrcom32.dll" (ByVal buffer1$, ByVal buffer2$) As Long
Public Declare Function tem_readmsdata1 Lib "rfwrcom32.dll" (ByVal buffer1$, ByVal buffer2$) As Long

Private Sub Command1_Click()
'On Error Resume Next
Dim nerr As Long
Dim bh1bit As String
Dim bh2bit As String
Dim bh3bit As String
Dim bh4bit As String

Dim strBh As String

nCom = Val(Text1.Text)
If nCom < 0 Or nCom > 7 Then
   Text1.Text = 0
   nCom = 0
End If

Call mif_closecom

'打开串口
nerr = mif_selecom(nCom, 9600)

Dim buf1 As String * 192
Dim buf2 As String * 192

If nerr <> 0 Then
    '关闭串口
   Call mif_closecom
   MsgBox "初始化串口错误！", vbOKOnly + vbInformation
   Exit Sub
End If

'开始读数据
nerr = tem_readmsdata1(buf1, buf2)
If nerr <> 0 Then
    '关闭串口
   Call mif_closecom
   MsgBox "读卡错误！(" & Str(nerr) & ")", vbOKOnly + vbInformation
   Exit Sub
End If

strBh = Mid(buf1, 1, 8)
Text2.Text = strBh
Text11.Text = strBh
Text9.Text = strBh
Text3.Text = buf2

pubBh = Text2.Text

'关闭串口
Call mif_closecom
MsgBox "读卡成功！", vbOKOnly + vbInformation

End Sub

Private Sub Command2_Click()
On Error Resume Next
Dim nerr As Long

nCom = Val(Text1.Text)
If nCom < 0 Or nCom > 7 Then
    Text1.Text = 0
   nCom = 0
End If

Call mif_closecom

'打开串口
nerr = mif_selecom(nCom, 9600)

Dim buf1 As String * 4
Dim buf2 As String * 8
If nerr <> 0 Then
    '关闭串口
   Call mif_closecom
   MsgBox "初始化串口错误！", vbOKOnly + vbInformation
   Exit Sub
End If

Dim bh1bit As String
Dim bh2bit As String
Dim bh3bit As String
Dim bh4bit As String

Dim strBh As String
strBh = Trim(Text9.Text)

If Len(strBh) <> 8 Then
    Call mif_closecom
   MsgBox "门锁编号的长度不足8位！", vbOKOnly + vbInformation
   Exit Sub
End If

bh1bit = ChrB(Val("&H" & Mid(strBh, 1, 2)))
bh2bit = ChrB(Val("&H" & Mid(strBh, 3, 2)))
bh3bit = ChrB(Val("&H" & Mid(strBh, 5, 2)))
bh4bit = ChrB(Val("&H" & Mid(strBh, 7, 2)))

strBh = Text9.Text

buf1 = Text9.Text
buf2 = Text8.Text

'开始写数据
nerr = tem_writemsdata1(strBh$, buf2$, Val(Text4.Text), Val(Text5.Text), Val(Text6.Text), Check1.Value)
If nerr <> 0 Then
    '关闭串口
   Call mif_closecom
   MsgBox "写卡错误！(" & Str(nerr) & ")", vbOKOnly + vbInformation
   Exit Sub
End If

'关闭串口
Call mif_closecom
MsgBox "写卡成功！", vbOKOnly + vbInformation
End Sub

Private Sub Command3_Click()
    End
End Sub

Private Sub Command4_Click()
    If Text2.Text = "" Or Text10.Text = "" Then
        MsgBox "无门锁编号或房号名称!", vbOKOnly + vbInformation
        Exit Sub
    End If
    Dim curStr As String
    Dim strCount As String
    Dim i As Integer
    Dim curBh As String * 8
   
    curBh = Text11.Text
   
    curStr = curBh & vbTab & Text10.Text
   
    For i = 0 To nCount - 1
        If MsTable(i) = curStr Then
           Exit Sub
        End If
    Next
   
    nCount = nCount + 1
   
    strCount = Str(nCount)
   
    MsTable(nCount - 1) = curStr
   
    Open App.Path & "\BhFh.txt" For Output As #1
    Print #1, strCount
    For i = 0 To nCount - 1
        Print #1, MsTable(i)
    Next
   
    Close #1
   
    Call OpenMsTabeFile
   
'    MsgBox "保存完成！", vbOKOnly + vbInformation

End Sub

Private Sub Command5_Click()
    If MsgBox("确实全部清除吗？", vbYesNo + vbQuestion) = vbNo Then Exit Sub
    CopyFile App.Path & "\bhfh.txt", App.Path & "\bhfh" + Format(Now, "mmddHHMMSS") + ".txt", False
   
    Open App.Path & "\BhFh.txt" For Output As #1
    Print #1, 0
    Close #1
    Call OpenMsTabeFile
End Sub

Private Sub Command6_Click()
    Dim curStr As String
    Dim strCount As String
    Dim i As Integer
   
    If List1.ListIndex = -1 Then Exit Sub
   
    If MsgBox("确实清除当前内容吗？", vbYesNo + vbQuestion) = vbNo Then Exit Sub
   
    List1.RemoveItem List1.ListIndex
   
    For i = 0 To List1.ListCount - 1
       MsTable(i) = List1.List(i)
    Next
   
   
    nCount = List1.ListCount
   
    strCount = Str(nCount)
   
   
    Open App.Path & "\BhFh.txt" For Output As #1
    Print #1, strCount
    For i = 0 To nCount - 1
        Print #1, MsTable(i)
    Next
   
    Close #1
   
    Call OpenMsTabeFile
End Sub

Private Sub Command7_Click()
    Dim id As Integer
    id = Shell("notepad.exe " + App.Path + "\BhFh.txt", vbNormalFocus)
End Sub

Private Sub Form_Load()
    Dim curStr As String
    Dim i As Integer
    Text8.Text = Right(Year(Date), 2) + Format(Month(Date), "00") + Format(Day(Date), "00") + Format(Hour(Time), "00")
    Call OpenMsTabeFile
   
End Sub

Private Sub OpenMsTabeFile()
    Dim i As Integer
    Dim curStr As String
    Dim curTotalStr As String
    Dim strCount As String
   
    List1.Clear
   
    If Dir$(App.Path & "\BhFh.txt") <> "" Then
        Open App.Path & "\BhFh.txt" For Input As #1
        Input #1, strCount
        nCount = strCount
        For i = 0 To nCount - 1
            Input #1, curStr
            MsTable(i) = curStr
            List1.AddItem curStr
        Next
        Close #1
    End If
End Sub

Private Sub Text7_Change()