酒店门锁V10SDK接口VB-幽冥大陆(一百26)—东方仙盟

系统环境

IDE:VB6

语言：vb

执行IDE:仙盟创梦IDE

完整代码

VERSION 5.00 Begin VB.Form Form1 Caption = "演示程序 DEMO" ClientHeight = 9345 ClientLeft = 60 ClientTop = 345 ClientWidth = 14055 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 9345 ScaleWidth = 14055 StartUpPosition = 1 '所有者中心 Begin VB.Frame Frame5 BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 1815 Left = 9480 TabIndex = 34 Top = 7200 Width = 4095 Begin VB.Label Label10 Caption = "请先用 门锁软件 发卡，确保发卡器与卡片是OK的，不要关闭门锁软件，然后打开本例程DEMO测试接口，谢谢！" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 735 Left = 240 TabIndex = 36 Top = 840 Width = 3615 End Begin VB.Label Label14 Caption = "温馨提示" BeginProperty Font Name = "宋体" Size = 15.75 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 375 Left = 1200 TabIndex = 35 Top = 240 Width = 1935 End End Begin VB.Frame Frame4 Caption = "最常用函数" Enabled = 0 'False Height = 4695 Left = 9480 TabIndex = 20 Top = 2280 Width = 4095 Begin VB.CommandButton Command7 Caption = "读取客人离店时间[GetGuestETimeByCardDataStr]" Height = 615 Left = 240 TabIndex = 28 Top = 3960 Width = 3615 End Begin VB.CommandButton Command6 Caption = "读取客人卡锁号[GetGuestLockNoByCardDataStr]" Height = 615 Left = 240 TabIndex = 27 Top = 3360 Width = 3615 End Begin VB.CommandButton Command5 Caption = "读取卡片类型[GetCardTypeByCardDataStr]" Height = 615 Left = 240 TabIndex = 26 Top = 2760 Width = 3615 End Begin VB.CommandButton Command4 Caption = "挂失卡片[LimitCard]" Height = 495 Left = 240 TabIndex = 25 Top = 2160 Width = 3615 End Begin VB.CommandButton Command2 Caption = "注销卡片[CardErase]" Height = 495 Left = 240 TabIndex = 24 Top = 1680 Width = 3615 End Begin VB.CommandButton cmdbuzzer Caption = "蜂鸣[Buzzer]" Height = 495 Left = 240 TabIndex = 23 Top = 240 Width = 3615 End Begin VB.CommandButton cmdwritecard Caption = "制宾客卡[GuestCard]" Height = 495 Left = 240 TabIndex = 22 Top = 1200 Width = 3615 End Begin VB.CommandButton cmdreadcard Caption = "读取卡数据[ReadCard]" Height = 495 Left = 240 TabIndex = 21 Top = 720 Width = 3615 End End Begin VB.TextBox txtStrHex BackColor = &H8000000B& Enabled = 0 'False BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 480 TabIndex = 18 Text = "txtStrHex" Top = 6600 Width = 8775 End Begin VB.CommandButton cmdExit Caption = "退出" Height = 495 Left = 9720 TabIndex = 16 Top = 1560 Width = 3735 End Begin VB.CommandButton cmdGetDllVer Caption = "读DLL版本号[GetDllVersion]" Height = 495 Left = 9720 TabIndex = 15 Top = 960 Width = 3735 End Begin VB.Frame Frame3 Caption = "使用说明" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 1815 Left = 480 TabIndex = 10 Top = 7200 Width = 8775 Begin VB.Label Label12 Caption = "4,读DLL版本为测试动态库，不涉及端口操作。" ForeColor = &H00008000& Height = 255 Left = 360 TabIndex = 14 Top = 1440 Width = 6015 End Begin VB.Label Label9 Caption = "3,客人代号，是实现后卡覆盖前卡功能的，一般默认为0即可；" ForeColor = &H000000FF& Height = 255 Left = 360 TabIndex = 13 Top = 1080 Width = 5535 End Begin VB.Label Label8 Caption = "2,按说明正确填写相应信息是能否发卡成功的关键步骤； " ForeColor = &H00008000& Height = 255 Left = 360 TabIndex = 12 Top = 720 Width = 5535 End Begin VB.Label Label7 Caption = "1,USB端口打开之后, 才能进行发卡读卡等操作;" ForeColor = &H000000FF& Height = 255 Left = 360 TabIndex = 11 Top = 360 Width = 5895 End End Begin VB.CommandButton Command1 Caption = "第一步: 打开端口[initializeUSB]" Height = 735 Left = 960 TabIndex = 1 Top = 1200 Width = 3615 End Begin VB.Frame Frame1 Caption = "端口操作" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 1335 Left = 480 TabIndex = 0 Top = 840 Width = 8775 Begin VB.CommandButton Command3 Caption = "从现有卡片读取酒店标识" Height = 375 Left = 4680 TabIndex = 31 Top = 720 Width = 3735 End Begin VB.TextBox txtCoID BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 270 Left = 6480 TabIndex = 30 Text = "txtCoID" Top = 360 Width = 1575 End Begin VB.Label Label23 Alignment = 1 'Right Justify Caption = "酒店标识[coID]：" Height = 255 Left = 4560 TabIndex = 32 Top = 360 Width = 1695 End End Begin VB.Frame Frame2 Caption = "客人卡信息[注：以下输入框没有做有效性检查，请按提示输入]" Enabled = 0 'False BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 3855 Left = 480 TabIndex = 2 Top = 2280 Width = 8775 Begin VB.TextBox txtDai BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 270 Left = 2520 TabIndex = 8 Text = "txtDai" Top = 2640 Width = 855 End Begin VB.TextBox txtETime BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 2520 TabIndex = 6 Text = "txtETime" Top = 1800 Width = 3375 End Begin VB.TextBox txtLockNo BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 270 Left = 2520 TabIndex = 4 Text = "txtLockNo" Top = 720 Width = 1575 End Begin VB.Label Label2 Caption = $"Form1.frx":0000 Height = 375 Left = 240 TabIndex = 33 Top = 3120 Width = 7575 End Begin VB.Label Label4 Caption = "锁号，必须以门锁软件-房间定义 最后一列为准。新的门锁软件可以导出锁号" ForeColor = &H000000FF& Height = 255 Left = 960 TabIndex = 17 Top = 1200 Width = 7455 End Begin VB.Label Label5 Caption = "（1-255循环）" ForeColor = &H000000FF& Height = 255 Left = 3480 TabIndex = 9 Top = 2640 Width = 1575 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "客人代[Dai]：" Height = 255 Left = 360 TabIndex = 7 Top = 2640 Width = 1935 End Begin VB.Label Label29 Alignment = 1 'Right Justify Caption = "预计退房时间[eTime]：" Height = 255 Left = 360 TabIndex = 5 Top = 1920 Width = 1935 End Begin VB.Label Label27 Alignment = 1 'Right Justify Caption = "锁号[LockNo]：" Height = 255 Left = 480 TabIndex = 3 Top = 720 Width = 1815 End End Begin VB.Label Label6 Alignment = 2 'Center Caption = "门锁接口函数例程DEMO（新系统P50版）" BeginProperty Font Name = "宋体" Size = 21.75 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 0 TabIndex = 29 Top = 120 Width = 14175 End Begin VB.Label Label3 Caption = "卡数据[CardHexStr]：" Height = 255 Left = 480 TabIndex = 19 Top = 6240 Width = 2055 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '读取卡数据 Private Sub cmdreadcard_Click() If rdCard <> True Then Exit Sub '先读卡 txtStrHex.Text = bufCard MsgBox "卡ID号：" & Mid(bufCard, 25, 8), 64 End Sub '制宾客卡 Private Sub cmdwritecard_Click() Dim llock As Byte '反锁标志 Dim pdoors As Byte '公共门标志 Dim dlsCoID As Long '酒店标识 Dim CardNo As Integer '卡号(0-15) Dim dai As Integer '客人代 Dim BTime As String '发卡时间,也就是电脑当前时间 Dim ETime As String '预计退房时间 Dim LockNo As String '锁号 If rdCard <> True Then Exit Sub '先读卡 txtStrHex.Text = bufCard llock = 0 pdoors = 1 '公共门标志 dlsCoID = CLng(txtCoID.Text) '酒店标识 CardNo = 0 dai = CInt(txtDai.Text) Mod 256 '客人代 BTime = Format(Now, "YYMMDDHHMM") '发卡时间 ETime = Format(txtETime.Text, "YYMMDDHHMM") '预计退房时间 LockNo = txtLockNo.Text st = GuestCard(flagUSB, dlsCoID, CardNo, dai, llock, pdoors, BTime, ETime, LockNo, bufHexStr) If flagUSB = 1 Then Buzzer flagUSB, 20 '写卡后鸣叫一声，因为GuestCard函数本身不会有响声 txtStrHex.Text = bufHexStr If st <> 0 Then MsgBox "调用发卡函数失败, 错误代号为: " & CStr(st), 16 Else MsgBox "调用发卡函数成功" & Chr(10) & Chr(10) & "注意: 并不代表数据已经写到卡里, 建议停顿一秒钟后调用ReadCard" & Chr(10) & "如果GuestCard与ReadCard的bufHexStr相同表示写卡成功", 64 End If End Sub '注销卡片 Private Sub Command2_Click() Dim dlsCoID As Long '酒店标识 If rdCard <> True Then Exit Sub '先读卡 txtStrHex.Text = bufCard dlsCoID = CLng(txtCoID.Text) '酒店标识 st = CardErase(flagUSB, dlsCoID, bufHexStr) If flagUSB = 1 Then Buzzer flagUSB, 20 '写卡后鸣叫一声，因为CardErase函数本身不会有响声 txtStrHex.Text = bufHexStr If st <> 0 Then MsgBox "注销失败, 错误代号为: " & CStr(st), 16 Else MsgBox "注销成功", 64 End If End Sub '卡片挂失 Private Sub Command4_Click() Dim dlsCoID As Long '酒店标识 Dim limitNo As String * 4 '挂失卡号 Dim dai As Integer '代 If rdCard <> True Then Exit Sub '先读卡 txtStrHex.Text = bufCard dlsCoID = CLng(txtCoID.Text) '酒店标识 CardNo = CInt(txtCardNo.Text) Mod 16 '卡号(0-15) dai = CInt(txtDai.Text) Mod 256 '客人代 BTime = Format(Now, "YYMMDDHHMM") '发卡时间 limitNo = Chr(&H60) & Chr(&H12) & Chr(&HD2) & Chr(&H91) '挂失卡号: 6012D291 st = LimitCard(flagUSB, dlsCoID, CardNo, dai, BTime, limitNo, bufHexStr) If flagUSB = 1 Then Buzzer flagUSB, 20 '写卡后鸣叫一声，因为LimitCard函数本身不会有响声 txtStrHex.Text = bufHexStr If st <> 0 Then MsgBox "挂失卡片失败, 错误代号为: " & CStr(st), 16 Else MsgBox "调用挂失卡函数成功" & Chr(10) & "本例子挂失卡号为: 6012D291", 64 End If End Sub '读取卡片类型 Private Sub Command5_Click() Dim s As String Dim CardType As String * 16 If rdCard <> True Then Exit Sub '先读卡 txtStrHex.Text = bufCard st = GetCardTypeByCardDataStr(bufCard, CardType) If st <> 0 Then MsgBox "卡数据串无效, 错误代号为: " & CStr(st), 48 Else s = Left(CardType, 1) If s = "0" Then MsgBox "授权卡" ElseIf s = "1" Then MsgBox "记录卡" ElseIf s = "2" Then MsgBox "房号设置卡" ElseIf s = "3" Then MsgBox "时间设置卡" ElseIf s = "4" Then MsgBox "限制卡[挂失卡]" ElseIf s = "5" Then MsgBox "组号设置卡" ElseIf s = "6" Then MsgBox "客人卡" ElseIf s = "7" Then MsgBox "退房卡" ElseIf s = "8" Then MsgBox "组控卡" ElseIf s = "9" Then MsgBox "未知卡[无此类型]" ElseIf s = "A" Then MsgBox "应急卡" ElseIf s = "B" Then MsgBox "总控卡" ElseIf s = "C" Then MsgBox "楼栋卡" ElseIf s = "D" Then MsgBox "楼层卡" ElseIf s = "E" Then MsgBox "未知卡[无此类型]" ElseIf s = "F" Then MsgBox "空白卡" End If End If End Sub '读取客人卡锁号 Private Sub Command6_Click() Dim dlsCoID As Long '酒店标识 Dim LockNo As String * 16 If rdCard <> True Then Exit Sub '先读卡 txtStrHex.Text = bufCard dlsCoID = CLng(txtCoID.Text) '酒店标识 st = GetGuestLockNoByCardDataStr(dlsCoID, bufCard, LockNo) If st = 0 Then MsgBox "锁号: " & LockNo, 64 ElseIf st = 1 Then MsgBox "卡数据串无效" & Chr(10) & bufCard, 48 ElseIf st = 2 Then MsgBox "非本酒店卡" & Chr(10) & bufCard, 48 ElseIf st = 3 Then MsgBox "不是客人卡" & Chr(10) & bufCard, 48 Else MsgBox "未知返回值: " & CStr(st) & Chr(10) & bufCard, 48 End If End Sub '读取客人卡离店时间 Private Sub Command7_Click() Dim dlsCoID As Long '酒店标识 Dim ETime As String * 16 If rdCard <> True Then Exit Sub '先读卡 txtStrHex.Text = bufCard dlsCoID = CLng(txtCoID.Text) '酒店标识 st = GetGuestETimeByCardDataStr(dlsCoID, bufCard, ETime) If st = 0 Then MsgBox "离店时间: " & ETime, 64 ElseIf st = 1 Then MsgBox "卡数据串无效" & Chr(10) & bufCard, 48 ElseIf st = 2 Then MsgBox "非本酒店卡" & Chr(10) & bufCard, 48 ElseIf st = 3 Then MsgBox "不是客人卡" & Chr(10) & bufCard, 48 Else MsgBox "未知返回值: " & CStr(st) & Chr(10) & bufCard, 48 End If End Sub Private Sub Form_Load() flagUSB = 1 '默认为pro免驱 txtCoID = "0" Cmdreset_Click End Sub Private Sub Option1_Click() flagUSB = 0 '有驱 End Sub Private Sub Option2_Click() flagUSB = 1 'pro免驱 End Sub '关闭程序 Private Sub cmdExit_Click() End End Sub '读取DLL版本信息 Private Sub cmdGetDllVer_Click() Dim s As String * 128 st = GetDLLVersion(s) If st = 0 Then MsgBox "DLL版本号为：" & s, 64 Else MsgBox "读DLL版本号错误, 错误代码为：" & CStr(st), 48 End If End Sub 'USB初始化 Private Sub Command1_Click() st = initializeUSB(1) If st <> 0 Then MsgBox "初始化USB端口失败, 错误代号为: " & CStr(st), 16 Else MsgBox "初始化USB端口成功", 64 Frame2.Enabled = True Frame4.Enabled = True End If End Sub '将输入框恢复到默认值 Private Sub Cmdreset_Click() txtCardNo = "1" txtLockNo = "01020A" txtETime = Format(Now + 1, "YYYY/MM/DD 14:00") txtDai = "0" txtStrHex = "" End Sub '蜂鸣器 Private Sub Cmdbuzzer_Click() Dim st As Integer st = Buzzer(flagUSB, 50) '发卡器鸣叫50x10ms If st <> 0 Then MsgBox "蜂鸣失败, 错误代号为: " & CStr(st), 16 End If End Sub '从现有卡片读取酒店标识 Private Sub Command3_Click() Dim i As Long Dim s As String If rdCard <> True Then Exit Sub '先读卡 txtStrHex.Text = bufCard If Mid(bufCard, 25, 8) = "FFFFFFFF" Then txtCoID.Text = "" MsgBox "此卡是空白卡，请换一张能开门的卡", 48 Exit Sub End If s = Mid(bufCard, 11, 4) i = CLng("&H" + s) Mod 16384 s = Mid(bufCard, 8, 3) i = i + (CLng("&H" + s) * 65536) txtCoID.Text = CStr(i) End Sub

人人皆为创造者，共创方能共成长

每个人都是使用者，也是创造者；是数字世界的消费者，更是价值的生产者与分享者。在智能时代的浪潮里，单打独斗的发展模式早已落幕，唯有开放连接、创意共创、利益共享，才能让个体价值汇聚成生态合力，让技术与创意双向奔赴，实现平台与伙伴的快速成长、共赢致远。

原创永久分成，共赴星辰大海

原创创意共创、永久收益分成，是东方仙盟始终坚守的核心理念。我们坚信，每一份原创智慧都值得被尊重与回馈，以永久分成锚定共创初心，让创意者长期享有价值红利，携手万千伙伴向着科技星辰大海笃定前行，拥抱硅基 生命与数字智能交融的未来，共筑跨越时代的数字文明共同体。

东方仙盟：拥抱知识开源，共筑数字新生态

在全球化与数字化浪潮中，东方仙盟始终秉持开放协作、知识共享的理念，积极拥抱开源技术与开放标准。我们相信，唯有打破技术壁垒、汇聚全球智慧，才能真正推动行业的可持续发展。

开源赋能中小商户：通过将前端异常检测、跨系统数据互联等核心能力开源化，东方仙盟为全球中小商户提供了低成本、高可靠的技术解决方案，让更多商家能够平等享受数字转型的红利。
共建行业标准：我们积极参与国际技术社区，与全球开发者、合作伙伴共同制定开放协议 与技术规范，推动跨境零售、文旅、餐饮等多业态的系统互联互通，构建更加公平、高效的数字生态。
知识普惠，共促发展：通过开源社区 、技术文档与培训体系，东方仙盟致力于将前沿技术转化为可落地的行业实践，赋能全球合作伙伴，共同培育创新人才，推动数字经济 的普惠式增长

阿雪技术观

在科技发展浪潮中，我们不妨积极投身技术共享。不满足于做受益者，更要主动担当贡献者 。无论是分享代码、撰写技术博客，还是参与开源项目 维护改进，每一个微小举动都可能蕴含推动技术进步的巨大能量。东方仙盟是汇聚力量的天地，我们携手在此探索硅基 生命，为科技进步添砖加瓦。

Hey folks, in this wild tech - driven world, why not dive headfirst into the whole tech - sharing scene? Don't just be the one reaping all the benefits; step up and be a contributor too. Whether you're tossing out your code snippets , hammering out some tech blogs, or getting your hands dirty with maintaining and sprucing up open - source projects, every little thing you do might just end up being a massive force that pushes tech forward. And guess what? The Eastern FairyAlliance is this awesome place where we all come together. We're gonna team up and explore the whole silicon - based life thing, and in the process, we'll be fueling the growth of technology