📄 modfuntion.bas
字号:
MSComm.Settings = ComPortSpeed & ",S,8,1" '设置通信口参数
ptime = 0.015
zif = 4
stime = Timer
Do While True
If Timer > (stime + ptime) Then
zif = 4
Exit Do
End If
If MSComm.InBufferCount >= 2 Then
Exit Do
End If
DoEvents
Loop
If MSComm.InBufferCount >= 2 Then
For j = 0 To UBound(byt)
av = MSComm.Input
byt(j) = av(0)
Next
If MachineNo = 255 Then
If byt(0) = 0 Then
zif = 8
i = FailResendTimes + 1
Else
zif = 4 '4为找不到机子
End If
Else
If byt(0) = (MachineNo + 1) Then
zif = 8
i = FailResendTimes + 1
Else
zif = 4 '4为找不到机子
End If
End If
Select Case byt(1) '取机器类型 考勤170 门禁187 考勤门禁204 份饭221
Case 170
MachineType = 0
Case 187
MachineType = 1
Case 204
MachineType = 2
Case 221
MachineType = 3
End Select
Else
zif = 4
End If
Else
zif = 8
Sleep (5)
Exit For
End If
Next i 'FailResendTimes '若找不到卡钟，则重发
Else
zif = zif
End If
If zif = 8 Then
FoundMac = 8
Else
FoundMac = zif
End If
Exit Function
ErrorHandler:
FoundMac = 44
End Function
Public Function FoundMacOnly(MSComm As MSComm, ComPortNo As Integer, ComPortSpeed As Long, MachineNo As Integer, FailResendTimes As Integer, Optional MachineType As Integer) As Integer
On Error GoTo ErrorHandler
Dim OutChar(0) As Byte
Dim OutCharS(1) As Byte
Dim av As Variant
Dim byt(1) As Integer
Dim tmpT
If MachineNo > 255 Then
FoundMacOnly = 256
Exit Function
End If
If MSComm.PortOpen = False Then
zif = OpenCom(MSComm, ComPortNo, ComPortSpeed, "M")
End If
If MSComm.PortOpen = True Then
For i = 0 To FailResendTimes '若找不到卡钟，则重发
' If i > 0 Then
' Sleep (10)
' End If
MSComm.InBufferCount = 0
MSComm.OutBufferCount = 0
OutChar(0) = MachineNo
MSComm.Settings = ComPortSpeed & ",M,8,1" '设置通信口参数
MSComm.Output = OutChar
Sleep (2)
If MachineNo < 255 Then
MSComm.Settings = ComPortSpeed & ",S,8,1" '设置通信口参数
ptime = 0.01
zif = 4
stime = Timer
Do While True
If Timer > (stime + ptime) Then
' Stop
zif = 4
Exit Do
End If
If MSComm.InBufferCount >= 2 Then
OutCharS(0) = 1
OutCharS(1) = 2
MSComm.Output = OutChar
Exit Do
End If
DoEvents
Loop
'If MachineNo = 10 Then
'Stop
'End If
If MSComm.InBufferCount >= 2 Then
For j = 0 To UBound(byt)
av = MSComm.Input
byt(j) = av(0)
Next
'If MachineNo = 10 Then
'Stop
'End If
If MachineNo = 255 Then
If byt(0) = 0 Then
zif = 8
i = FailResendTimes + 1
Else
zif = 4 '4为找不到机子
End If
Else
If byt(0) = (MachineNo + 1) Then
zif = 8
i = FailResendTimes + 1
Else
zif = 4 '4为找不到机子
End If
End If
Select Case byt(1) '取机器类型 考勤170 门禁187 考勤门禁204 份饭221
Case 170
MachineType = 0
Case 187
MachineType = 1
Case 204
MachineType = 2
Case 221
MachineType = 3
End Select
Else
zif = 4
End If
Else
zif = 8
Sleep (5)
Exit For
End If
Next i 'FailResendTimes '若找不到卡钟，则重发
Else
zif = zif
End If
If zif = 8 Then
FoundMacOnly = 8
Else
FoundMacOnly = zif
End If
Exit Function
ErrorHandler:
FoundMacOnly = 44
End Function
Public Function SendCmd(MSComm As MSComm, CommandString As String, WaitSeconds As Single, Optional MachineNo As Integer = 255) As Integer
On Error GoTo ErrorHandler
Dim OutChar(1) As Byte
Dim InByt As String
If Val("&H" & CommandString) > 255 Then
SendCmd = 256
Exit Function
End If
For Resend = 0 To 3
MSComm.InBufferCount = 0
MSComm.OutBufferCount = 0
OutChar(0) = "&H" & CommandString
OutChar(1) = "&H" & CommandString
MSComm.Output = OutChar
If MachineNo < 255 Then
ptime = WaitSeconds
zif = 1
stime = Timer
Do While True
If Timer > (stime + ptime) Then
zif = 2
Exit Do
End If
If MSComm.InBufferCount >= 1 Then
Exit Do
End If
DoEvents
Loop
' Debug.Print MSComm.InBufferCount
If MSComm.InBufferCount >= 1 Then
av = MSComm.Input
InByt = Hex(av(0))
If InByt = "CC" Then
zif = 8
Resend = 4
Else
zif = 2
End If
Else
zif = 2
End If
Else
zif = 8
Sleep (5)
Exit For
End If
If Resend > 0 Then
Sleep (10)
End If
Next Resend
SendCmd = zif
' MSComm.InBufferCount = 0
' MSComm.OutBufferCount = 0
Exit Function
ErrorHandler:
SendCmd = 44
End Function
Public Function SendTotalEmployee(MSComm As MSComm, TotalEmployee As Long)
On Error GoTo ErrorHandler
Dim OutChar(2) As Byte
Dim InByt As String
Dim CheckCode As Integer
For Resend = 0 To 3
MSComm.InBufferCount = 0
MSComm.OutBufferCount = 0
OutChar(0) = Fix(TotalEmployee / 100)
OutChar(1) = TotalEmployee Mod 100
CheckCode = 0
For i = 0 To 1
CheckCode = CheckCode + Val(OutChar(i))
Next
OutChar(2) = "&H" & Right(Hex(CheckCode), 2)
MSComm.Output = OutChar
ptime = 0.1
zif = 1
stime = Timer
Do While True
If Timer > (stime + ptime) Then
zif = 2
Exit Do
End If
If MSComm.InBufferCount >= 1 Then
Exit Do
End If
DoEvents
Loop
' Debug.Print MSComm.InBufferCount
If MSComm.InBufferCount >= 1 Then
av = MSComm.Input
InByt = Hex(av(0))
If InByt = "CC" Then
zif = 8
Resend = 4
Else
zif = 2
End If
Else
zif = 2
End If
Next Resend
SendTotalEmployee = zif
Exit Function
ErrorHandler:
SendTotalEmployee = 44
End Function
Public Function ChangeTimeStrToArr(InString As String, OutArray() As String)
On Error GoTo ErrorHandler
Dim i As Integer, j As Integer
Dim tmpArr() As String
InString = Trim(InString)
tmpArr = Split(InString)
If (UBound(tmpArr) Mod 2) = 0 Then
ReDim OutArray((UBound(tmpArr) - 2) / 2, 1)
Else
ReDim OutArray((UBound(tmpArr) - 1) / 2, 1)
End If
For i = 0 To UBound(OutArray)
OutArray(i, 0) = tmpArr(i * 2)
OutArray(i, 1) = tmpArr(i * 2 + 1)
Next
Exit Function
ErrorHandler:
ChangeTimeStrToArr = 44
End Function
Public Function ChangeMsgToArr(Message As String, ChnWord() As String)
On Error GoTo ErrorHandler
Dim i As Integer
Dim WordNo As Integer
Dim NotChnCount As Integer
WordNo = 0
NotChnCount = 0
For i = 0 To UBound(ChnWord)
ChnWord(i) = ""
Next
For i = 1 To Len(Message)
If WordNo < UBound(ChnWord) + 1 Then
If IfChn(Mid(Message, i, 1)) Then
ChnWord(WordNo) = Mid(Message, i, 1)
WordNo = WordNo + 1
ElseIf Mid(Message, i, 1) = Chr(13) Or Mid(Message, i, 1) = Chr(10) Then
NotChnCount = 0
Else
NotChnCount = NotChnCount + 1
If (NotChnCount Mod 2) = 1 Then
WordNo = WordNo + 1
NotChnCount = 1
If WordNo < UBound(ChnWord) + 1 Then
ChnWord(WordNo) = ""
End If
End If
End If
Else
Exit For
End If
Next
Exit Function
ErrorHandler:
ChangeMsgToArr = 44
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -