需要放到雷雕程序目录中执行。 需要调用MarkEzdStdCall.dll, 是对MarkEzd.dll二次封装后的文件,具体参照另一个文章。
可能需要以下几个dll文件,去网上下载即可。 MFC42UD.DLL MFCO42UD.DLL msvcrtd.dll
aaaaa.ezd是雷雕模板文件。
VERSION 5.00 Begin VB.Form Form1 Caption = "金橙子镭雕二次开发--" ClientHeight = 4725 ClientLeft = 45 ClientTop = 435 ClientWidth = 8670 Icon = "Form1.frx":0000 LinkTopic = "Form1" ScaleHeight = 4725 ScaleWidth = 8670 StartUpPosition = 1 'CenterOwner Begin VB.Timer Timer1 Enabled = 0 'False Interval = 100 Left = 7320 Top = 2520 End Begin VB.CommandButton stopButton Caption = "停止执行" Enabled = 0 'False BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 612 Left = 3960 TabIndex = 7 Top = 2640 Width = 2172 End Begin VB.CommandButton startButton Caption = "开始执行" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 612 Left = 840 TabIndex = 6 Top = 2640 Width = 2172 End Begin VB.Frame Frame1 Caption = "参数设置" Height = 2172 Left = 240 TabIndex = 9 Top = 240 Width = 8172 Begin VB.OptionButton runTimes Caption = "连续执行" Height = 252 Index = 1 Left = 2160 TabIndex = 5 Top = 1680 Value = -1 'True Width = 1092 End Begin VB.OptionButton runTimes Caption = "执行一次" Height = 252 Index = 0 Left = 1080 TabIndex = 4 Top = 1680 Width = 1092 End Begin VB.ComboBox waitTimeList Height = 288 ItemData = "Form1.frx":038A Left = 2640 List = "Form1.frx":038C Style = 2 'Dropdown List TabIndex = 3 Top = 1182 Width = 852 End Begin VB.TextBox fileName Height = 288 Left = 1080 TabIndex = 2 Top = 702 Width = 2772 End Begin VB.ComboBox comList Height = 288 Left = 1080 Style = 2 'Dropdown List TabIndex = 1 Top = 240 Width = 2052 End Begin VB.Label Label8 Caption = "执行次数:" Height = 252 Left = 120 TabIndex = 16 Top = 1680 Width = 972 End Begin VB.Label Label7 Caption = "EzCad模板文件,与本程序放在同一目录下" Height = 252 Left = 4080 TabIndex = 15 Top = 720 Width = 3972 End Begin VB.Label Label6 Caption = "秒开始雕刻卡号。" Height = 252 Left = 3600 TabIndex = 14 Top = 1200 Width = 1332 End Begin VB.Label Label5 Caption = "发现卡片后,等待" Height = 252 Left = 1080 TabIndex = 13 Top = 1200 Width = 1452 End Begin VB.Label Label4 Caption = "时间设置:" Height = 252 Left = 120 TabIndex = 12 Top = 1200 Width = 972 End Begin VB.Label Label3 Caption = "模板文件:" Height = 252 Left = 120 TabIndex = 11 Top = 720 Width = 972 End Begin VB.Label Label1 Caption = "串口:" Height = 252 Left = 360 TabIndex = 10 Top = 264 Width = 852 End End Begin VB.Label Label2 Caption = "状态:" Height = 252 Left = 120 TabIndex = 8 Top = 3600 Width = 612 End Begin VB.Label statusLabel Caption = "未执行" Height = 1092 Left = 840 TabIndex = 0 Top = 3600 Width = 6972 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False
Option Base 0 Private Declare Function Beep Lib "kernel32 " (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'---------------------以下是镭雕的的API调用------------------------------------- Private Declare Function stdCallStart Lib "MarkEzdStdCall.dll" () As Long
Private Declare Function stdCallEnd Lib "MarkEzdStdCall.dll" () As Long
Private Declare Function lmc1_Initial_StdCall Lib "MarkEzdStdCall.dll" (ByVal strEzCadPath As String, ByVal bTestMode As Boolean, ByVal hOwenWnd As Long) As Long
Private Declare Function lmc1_LoadEzdFile_StdCall Lib "MarkEzdStdCall.dll" (ByVal strFileName As String) As Long
Private Declare Function lmc1_ChangeTextByName_StdCall Lib "MarkEzdStdCall.dll" (ByVal strTextName As String, ByVal strTextNew As String) As Long
Private Declare Function lmc1_Mark_StdCall Lib "MarkEzdStdCall.dll" (ByVal bFlyMark As Boolean) As Long
Private Declare Function lmc1_Close_StdCall Lib "MarkEzdStdCall.dll" () As Long
'---------------------以下是串口读写的API调用------------------------------------- Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const OPEN_EXISTING = 3 Private Const INVALID_HANDLE_VALUE = -1 Private Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long Private Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long Private Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long Private Const PURGE_TXABORT = &H1 ' Kill the pending/current writes to the comm port. Private Const PURGE_RXABORT = &H2 ' Kill the pending/current reads to the comm port. Private Const PURGE_TXCLEAR = &H4 ' Kill the transmit queue if there. Private Const PURGE_RXCLEAR = &H8 ' Kill the typeahead buffer if there. Private Type DCB DCBlength As Long BaudRate As Long fBitFields As Long 'See Comments in Win32API.Txt wReserved As Integer XonLim As Integer XoffLim As Integer ByteSize As Byte Parity As Byte StopBits As Byte XonChar As Byte XoffChar As Byte ErrorChar As Byte EOFChar As Byte EvtChar As Byte wReserved1 As Integer 'Reserved; Do Not Use End Type Private Type COMMTIMEOUTS ReadIntervalTimeout As Long ReadTotalTimeoutMultiplier As Long ReadTotalTimeoutConstant As Long WriteTotalTimeoutMultiplier As Long WriteTotalTimeoutConstant As Long End Type Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long
'---------------------以下是全局变量------------------------------------- '上一张卡号 Dim LastCardNo As String
'历史消息数 Dim msgCount As Integer
'是否正在雷雕 Dim isMarking As Boolean
'串口 Dim hComm As Long
'读取串口数据 Private Sub ReadData()
Dim data As String Dim letter As String
'读取数据 data = BytesToString(ReadComm(hComm)) If data = "" Then M ("返回数据为空。") Call stopButton_Click Exit Sub End If '第一位字母 letter = Left(data, 1) '判断成功还是失败 If letter = "E" Then '寻卡失败,'E'+0x0D,继续寻卡…… M ("寻卡失败。") ElseIf letter = "O" Then '寻卡成功,字母'O'+ 11字节卡号,最后是0x0D Dim cardNo As String cardNo = Mid(data, 2, 11) M ("寻卡成功,卡号" & cardNo & "。") 'Beep 800, 200 'Beep 800, 200 '如果与上一张卡号一样,则返回 If LCase(cardNo) = LCase(LastCardNo) Then M ("请换卡。") Else '等待指定的时间 Dim waitTime As Long waitTime = CLng(waitTimeList.ListIndex + 1) M ("等待" & waitTime & "秒后开始雕刻..") Sleep waitTime * 1000 '更新文本,雕刻 Call PrintCardNo(cardNo) '缓存卡号 LastCardNo = cardNo End If
End If '清空缓冲区 Call ClearComm(hComm) '执行一次,则直接结束。连续执行,则继续发送寻卡命令 If runOnce() = True Then Call stopButton_Click Else '睡500毫秒(把卡拿走的时间) Sleep (500) '继续寻卡 Call sendReadMsg '开始定时器 Timer1.Enabled = True End If End Sub
'打开串口 Private Function openCom()
'默认True openCom = True '打开串口1 hComm = OpenComm(comList.ListIndex + 1) If hComm = 0 Then M "打开串口" & (comList.ListIndex + 1) & "失败。" openCom = False Exit Function End If M "打开串口" & (comList.ListIndex + 1) & "成功。" '设置串口通讯参数 Dim setResult As Boolean setResult = SetCommParam(hComm, 38400, 8, ONESTOPBIT, NOPARITY) '设置波特率为38400,8位数据位,1位结束位,没有奇偶校验 If setResult = False Then M "设置串口" & (comList.ListIndex + 1) & "参数失败。" openCom = False Exit Function End If '设置串口超时 setResult = SetCommTimeOut(hComm, 2, 3) If setResult = False Then M "设置串口" & (comList.ListIndex + 1) & "超时时间失败。" openCom = False Exit Function End If '上一张卡号 LastCardNo = "" '成功返回 openCom = True End Function
'关闭端口 Private Sub closeCom()
'关闭串口 CloseComm hComm End Sub
'读取卡号命令 Private Sub sendReadMsg()
'向串口写入字符R WriteComm hComm, StringToBytes("R") End Sub
'关闭窗口时,关闭串口 Private Sub Form_Unload(Cancel As Integer)
If isMarking = True Then MsgBox ("正在雕刻,请稍后停止。") Exit Sub End If If stopButton.Enabled = True Then '停止定时器 Timer1.Enabled = False '镭雕软件收尾 If MarkEnd() = False Then '出错就出错吧。 End If '关闭串口 Call closeCom End If '保存参数 Call saveConfig End Sub
'软件刚打开,进行初始化 Private Sub Form_Load()
'串口列表,VB的限制,最多到COM16 comList.AddItem ("COM1") comList.AddItem ("COM2") comList.AddItem ("COM3") comList.AddItem ("COM4") comList.AddItem ("COM5") comList.AddItem ("COM6") comList.AddItem ("COM7") comList.AddItem ("COM8") comList.AddItem ("COM9") comList.AddItem ("COM10") comList.AddItem ("COM11") comList.AddItem ("COM12") comList.AddItem ("COM13") comList.AddItem ("COM14") comList.AddItem ("COM15") comList.AddItem ("COM16") comList.ListIndex = 0 '选中COM1 '文件名 FileName.Text = "1600.ezd" '等待时间下拉框 waitTimeList.AddItem ("1") waitTimeList.AddItem ("2") waitTimeList.AddItem ("3") waitTimeList.AddItem ("4") waitTimeList.AddItem ("5") waitTimeList.AddItem ("6") waitTimeList.AddItem ("7") waitTimeList.AddItem ("8") waitTimeList.AddItem ("9") waitTimeList.AddItem ("10") waitTimeList.ListIndex = 2 '选中3 '默认执行多次 runTimes.Item(1).Value = True '取得配置参数 Dim config As String config = getConfig() If Len(config) > 0 Then configArray = Split(config, "|") If UBound(configArray) = 3 Then '不检查数据了,没闲人改这个 comList.ListIndex = CInt(configArray(0)) FileName.Text = configArray(1) waitTimeList.ListIndex = CInt(configArray(2)) If CInt(configArray(3)) = 0 Then runTimes.Item(0).Value = True Else runTimes.Item(0).Value = False End If End If End If End Sub
'镭雕软件准备工作 Private Function MarkPrepare()
'默认True MarkPrepare = True '出错继续执行 On Error Resume Next '接收处理结果 Dim result As Long 'MarkEzdStdCall.dll的准备工作 result = stdCallStart() If Err.Number <> 0 Then M ("MarkEzdStdCall.dll准备工作出错。" & Err.Description) MarkPrepare = False Exit Function End If If result <> 0 Then M ("MarkEzdStdCall.dll准备工失败。" & getErrDesc(result)) MarkPrepare = False Exit Function End If '--------初始化lmc1控制卡---------- 'int lmc1_Initial(TCHAR* strEzCadPath,BOOL bTestMode,HWND hOwenWnd); 'strEzCadPath:ezcad2.exe所处的目录的全路径名称 'bTestMode:指是否是测试模式 'hOwenWnd:指拥有用户输入焦点的窗口,用于检测用户暂停消息 result = lmc1_Initial_StdCall(StrConv(App.Path, vbUnicode), False, Me.hWnd) If Err.Number <> 0 Then M ("初始化lmc1控制卡出错。" & Err.Description) MarkPrepare = False Exit Function End If If result <> 0 Then M ("初始化lmc1控制卡失败。" & getErrDesc(result)) MarkPrepare = False Exit Function End If '--------打开模板文件-------- result = lmc1_LoadEzdFile_StdCall(StrConv(Trim(FileName.Text), vbUnicode)) If Err.Number <> 0 Then M ("打开指定的ezd文件出错。" & Err.Description) '关闭lmc1控制卡,是否关闭成功不管了。 result = lmc1_Close_StdCall() MarkPrepare = False Exit Function End If If result <> 0 Then M ("打开指定的ezd文件失败。" & getErrDesc(result)) '关闭lmc1控制卡,是否关闭成功不管了。 result = lmc1_Close_StdCall() MarkPrepare = False Exit Function End If '成功返回 MarkPrepare = True End Function
'镭雕软件收尾工作 Private Function MarkEnd()
'默认true MarkEnd = True
'出错继续执行 On Error Resume Next '接收处理结果 Dim result As Long result = lmc1_Close_StdCall() If Err.Number <> 0 Then M ("关闭lmc1控制卡出错。" & Err.Description) MarkEnd = False Exit Function End If If result <> 0 Then M ("关闭lmc1控制卡失败。" & getErrDesc(result)) MarkEnd = False Exit Function End If result = stdCallEnd() If Err.Number <> 0 Then M ("MarkEzdStdCall.dll结束工作出错。" & Err.Description) MarkEnd = False Exit Function End If If result <> 0 Then M ("MarkEzdStdCall.dll结束工作失败。" & getErrDesc(result)) MarkEnd = False Exit Function End If '成功返回 MarkEnd = True End Function
'雕刻卡号 Private Function PrintCardNo(cardNo As String)
'Beep 800, 200 'Beep 800, 200 'Beep 800, 200 M ("开始雕刻.....") '正在镭雕,不能停止 isMarking = True '默认True PrintCardNo = True '出错继续执行 On Error Resume Next '接收处理结果 Dim result As Long '替换卡号 result = lmc1_ChangeTextByName_StdCall(StrConv("cardNo", vbUnicode), StrConv(cardNo, vbUnicode)) If Err.Number <> 0 Then M ("更改文本内容出错。" & Err.Description) PrintCardNo = False isMarking = False Exit Function End If If result <> 0 Then M ("更改文本内容失败。" & getErrDesc(result)) PrintCardNo = False isMarking = False Exit Function End If '雕刻,此函数一直等待设备加工完毕后才返回 result = lmc1_Mark_StdCall(False) If Err.Number <> 0 Then M ("雕刻出错。" & Err.Description) PrintCardNo = False isMarking = False Exit Function End If If result <> 0 Then M ("雕刻失败。" & getErrDesc(result)) PrintCardNo = False isMarking = False Exit Function End If '成功返回 PrintCardNo = True isMarking = False M ("雕刻成功。") '记录成功的卡号 Call LogSuccessCardNo(cardNo) End Function
'取得错误号描述 Private Function getErrDesc(resultCode As Long) Select Case resultCode Case -1 getErrDesc = "MarkEzdStdCall.dll调用出错" Case 0 getErrDesc = "成功" Case 1 getErrDesc = "发现EZCAD在运行" Case 2 getErrDesc = "找不到EZCAD.CFG" Case 3 getErrDesc = "打开LMC1失败" Case 4 getErrDesc = "没有有效的lmc1设备" Case 5 getErrDesc = "lmc1版本错误" Case 6 getErrDesc = "找不到设备配置文件" Case 7 getErrDesc = "报警信号" Case 8 getErrDesc = "用户停止" Case 9 getErrDesc = "不明错误" Case 10 getErrDesc = "超时" Case 11 getErrDesc = "未初始化" Case 12 getErrDesc = "读文件错误" Case 13 getErrDesc = "窗口为空" Case 14 getErrDesc = "找不到指定名称的字体" Case 15 getErrDesc = "错误的笔号" Case 16 getErrDesc = "指定名称的对象不是文本对象" Case 17 getErrDesc = "保存文件失败" Case 18 getErrDesc = "找不到指定对象" Case 19 getErrDesc = "当前状态下不能执行此操作" Case Else getErrDesc = "未知错误号" End Select End Function
'开始执行 Private Sub startButton_Click() '输入检查 If Len(Trim(FileName.Text)) = 0 Then MsgBox ("请输入模板文件名。") Exit Sub End If '消息数置0 msgCount = 0 '打开串口 If openCom() = False Then Call closeCom Exit Sub End If '镭雕软件准备 If MarkPrepare() = False Then Call closeCom '关串口 Exit Sub End If '发送读卡号命令 Call sendReadMsg M ("寻卡命令已经发送。") '按钮状态 comList.Enabled = False FileName.Enabled = False waitTimeList.Enabled = False runTimes.Item(0).Enabled = False runTimes.Item(1).Enabled = False startButton.Enabled = False stopButton.Enabled = True '开始定时器 Timer1.Enabled = True End Sub
'停止执行 Private Sub stopButton_Click()
If isMarking = True Then MsgBox ("正在雕刻,请稍后停止。") Exit Sub End If '停止定时器 Timer1.Enabled = False '镭雕软件收尾 If MarkEnd() = False Then '出错就出错吧。 End If '关闭串口 Call closeCom '按钮状态 comList.Enabled = True FileName.Enabled = True waitTimeList.Enabled = True runTimes.Item(0).Enabled = True runTimes.Item(1).Enabled = True startButton.Enabled = True stopButton.Enabled = False M ("未执行") End Sub
'显示消息 Private Sub M(msg As String) Dim d As Date Dim dStr As String Dim historyMsg As String d = Now dStr = "[" & Year(d) & "-" & Month(d) & "-" & Day(d) & " " & Hour(d) & ":" & Minute(d) & ":" & Second(d) & "]" historyMsg = statusLabel.Caption If msgCount = 0 Then statusLabel.Caption = msg & dStr & vbCrLf msgCount = msgCount + 1 ElseIf msgCount < 5 Then statusLabel.Caption = historyMsg & msg & dStr & vbCrLf msgCount = msgCount + 1 Else '去掉第一行,然后在最后追加当前消息,实现滚动 statusLabel.Caption = Right(historyMsg, Len(historyMsg) - (InStr(historyMsg, vbCrLf) + 2) + 1) & msg & dStr & vbCrLf End If End Sub
'定时器时间到 Private Sub Timer1_Timer()
'停止定时器 Timer1.Enabled = False '即100毫秒后开始读数据 Call ReadData End Sub
'是否只执行一次 Private Function runOnce() runOnce = runTimes.Item(0).Value End Function
'取得配置内容 Private Function getConfig()
getConfig = "" '文件路径 filePath = App.Path + "\xxMark.ini" '判断文件是否存在 If Dir(filePath) = "" Then Exit Function End If '读入文件内容 Dim str As String Open filePath For Input As #1 If LOF(1) > 0 Then '文件长度大于0,才读入 Input #1, str End If Close #1 getConfig = str End Function
'保存设置 Private Function saveConfig()
'拼接字符串 Dim str As String str = "" & comList.ListIndex & "|" & Trim(FileName.Text) & "|" & waitTimeList.ListIndex & "|" If runTimes.Item(0).Value = True Then str = str & "0" Else str = str & "1" End If '文件路径 filePath = App.Path + "\xxMark.ini" '写入文件 Open filePath For Output As #1 Write #1, str Close #1 End Function
'记录成功的卡号 Private Sub LogSuccessCardNo(cardNo As String) '文件路径 filePath = App.Path + "\MarkCardNo.txt" Dim d As Date Dim dStr As String d = Now dStr = "[" & Year(d) & "-" & Month(d) & "-" & Day(d) & " " & Hour(d) & ":" & Minute(d) & ":" & Second(d) & "]" '写入文件 Open filePath For Append As #1 Write #1, cardNo & "," & dStr Close #1 End Sub
'打开串口 Function OpenComm(ByVal lComPort As Long) As Long Dim hComm As Long hComm = CreateFile("COM" & lComPort, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0) If hComm = INVALID_HANDLE_VALUE Then OpenComm = 0 Else OpenComm = hComm End If End Function '关闭串口 Sub CloseComm(hComm As Long) CloseHandle hComm hComm = 0 End Sub '读串口 Function ReadComm(ByVal hComm As Long) As Byte() Dim dwBytesRead As Long Dim BytesBuffer() As Byte ReDim BytesBuffer(4095) ReadFile hComm, BytesBuffer(0), UBound(BytesBuffer) + 1, dwBytesRead, 0 If dwBytesRead > 0 Then ReDim Preserve BytesBuffer(dwBytesRead) ReadComm = BytesBuffer End If End Function '写串口 Function WriteComm(ByVal hComm As Long, BytesBuffer() As Byte) As Long Dim dwBytesWrite If SafeArrayGetDim(BytesBuffer) = 0 Then Exit Function WriteFile hComm, BytesBuffer(0), UBound(BytesBuffer) + 1, dwBytesWrite, 0 WriteComm = dwBytesWrite End Function '设置串口通讯参数 Function SetCommParam(ByVal hComm As Long, Optional ByVal lBaudRate As Long = 9600, _ Optional ByVal cByteSize As Byte = 8, Optional ByVal cStopBits As Byte = 0, _ Optional ByVal cParity As Byte = 0, Optional ByVal cEOFChar As Long = 26) As Boolean Dim dc As DCB If hComm = 0 Then Exit Function If GetCommState(hComm, dc) Then dc.BaudRate = lBaudRate dc.ByteSize = cByteSize dc.StopBits = cStopBits dc.Parity = cParity dc.EOFChar = cEOFChar SetCommParam = CBool(SetCommState(hComm, dc)) End If End Function '设置串口超时 Function SetCommTimeOut(ByVal hComm As Long, Optional ByVal dwReadTimeOut As Long = 2, _ Optional ByVal dwWriteTimeOut As Long = 3) As Boolean Dim ct As COMMTIMEOUTS If hComm = 0 Then Exit Function ct.ReadIntervalTimeout = dwReadTimeOut '读操作时,字符间超时 ct.ReadTotalTimeoutMultiplier = dwReadTimeOut '读操作时,每字节超时 ct.ReadTotalTimeoutConstant = dwReadTimeOut '读操作时,固定超时(总超时=每字节超时*字节数+固定超时) ct.WriteTotalTimeoutMultiplier = dwWriteTimeOut '写操作时,每字节超时 ct.WriteTotalTimeoutConstant = dwWriteTimeOut '写操作时,固定超时(总超时=每字节超时*字节数+固定超时) SetCommTimeOut = CBool(SetCommTimeouts(hComm, ct)) End Function '设置串口读写缓冲区大小 Function SetCommBuffer(ByVal hComm As Long, Optional ByVal dwBytesRead As Long = 1024, _ Optional ByVal dwBytesWrite As Long = 512) As Boolean If hComm = 0 Then Exit Function SetCommBuffer = CBool(SetupComm(hComm, dwBytesRead, dwBytesWrite)) End Function '清空串口缓冲区 Sub ClearComm(ByVal hComm As Long, Optional ByVal InBuffer As Boolean = True, Optional ByVal OutBuffer As Boolean = True) If hComm = 0 Then Exit Sub If InBuffer And OutBuffer Then '清空输入输出缓冲区 PurgeComm hComm, PURGE_TXABORT Or PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR ElseIf InBuffer Then '清空输入缓冲区 PurgeComm hComm, PURGE_RXABORT Or PURGE_RXCLEAR ElseIf OutBuffer Then '清空输出缓冲区 PurgeComm hComm, PURGE_TXABORT Or PURGE_TXCLEAR End If End Sub '辅助函数:BSTR字符串转换为CHAR字符串 Function StringToBytes(ByVal szText As String) As Byte() If Len(szText) > 0 Then StringToBytes = StrConv(szText, vbFromUnicode) End If End Function '辅助函数:CHAR字符串转换为BSTR字符串 Function BytesToString(bytesText() As Byte) As String If SafeArrayGetDim(bytesText) <> 0 Then BytesToString = StrConv(bytesText, vbUnicode) End If End Function '辅助函数:获得CHAR字符串长度 Function Byteslen(bytesText() As Byte) As Long If SafeArrayGetDim(bytesText) <> 0 Then Byteslen = UBound(bytesText) + 1 End If End Function
|