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