📄 cancelicclient.frm
字号:
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4080
TabIndex = 12
Top = 1560
Width = 975
End
Begin VB.Label Label7
Caption = "终止时间"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 11
Top = 2760
Width = 975
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "起始时间"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 10
Top = 2160
Width = 975
End
End
Attribute VB_Name = "FrmCancelClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ls As Recordset
Sub Init_Win(pReadCancel As String) '注销和读卡共用
If StrComp(pReadCancel, "Cancel", vbTextCompare) = 0 Then
CmdAccept.Visible = True
Caption = "注销客人卡"
Else
CmdAccept.Visible = False
Caption = "读取客人卡"
End If
LblHeader.Caption = Caption
End Sub
Private Sub Timer1_Timer()
Dim sTmp As String
Dim iTmp As Integer
Dim bReturn As Byte
sTmp = ""
II = FrmMain.MSCommIC.Input 'clear read buffer
FrmMain.MSCommIC.Output = Chr(&HA) & Chr(&HC) & Chr(&HF)
bReturn = DelaySecond(DelaySecondConst + 2) '延时间
If bReturn <> 0 Then
Select Case bReturn
Case &H1C
sTmp = "新卡"
TxtICNumber.Text = ""
Case &H1D
sTmp = "非法卡,请插卡"
TxtICNumber.Text = ""
Case &H1E
sTmp = "卡损坏,请插卡"
TxtICNumber.Text = ""
Case &H1F
sTmp = "无卡,请插卡"
TxtICNumber.Text = ""
Case &H1, &H2, &H3, &H4, &H5, &H6, &H7, &H8, &H9, &HA, &HB, &HC, &HD
sICType = CodeToIC((bReturn))
If StrComp(sICType, "客人卡", vbTextCompare) = 0 Then
iTmp = gReceiveBuffer.SendBuffer_Array(3) + gReceiveBuffer.SendBuffer_Array(2) * 256 '此位置写卡号
sTmp = "客人卡！"
TxtICNumber.Text = Right("00000000" & iTmp, 6)
TEXTABC.Text = TxtICNumber
Else
sTmp = "非客人卡，请插入客人卡！"
TxtICNumber.Text = ""
End If
Case Else
sTmp = "无卡,请插卡！"
TxtICNumber.Text = ""
End Select
Else
sTmp = "无卡,请插卡！"
End If
PicMSG.Cls
PicMSG.Print sTmp
End Sub
Private Sub Timer2_Timer()
Dim sTmp As String
Dim iTmp As Integer
Dim bReturn As Byte
sTmp = ""
II = FrmMain.MSCommIC.Input 'clear read buffer
FrmMain.MSCommIC.Output = Chr(&HA) & Chr(&HC) & Chr(&HF)
bReturn = DelaySecond(DelaySecondConst + 2) '延时间
If bReturn <> 0 Then
Select Case bReturn
Case &H1C
sTmp = "新卡"
TxtICNumber.Text = ""
Case &H1D
sTmp = "非法卡,请插卡"
TxtICNumber.Text = ""
Case &H1E
sTmp = "卡损坏,请插卡"
TxtICNumber.Text = ""
Case &H1F
sTmp = "无卡,请插卡"
TxtICNumber.Text = ""
Case &H1, &H2, &H3, &H4, &H5, &H6, &H7, &H8, &H9, &HA, &HB, &HC, &HD
sICType = CodeToIC((bReturn))
If StrComp(sICType, "客人卡", vbTextCompare) = 0 Then
iTmp = gReceiveBuffer.SendBuffer_Array(3) + gReceiveBuffer.SendBuffer_Array(2) * 256 '此位置写卡号
sTmp = "客人卡！"
TxtICNumber.Text = Right("00000000" & iTmp, 6)
Else
sTmp = "非客人卡，请插入客人卡！"
TxtICNumber.Text = ""
End If
Case Else
sTmp = "无卡,请插卡！"
TxtICNumber.Text = ""
End Select
Else
sTmp = "无卡,请插卡！"
End If
PicMSG.Cls
PicMSG.Print sTmp
End Sub
Private Sub TxtICNumber_Change()
If Val(TxtICNumber.Text) = 0 Then
CmdAccept.Enabled = False
ClearClientICMSG
Else
' If Not ICHavePutOut(TxtICNumber.Text) Then '该已经IC发行True
' CmdAccept.Enabled = False
' MsgBox "该IC已经注销", vbInformation + vbOKOnly, "提示"
'Else
CmdAccept.Enabled = True
sTmp = GetClientICMSG(TxtICNumber.Text)
'End If
End If
End Sub
Private Sub CmdAccept_Click()
Dim sTmp As String
Timer1.Enabled = False
If CancelIC Then '对卡注销成功
CmdAccept = False
sTmp = "注销成功！"
gICProperty.ICNumber = TxtICNumber.Text
gICProperty.CancelReason = "有卡注销"
gICProperty.OperatorCancel = gUserName
gICProperty.CancelSDate = "" & Year(Date) & "年" & Right("00" & Month(Date), 2) & "月" & Right("00" & Day(Date), 2) & "日" & _
Right("00" & Hour(Time), 2) & ":" & Right("00" & Minute(Time), 2) & ":" & Right("00" & Second(Time), 2)
If ICCardCancel("客人卡") Then
Call RC_EventLog_Add("有卡注销客人卡" & TxtICNumber.Text, gUserName, "")
End If
Else
sTmp = "注销失败！"
End If
PicMSG.Cls
PicMSG.Print sTmp
Timer1.Enabled = True
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Function CancelIC() As Boolean
Dim i As Integer
Dim sTmp As String
Dim bReturn As Byte
CancelIC = False
'获得发送信息,写入gSendBuffer内
'0AH+0EH+旧密码（6）+新密码（6）+0CH
gSendBuffer.SendBuffer_Array(0) = &HA
gSendBuffer.SendBuffer_Array(1) = &HE
gSendBuffer.SendBuffer_Array(2) = &HF
gSendBuffer.ArrayLen = 3
For i = 0 To gSendBuffer.ArrayLen - 1
' DelayTimeMills (1)
FrmMain.MSCommIC.Output = Chr(gSendBuffer.SendBuffer_Array(i))
Next
bReturn = DelaySecond(DelaySecondConst * 4) '延时间
If bReturn = &H55 Then 'return 55H success
CancelIC = True
Else
CancelIC = False
End If
End Function
'******************************
' 功能：获得Client IC卡信息，
' 编者：韩国栋
' 时间：2000-03-02
' 参数：pICTypeName 确定发送哪种卡
'******************************
Function GetClientICMSG(pICNumber As String) As String
Dim iTmp As Integer
Dim sTmp, sTmp1, sICTypeName As String
Dim dCheckInDate, dCheckOutDate As Date
'起始年(1)月(1)日(1) 入住时间
i = gReceiveBuffer.SendBuffer_Array(1) And &HF
If i = 1 Then
TxtLoss.Text = "已挂失！"
Else
TxtLoss.Text = "未挂失！"
End If
TxtAccount = gReceiveBuffer.SendBuffer_Array(19) * 256 * 256 + gReceiveBuffer.SendBuffer_Array(20) * 256 + gReceiveBuffer.SendBuffer_Array(21)
sTmp = "" & (gReceiveBuffer.SendBuffer_Array(4) + 2000) & "年" & Right("00" & gReceiveBuffer.SendBuffer_Array(5), 2) & "月" & Right("00" & gReceiveBuffer.SendBuffer_Array(6), 2) & "日"
sTmp = sTmp & Right("00" & gReceiveBuffer.SendBuffer_Array(7), 2) & "时" & Right("00" & gReceiveBuffer.SendBuffer_Array(8), 2) & "分"
TxtCheckInSDate = sTmp
sTmp1 = "" & (gReceiveBuffer.SendBuffer_Array(9) + 2000) & "年" & Right("00" & gReceiveBuffer.SendBuffer_Array(10), 2) & "月" & Right("00" & gReceiveBuffer.SendBuffer_Array(11), 2) & "日"
sTmp1 = sTmp1 & Right("00" & gReceiveBuffer.SendBuffer_Array(12), 2) & "时" & Right("00" & gReceiveBuffer.SendBuffer_Array(14), 2) & "分"
TxtCheckOutSDate = sTmp1
'预住天数
dCheckInDate = Format(sTmp, "yyyy-mm-dd")
dCheckOutDate = Format(sTmp1, "yyyy-mm-dd")
TxtStayDays.Text = DateDiff("d", dCheckInDate, dCheckOutDate)
'楼号（1）+楼层卡(1)+房号卡(1)
TxtShortRoomNumber = Right("00" & gReceiveBuffer.SendBuffer_Array(15), 2) & Right("00" & gReceiveBuffer.SendBuffer_Array(16), 2) & Right("00" & gReceiveBuffer.SendBuffer_Array(17), 2)
'15 栋 16 层 17 房号
TxtAccount = Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(18)), 2) & Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(19)), 2) & Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(20)), 2)
'TEXTABC = TxtICNumber
sTmp = "ICNumber='" & pICNumber & "'"
With RC_Client
If Not (.BOF And .EOF) Then
.MoveFirst
.FindLast sTmp
If .NoMatch Then
Exit Function
End If
Else
Exit Function
End If
TxtStayDays = .Fields("StayDays")
'发卡人
' TxtOperatorCheckIn = .Fields("Operatorout")
'发卡时间
' TxtPutoutSDate = .Fields("PutOutSDate")
'持卡人
TxtName = .Fields("Name")
'持卡人身份证
TxtIDCard = .Fields("IDCard")
'备注
TxtRemark = .Fields("Remark")
End With
Set ls = DB_ICData.OpenRecordset("client", dbOpenDynaset)
GetClientICMSG = ""
End Function
'******************************
' 功能：获得Client IC卡信息，
' 编者：韩国栋
' 时间：2000-03-02
' 参数：pICTypeName 确定发送哪种卡
'******************************
Sub ClearClientICMSG()
TxtCheckInSDate = ""
'预住天数
TxtStayDays.Text = ""
TxtCheckOutSDate = ""
'楼号（1）+楼层卡(1)+房号卡(1)
TxtShortRoomNumber = ""
'发卡人
TxtOperatorOut = ""
'发卡时间
TxtPutoutSDate = ""
'持卡人
TxtName = ""
'持卡人身份证
TxtIDCard = ""
TxtAccount = ""
'备注
TxtRemark = ""
End Sub
Function GetShortRoomNumber(pICNumber As String) As String
Dim sTmp As String
sTmp = "icnumber='" & pICNumber & "' and CancelLog=True"
GetShortRoomNumber = ""
With RC_ICCard
If Not (.BOF And .EOF) Then
.MoveFirst
.FindLast sTmp
If Not .NoMatch Then
GetShortRoomNumber = .Fields("ShortRoomNumber")
End If
End If
End With
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -