IDE:visual basic 5语言visual basic执行IDE:仙盟创梦IDE核心代码完整代码VERSION 5.00 Begin VB.Form MainFrm BorderStyle 1 Fixed Single Caption RF发卡器DLL调用VB演示 WWW.ISAKER.COM ClientHeight 6975 ClientLeft 45 ClientTop 435 ClientWidth 7380 BeginProperty Font Name 宋体 Size 10.5 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Icon TestComm.frx:0000 LinkTopic Form1 MaxButton 0 False MinButton 0 False ScaleHeight 6975 ScaleWidth 7380 StartUpPosition 1 所有者中心 Begin VB.Frame Frame4 Caption 通讯 BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 1395 Left 300 TabIndex 4 Top 180 Width 6795 Begin VB.TextBox TxtSec Height 315 Left 4800 TabIndex 34 Text 00 Top 900 Width 315 End Begin VB.TextBox TxtMin Height 315 Left 4200 TabIndex 26 Text 00 Top 900 Width 315 End Begin VB.TextBox TxtHour Height 315 Left 3540 TabIndex 24 Text 00 Top 900 Width 315 End Begin VB.TextBox TxtDay Height 315 Left 2820 TabIndex 22 Text 00 Top 900 Width 315 End Begin VB.TextBox TxtMonth Height 315 Left 2100 TabIndex 20 Text 00 Top 900 Width 315 End Begin VB.TextBox TxtYear Height 315 Left 1500 TabIndex 18 Text 00 Top 900 Width 315 End Begin VB.CommandButton SetRTCBtn Caption 写入RTC Height 495 Left 5460 TabIndex 17 ToolTipText 更新读卡器内部时间与电脑时钟同步 Top 780 Width 1155 End Begin VB.CommandButton GetRTCBtn Caption 读RTC Height 495 Left 120 TabIndex 16 ToolTipText 读取发卡器内部时间 Top 780 Width 1275 End Begin VB.CommandButton LinkBtn Caption 连接读卡器 BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 375 Left 120 TabIndex 5 Top 240 Width 6495 End Begin VB.Label Label1 Caption 秒 Height 255 Left 5220 TabIndex 35 Top 960 Width 315 End Begin VB.Label Label10 Caption 分 Height 315 Left 4560 TabIndex 27 Top 960 Width 315 End Begin VB.Label Label9 Caption 时 Height 315 Left 3960 TabIndex 25 Top 960 Width 315 End Begin VB.Label Label8 Caption 日 Height 315 Left 3240 TabIndex 23 Top 960 Width 315 End Begin VB.Label Label7 Caption 月 Height 315 Left 2520 TabIndex 21 Top 960 Width 315 End Begin VB.Label Label5 Caption 年 Height 315 Left 1860 TabIndex 19 Top 960 Width 315 End End Begin VB.ListBox StatusList BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 2220 ItemData TestComm.frx:030A Left 240 List TestComm.frx:032C TabIndex 3 Top 4560 Width 6855 End Begin VB.Frame Frame1 Caption 卡基本功能 BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 2715 Left 240 TabIndex 0 Top 1680 Width 6855 Begin VB.TextBox txt4100Num BeginProperty Font Name Arial Size 14.25 Charset 0 Weight 700 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty ForeColor H000080FF Height 435 Left 1440 TabIndex 37 Text 0000000000 Top 840 Width 1935 End Begin VB.CommandButton btnRead4100 Caption 读取仿真号 Height 375 Left 120 TabIndex 36 Top 840 Width 1215 End Begin VB.CommandButton SetMangerCardBtn Caption 发经理卡 Height 435 Left 5280 TabIndex 33 Top 2040 Width 1395 End Begin VB.TextBox TxtCustomer Enabled 0 False Height 315 Left 2040 TabIndex 29 Text 8000 Top 2100 Width 975 End Begin VB.CommandButton ReadTypeBtn Caption 读手牌类型 Height 435 Left 120 TabIndex 28 Top 2040 Width 1275 End Begin VB.CommandButton Command3 Caption 配置手牌码 BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 435 Left 5280 TabIndex 11 Top 1560 Width 1395 End Begin VB.TextBox TxtBoxID BeginProperty Font Name Arial Size 14.25 Charset 0 Weight 700 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty ForeColor H000080FF Height 390 Left 2040 MaxLength 4 TabIndex 10 Text 0000 Top 1560 Width 975 End Begin VB.ComboBox CmbZone BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 300 ItemData TestComm.frx:0497 Left 3780 List TestComm.frx:04AD TabIndex 9 Text 未知 Top 1620 Width 1215 End Begin VB.CommandButton Command9 Caption 读手牌码 BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 435 Left 120 TabIndex 8 Top 1560 Width 1275 End Begin VB.CommandButton Command2 Caption 发卡操作 BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 375 Left 5280 TabIndex 7 Top 180 Width 1395 End Begin VB.CommandButton CancelCardBTN Caption 消卡操作 BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 375 Left 5280 TabIndex 6 Top 600 Width 1395 End Begin VB.TextBox TxtRFID BeginProperty Font Name Arial Size 14.25 Charset 0 Weight 700 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty ForeColor H000080FF Height 435 Left 1500 MaxLength 8 TabIndex 2 Text 00000000 Top 360 Width 1515 End Begin VB.CommandButton ReadRFIDBTN Caption 读卡号 BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 405 Left 120 TabIndex 1 Top 360 Width 1305 End Begin VB.ComboBox CmbCardType Height 330 ItemData TestComm.frx:04D7 Left 3780 List TestComm.frx:04F3 TabIndex 30 Top 2100 Width 1215 End Begin VB.Label Label12 Caption 类型: Height 255 Left 3120 TabIndex 32 Top 2160 Width 675 End Begin VB.Label Label11 Caption 客户码 Height 435 Left 1500 TabIndex 31 Top 2100 Width 495 End Begin VB.Label Label4 Caption 发卡操作前请先读卡号 Height 435 Left 3540 TabIndex 15 Top 360 Width 1095 End Begin VB.Label Label2 Caption 手牌号码 BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 375 Left 1500 TabIndex 14 Top 1620 Width 375 End Begin VB.Label Label6 Caption 0000-FFFF BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 195 Left 2100 TabIndex 13 Top 1380 Width 915 End Begin VB.Label Label3 Caption 通道码: BeginProperty Font Name 宋体 Size 9 Charset 134 Weight 400 Underline 0 False Italic 0 False Strikethrough 0 False EndProperty Height 195 Left 3120 TabIndex 12 Top 1680 Width 675 End End End Attribute VB_Name MainFrm Attribute VB_GlobalNameSpace False Attribute VB_Creatable False Attribute VB_PredeclaredId True Attribute VB_Exposed False Option Explicit Private Declare Sub Sleep Lib kernel32 (ByVal dwMilliseconds As Long) Private Declare Function OpenReader Lib RF003Reader.dll (ByVal CommName As Long) As Long Private Declare Function CloseReader Lib RF003Reader.dll () As Long Private Declare Function ReadRFID Lib RF003Reader.dll (ByRef pRFID As Byte) As Integer Private Declare Function SetCard Lib RF003Reader.dll (ByRef pRFID As Byte) As Integer Private Declare Function ClearCard Lib RF003Reader.dll (ByRef pRFID As Byte) As Integer Private Declare Function GetReaderVersion Lib RF003Reader.dll (ByRef pVerByte As Byte) As Integer Private Declare Function GetHandId Lib RF003Reader.dll (ByRef pHandId As Byte) As Integer Private Declare Function SetHandId Lib RF003Reader.dll (ByRef pHandId As Byte) As Integer Private Declare Function GetRTC Lib RF003Reader.dll (ByRef pRTC As Byte) As Integer Private Declare Function SetRTC Lib RF003Reader.dll (ByRef pRTC As Byte) As Integer Private Declare Function GetHandType Lib RF003Reader.dll (ByRef pHandType As Byte) As Integer Private Declare Function SetHandType Lib RF003Reader.dll (ByRef pHandType As Byte) As Integer Private Declare Function Read4100RFID Lib RF003Reader.dll (ByRef pRFID4100 As Byte) As Integer Const REG_SZ 1 Const HKEY_LOCAL_MACHINE H80000002 Const ERROR_SUCCESS 0 Const SYNCHRONIZE H100000 Const STANDARD_RIGHTS_READ H20000 Const KEY_QUERY_VALUE H1 Const KEY_CREATE_SUB_KEY H4 Const KEY_ENUMERATE_SUB_KEYS H8 Const KEY_NOTIFY H10 Const KEY_READ ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) Private Sub btnRead4100_Click() Dim RetVal As Integer If ReaderOpen True Then StatusList.Clear RetVal Read4100RFID(RFID4100(0)) If RetVal 0 Then TxtRFID Right(0 Hex(RFID(0)), 2) Right(0 Hex(RFID(1)), 2) Right(0 Hex(RFID(2)), 2) Right(0 Hex(RFID(3)), 2) StatusList.AddItem (读RFID操作成功...) Else StatusList.AddItem (读RFID操作不成,Err: Str(RetVal)) End If End If End Sub Private Sub CancelCardBTN_Click() Dim RetVal As Integer If ReaderOpen True Then StatusList.Clear RetVal ClearCard(RFID(0)) If RetVal 0 Then TxtRFID Right(0 Hex(RFID(0)), 2) Right(0 Hex(RFID(1)), 2) Right(0 Hex(RFID(2)), 2) Right(0 Hex(RFID(3)), 2) StatusList.AddItem (消卡操作成功...) Else StatusList.AddItem (消卡操Err: Str(RetVal)) End If End If End Sub Private Sub Command1_Click() Call Form_Load End Sub Private Sub Command2_Click() Dim RetVal As Integer, tempstr As String StatusList.Clear tempstr Right(00000000 TxtRFID.Text, 8) RFID(0) Val(H Mid(tempstr, 1, 2)) RFID1-2 RFID(1) Val(H Mid(tempstr, 3, 2)) RFID3-4 RFID(2) Val(H Mid(tempstr, 5, 2)) RFID5-6 RFID(3) Val(H Mid(tempstr, 7, 2)) RFID7-8 RetVal SetCard(RFID(0)) If RetVal 0 Then StatusList.AddItem (发牌成功) Else StatusList.AddItem (发牌Err: Str(RetVal)) If RetVal 3 Then StatusList.AddItem (USB-232通讯出错!) If RetVal 3 Then StatusList.AddItem (无法读取RFID号码!) If RetVal 4 Then StatusList.AddItem (手牌RFID码不配对!) If RetVal 7 Then StatusList.AddItem (读卡器内部时钟有误请设置RTC!) End If End Sub Private Sub Command8_Click() StatusList.Clear End Sub Private Sub Command3_Click() Dim RetVal As Integer If ReaderOpen True Then StatusList.Clear TxtBoxID Right(0000 TxtBoxID, 4) HandId(0) Val(H0 Left(TxtBoxID, 2)) HandId(1) Val(H0 Right(TxtBoxID, 2)) HandId(2) CmbZone.ListIndex HandId(3) HandId(0) Xor HandId(1) Xor HandId(2) RetVal SetHandId(HandId(0)) If RetVal 0 Then StatusList.AddItem (设置手牌成功!) Else StatusList.AddItem (设置手牌出错: Str(RetVal)) End If End If End Sub Private Sub Command4_Click() End Sub Private Sub Command9_Click() Dim RetVal As Integer If ReaderOpen True Then StatusList.Clear RetVal GetHandId(HandId(0)) If RetVal 0 Then TxtBoxID Right(0 Hex(HandId(0)), 2) Right(0 Hex(HandId(1)), 2) If (HandId(2) CmbZone.ListCount) Then CmbZone.ListIndex HandId(2) Else CmbZone.Text 未知 StatusList.AddItem (读手牌操作成功...) Else StatusList.AddItem (读手牌出错: Str(RetVal)) End If End If End Sub Private Sub Form_Load() Check registry serial Port list Start ----------------------------- Dim typecode As Long Dim lngKeyHandle As Long Dim lngResult As Long Dim lngCurIdx As Long Dim ValueName As String * 256 Dim ValueNameLen As Long Dim Value As String * 256 Dim ValueLen As Long Dim FreeNum As Integer Dim a As String ReaderOpen False FreeNum FreeFile If Dir(App.Path \Zone.txt) Then CmbZone.Clear Open App.Path \Zone.txt For Input As #FreeNum Do Until EOF(FreeNum) 循环直到文件结尾。Eof函数用来判断文件是否读完 Line Input #FreeNum, a CmbZone.AddItem (a) Loop CmbZone.AddItem (未知) Close FreeNum End If MsgBox (App.Path) End Sub Private Sub Form_Unload(Cancel As Integer) Dim RetVal RetVal CloseReader() End Sub Private Sub GetRTCBtn_Click() Dim RetVal As Integer, tmpchksum As Byte GetRTCBtn.Enabled False If ReaderOpen True Then StatusList.Clear RetVal GetRTC(RTC(0)) If RetVal 0 Then TxtYear.Text Right(0 Hex(RTC(0)), 2) TxtMonth Right(0 Hex(RTC(1)), 2) TxtDay Right(0 Hex(RTC(2)), 2) TxtHour Right(0 Hex(RTC(3)), 2) TxtMin Right(0 Hex(RTC(4)), 2) TxtSec Right(0 Hex(RTC(5)), 2) StatusList.AddItem (读RTC操作成功...) StatusList.AddItem (如果读卡器的时间和标准时间差距大于2分钟,请设置读卡器RTC...) Else StatusList.AddItem (读RTC操作不成,Err: Str(RetVal)) End If Else StatusList.AddItem (请先连接读卡器) End If GetRTCBtn.Enabled True End Sub Private Sub LinkBTN_Click() Dim RetVal As Long Dim CommPort As Long RetVal OpenReader(1) StatusList.Clear If RetVal 0 Then ReaderOpen True StatusList.AddItem (USB 接口上找到RF003读卡器) Else StatusList.AddItem (未找到RF003读卡器) End If End Sub Private Sub ReadRFIDBTN_Click() Dim RetVal As Integer If ReaderOpen True Then StatusList.Clear RetVal ReadRFID(RFID(0)) If RetVal 0 Then TxtRFID Right(0 Hex(RFID(0)), 2) Right(0 Hex(RFID(1)), 2) Right(0 Hex(RFID(2)), 2) Right(0 Hex(RFID(3)), 2) StatusList.AddItem (读RFID操作成功...) Else StatusList.AddItem (读RFID操作不成,Err: Str(RetVal)) End If End If End Sub Private Sub ReadTypeBtn_Click() Dim RetVal As Long If ReaderOpen True Then StatusList.Clear RetVal GetHandType(HandType(0)) CmbCardType.ListIndex 0 If RetVal 0 Then If HandType(0) Xor HandType(1) Xor HandType(2) HandType(3) Then TxtCustomer Right(0 Hex(HandType(0)), 2) Right(0 Hex(HandType(1)), 2) If HandType(2) H45 Then CmbCardType.ListIndex 1 If HandType(2) H42 Then CmbCardType.ListIndex 2 If HandType(2) H52 Then CmbCardType.ListIndex 3 If HandType(2) H80 Then CmbCardType.ListIndex 4 If HandType(2) H90 Then CmbCardType.ListIndex 5 If HandType(2) HA0 Then CmbCardType.ListIndex 6 If HandType(2) HB0 Then CmbCardType.ListIndex 7 StatusList.AddItem (读手牌类型码操作成功...) Else StatusList.AddItem (手牌类型码未定义!) End If Else StatusList.AddItem (读手牌类型码出错: Str(RetVal)) End If End If End Sub Private Sub SetMangerCardBtn_Click() Dim RetVal As Integer If ReaderOpen True Then StatusList.Clear TxtCustomer Right(0000 TxtCustomer, 4) HandType(0) Val(H0 Left(TxtCustomer, 2)) HandType(1) Val(H0 Right(TxtCustomer, 2)) HandType(2) H90 经理卡可以临时开门1次需要配置待衣柜锁的手牌码 HandType(3) HandType(0) Xor HandType(1) Xor HandType(2) RetVal SetHandType(HandType(0)) If RetVal 0 Then StatusList.AddItem (设置经理卡成功!) Else StatusList.AddItem (设置经理卡出错: Str(RetVal)) End If End If End Sub Private Sub SetRTCBtn_Click() Dim RetVal As Integer, Temp As Integer If ReaderOpen True Then TxtYear.Text Right(Trim(Year(Date)), 2) TxtMonth.Text Right(0 Trim(Month(Date)), 2) TxtDay.Text Right(0 Trim(Day(Date)), 2) TxtHour Right(0 Trim(Hour(Time)), 2) TxtMin Right(0 Trim(Minute(Time)), 2) TxtSec Right(0 Trim(Second(Time)), 2) Temp Val(TxtYear.Text) RTC(0) (Temp \ 10) * 16 (Temp Mod 10) Temp Val(TxtMonth.Text) RTC(1) (Temp \ 10) * 16 (Temp Mod 10) Temp Val(TxtDay.Text) RTC(2) (Temp \ 10) * 16 (Temp Mod 10) Temp Val(TxtHour.Text) RTC(3) (Temp \ 10) * 16 (Temp Mod 10) Temp Val(TxtMin.Text) RTC(4) (Temp \ 10) * 16 (Temp Mod 10) Temp Val(TxtSec.Text) RTC(5) (Temp \ 10) * 16 (Temp Mod 10) RetVal SetRTC(RTC(0)) If RetVal 0 Then StatusList.AddItem (Set RTC 操作成功...) Else StatusList.AddItem (Set RTC 操作不成,Err: Str(RetVal)) End If Else StatusList.AddItem (请先连接读卡器) End If End Sub Private Sub StatusList_DblClick() StatusList.Clear End Sub Private Sub TxtBoxID_Change() Dim UL As String TxtBoxID UCase$(TxtBoxID.Text) UL Left(TxtBoxID.Text, 1) If UL And UL A And UL a And UL B And UL b And UL C And UL c And UL D And UL d And UL E And UL e And UL F And UL f Then MsgBox 输入格式错误请重新输入, , 提示 TxtBoxID.Text End If End Sub Private Sub TxtBoxID_KeyPress(KeyAscii As Integer) If ((KeyAscii 48 Or KeyAscii 57) And (KeyAscii 64 Or KeyAscii 70) And (KeyAscii Asc(a) Or KeyAscii Asc(f)) And KeyAscii 8) Then KeyAscii 0 End Sub人人皆为创造者共创方能共成长每个人都是使用者也是创造者是数字世界的消费者更是价值的生产者与分享者。在智能时代的浪潮里单打独斗的发展模式早已落幕唯有开放连接、创意共创、利益共享才能让个体价值汇聚成生态合力让技术与创意双向奔赴实现平台与伙伴的快速成长、共赢致远。原创永久分成共赴星辰大海原创创意共创、永久收益分成是东方仙盟始终坚守的核心理念。我们坚信每一份原创智慧都值得被尊重与回馈以永久分成锚定共创初心让创意者长期享有价值红利携手万千伙伴向着科技星辰大海笃定前行拥抱硅基 生命与数字智能交融的未来共筑跨越时代的数字文明共同体。东方仙盟拥抱知识开源共筑数字新生态在全球化与数字化浪潮中东方仙盟始终秉持开放协作、知识共享的理念积极拥抱开源技术与开放标准。我们相信唯有打破技术壁垒、汇聚全球智慧才能真正推动行业的可持续发展。开源赋能中小商户通过将前端异常检测、跨系统数据互联等核心能力开源化东方仙盟为全球中小商户提供了低成本、高可靠的技术解决方案让更多商家能够平等享受数字转型的红利。共建行业标准我们积极参与国际技术社区与全球开发者、合作伙伴共同制定开放协议 与技术规范推动跨境零售、文旅、餐饮等多业态的系统互联互通构建更加公平、高效的数字生态。知识普惠共促发展通过开源社区 、技术文档与培训体系东方仙盟致力于将前沿技术转化为可落地的行业实践赋能全球合作伙伴共同培育创新人才推动数字经济 的普惠式增长阿雪技术观在科技发展浪潮中我们不妨积极投身技术共享。不满足于做受益者更要主动担当贡献者 。无论是分享代码、撰写技术博客还是参与开源项目 维护改进每一个微小举动都可能蕴含推动技术进步的巨大能量。东方仙盟是汇聚力量的天地我们携手在此探索硅基 生命为科技进步添砖加瓦。Hey folks, in this wild tech - driven world, why not dive headfirst into the whole tech - sharing scene? Dont just be the one reaping all the benefits; step up and be a contributor too. Whether youre 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. Were gonna team up and explore the whole silicon - based life thing, and in the process, well be fueling the growth of technology