开启辅助访问 切换到宽版

精易论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

用微信号发送消息登录论坛

新人指南 邀请好友注册 - 我关注人的新帖 教你赚取精币 - 每日签到


求职/招聘- 论坛接单- 开发者大厅

论坛版规 总版规 - 建议/投诉 - 应聘版主 - 精华帖总集 积分说明 - 禁言标准 - 有奖举报

查看: 1331|回复: 3
收起左侧

[已解决] 谁能帮忙 vb 转易语言啊。。

 关闭 [复制链接]
结帖率:100% (29/29)
发表于 2019-3-7 09:54:37 | 显示全部楼层 |阅读模式   福建省福州市
5精币
------------------------------------------------------------------------------------------------------------
第一段

Option Explicit
'*************************************************************************
'*  链接卡片操作函数库
'*************************************************************************
Public Declare Function mif_selecom Lib "LCRFRW_SDK.dll" (ByVal com As Long, ByVal baud As Long) As Long
Public Declare Function mif_selecard Lib "LCRFRW_SDK.dll" (ByVal ncardtype As Long) As Long
Public Declare Function mif_closecom Lib "LCRFRW_SDK.dll" () As Long
Public Declare Function tem_writedoorcard_sdk Lib "LCRFRW_SDK.dll" (ByVal buffer1$, ByVal buffer2$, ByVal xh As Long, ByVal sjdw As Long, ByVal sjlenght As Long, ByVal gs As Long, ByVal p_nLockAP As Long) As Long
Public Declare Function tem_readdoorcard_sdk Lib "LCRFRW_SDK.dll" (ByVal buffer1$, ByVal buffer2$, ByVal p_nLockAP As Long) As Long
Public Declare Function tem_readtimercard_sdk Lib "LCRFRW_SDK.dll" (ByVal fksj$, ByVal time$, ByVal p_nLockAP As Long) As Long
Public Declare Function tem_writetimercard_sdk Lib "LCRFRW_SDK.dll" (ByVal fksj$, ByVal nxh As Long, ByVal time$, ByVal p_nLockAP As Long) As Long
Public Declare Function tem_readidcard_sdk Lib "LCRFRW_SDK.dll" (ByVal idbuff$) As Long
Public Declare Function tem_readdatetime_sdk Lib "LCRFRW_SDK.dll" (ByVal p_csStartTime$, ByVal p_nUnit$, ByVal p_nTimes$, ByVal p_nLockAP As Long) As Long

------------------------------------------------------------------------------------------------------------
第二段

Option Explicit
Dim nCom As Long
Dim MsTable(2 * 1024) As String
Dim nCount As Long
Dim pubBh As String
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) 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 > 255 Then
   Text1.Text = 0
   nCom = 0
End If

Call mif_closecom
'打开串口
nerr = mif_selecom(nCom, 9600)
Dim buf1 As String * 20
Dim buf2 As String * 20
Dim l_nLockAP As Long
Dim l_csSDT As String * 8
Dim l_csUnit As String * 8
Dim l_csTimes As String * 8

If nerr <> 0 Then
    '关闭串口
   Call mif_closecom
   MsgBox "初始化串口错误!", vbOKOnly + vbInformation
   Exit Sub
End If
l_nLockAP = Int(Val(txtLockAP.Text))
If l_nLockAP > 255 Then
    l_nLockAP = 0
End If
'开始读数据
nerr = tem_readdoorcard_sdk(buf1, buf2, l_nLockAP)
If nerr <> 0 Then
   '关闭串口
   Call mif_closecom
   MsgBox "读卡错误!(" & Str(nerr) & ")", vbOKOnly + vbInformation
   Exit Sub
End If
'开始读卡起始结束时间
nerr = tem_readdatetime_sdk(l_csSDT, l_csUnit, l_csTimes, l_nLockAP)
If nerr <> 0 Then
   '关闭串口
   Call mif_closecom
   MsgBox "读卡错误!(" & Str(nerr) & ")", vbOKOnly + vbInformation
   Exit Sub
End If

strBh = Mid(buf1, 1, 10)
Text2.Text = strBh
Text11.Text = strBh
Text9.Text = strBh
Text3.Text = buf2
Dim l_csCOTime As String
Dim l_csSDT_All As String
Dim l_csEDT_All As String
l_csCOTime = "12"
l_csSDT_All = "20" & Mid(l_csSDT, 1, 2) & "-" & Mid(l_csSDT, 3, 2) & "-" & Mid(l_csSDT, 5, 2) & " " & Mid(l_csSDT, 7, 2)
l_csEDT_All = "20" & Mid(l_csSDT, 1, 2) & "-" & Mid(l_csSDT, 3, 2) & "-" & Mid(l_csSDT, 5, 2) & " " & l_csCOTime
l_csSDT_All = l_csSDT_All + ":00:00"
l_csEDT_All = l_csEDT_All + ":00:00"
If IsDate(l_csSDT_All) And IsDate(l_csEDT_All) Then
    Select Case Val(l_csUnit)
        
        Case 0      '以时为单位
            l_csEDT_All = CDate(l_csSDT_All) + Val(l_csTimes) / 24
        Case 1      '以日为单位
            l_csEDT_All = CDate(l_csEDT_All) + Val(l_csTimes)
        Case 2      '以月为单位
            l_csEDT_All = CDate(l_csEDT_All) + Val(l_csTimes) * 30
        Case 3      '以年为单位
            l_csEDT_All = CDate(l_csEDT_All) + Val(l_csTimes) * 365
        Case Else   '无效的时间单位
            l_csEDT_All = "无效"
        
    End Select
End If
txtSDT.Text = l_csSDT_All
txtEDT.Text = l_csEDT_All
pubBh = Text2.Text
'关闭串口
Call mif_closecom
MsgBox "读卡成功!", vbOKOnly + vbInformation
End Sub
Private Sub Command10_Click()
   
    On Error Resume Next
    Dim nerr As Long
   
    nCom = Val(Text1.Text)
    If nCom < 0 Or nCom > 255 Then
        Text1.Text = 0
       nCom = 0
    End If
   
    Call mif_closecom
   
    '打开串口
    nerr = mif_selecom(nCom, 9600)
   
    Dim buf1 As String * 10
   
    '开始读ID卡卡号
    nerr = tem_readidcard_sdk(buf1$)
    If nerr <> 0 Then
        '关闭串口
        txtIDCardNo.Text = ""
       Call mif_closecom
       MsgBox "读卡错误!(" & Str(nerr) & ")", vbOKOnly + vbInformation
       Exit Sub
    End If
   
    txtIDCardNo.Text = buf1
   
    '关闭串口
    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 > 255 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 * 10
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 l_nLockAP As Long
Dim strBh As String
strBh = Trim(Text9.Text)
If Len(strBh) <> 10 Then
    Call mif_closecom
   MsgBox "门锁编号的长度不足10位!", 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
l_nLockAP = Val(txtLockAP.Text)
If l_nLockAP > 255 Then
    l_nLockAP = 0
End If
'开始写数据
nerr = tem_writedoorcard_sdk(strBh$, buf2$, Val(Text4.Text), Val(Text5.Text), Val(Text6.Text), Check1.Value, l_nLockAP)
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 Long
    Dim curBh As String * 10
   
    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 Long
   
    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 Long
    id = Shell("notepad.exe " + App.Path + "\BhFh.txt", vbNormalFocus)
End Sub
Private Sub Command8_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 strFksj As String
   
    Dim strTime As String
   
    Dim buf1 As String * 10
    Dim buf2 As String * 10
   
    Dim l_nLockAP As Long
   
    nCom = Val(Text1.Text)
    If nCom < 0 Or nCom > 255 Then
       Text1.Text = 0
       nCom = 0
    End If
   
    Call mif_closecom
   
    '打开串口
    nerr = mif_selecom(nCom, 9600)
    If nerr <> 0 Then
        '关闭串口
       Call mif_closecom
       MsgBox "初始化串口错误!", vbOKOnly + vbInformation
       Exit Sub
    End If
   
    l_nLockAP = Int(Val(txtLockAP.Text))
    If l_nLockAP > 255 Then
        l_nLockAP = 0
    End If
    '开始读数据
    nerr = tem_readtimercard_sdk(buf1, buf2, l_nLockAP)
    If nerr <> 0 Then
        '关闭串口
       Call mif_closecom
       MsgBox "读卡错误!(" & Str(nerr) & ")", vbOKOnly + vbInformation
       Exit Sub
    End If
   
    strFksj = Mid(buf1, 1, 10)
    strTime = Mid(buf2, 1, 10)
   
    txtCardID.Text = strFksj
    txtTime.Text = strTime
   
    txtXh.Text = Val("&H" + Right(strFksj, 2))
   
    '关闭串口
    Call mif_closecom
    MsgBox "读卡成功!", vbOKOnly + vbInformation
End Sub
Private Sub Command9_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 nxh As Long
   
    Dim strFksj As String
   
    Dim strTime As String
   
    Dim l_nLockAP As Long
   
   
    nCom = Val(Text1.Text)
    If nCom < 0 Or nCom > 255 Then
       Text1.Text = 0
       nCom = 0
    End If
   
   
    Call mif_closecom
   
    '打开串口
    nerr = mif_selecom(nCom, 9600)
    If nerr <> 0 Then
        '关闭串口
       Call mif_closecom
       MsgBox "初始化串口错误!", vbOKOnly + vbInformation
       Exit Sub
    End If
   
    Dim buf1 As String
    Dim buf2 As String
   
    buf1 = Right(String(8, "0") + Left(Trim(txtCardID.Text), 8), 8)
    buf2 = Right(String(10, "0") + Trim(txtTime.Text), 10)
    nxh = Val(txtXh.Text)
  
    l_nLockAP = Int(Val(txtLockAP.Text))
    If l_nLockAP > 255 Then
        l_nLockAP = 0
    End If
   
    '开始读数据
    nerr = tem_writetimercard_sdk(buf1, nxh, buf2, l_nLockAP)
    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 Form_Load()
    Dim curStr As String
    Dim i As Long
    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 Long
    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


附件  也有。。。。

VBDemo.zip

69.49 KB, 下载次数: 0

最佳答案

查看完整内容

这么长,定制区可能有大神出手,这里很难的

求助知识:请将问题描述清楚,最好把你有问题的源码打包上传上来,这样更方便大家帮助你。
友情提醒:本版被采纳的主题可在 申请荣誉值 帖子申请荣誉值,获得 3点 荣誉值,荣誉值可兑换荣誉会员、终身vip用户组。

结帖率:99% (71/72)
发表于 2019-3-7 09:54:38 | 显示全部楼层   广东省深圳市
这么长,定制区可能有大神出手,这里很难的
回复

使用道具 举报

结帖率:92% (24/26)

签到天数: 3 天

发表于 2019-3-7 10:14:57 | 显示全部楼层   浙江省杭州市
这么长 5精币
回复

使用道具 举报

结帖率:100% (29/29)

签到天数: 7 天

 楼主| 发表于 2019-3-7 10:36:14 | 显示全部楼层   福建省福州市
袄 好吧。。那要多少 金币 哈
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则 致发广告者

发布主题 收藏帖子 返回列表

sitemap| 易语言源码| 易语言教程| 易语言论坛| 易语言模块| 手机版| 广告投放| 精易论坛
拒绝任何人以任何形式在本论坛发表与中华人民共和国法律相抵触的言论,本站内容均为会员发表,并不代表精易立场!
论坛帖子内容仅用于技术交流学习和研究的目的,严禁用于非法目的,否则造成一切后果自负!如帖子内容侵害到你的权益,请联系我们!
防范网络诈骗,远离网络犯罪 违法和不良信息举报电话0663-3422125,QQ: 793400750,邮箱:wp@125.la
Powered by Discuz! X3.4 揭阳市揭东区精易科技有限公司 ( 粤ICP备12094385号-1) 粤公网安备 44522102000125 增值电信业务经营许可证 粤B2-20192173

快速回复 返回顶部 返回列表