t_lostresume.bas

停车场源代码。集成了很多功能

Attribute VB_Name = "T_LostResume"
'查找出挂失、恢复后的字符串
Public Function FindLostResume(CLostResume As String, AFalg As String, BFalg As String, Falg As Integer) As String
    Dim ClostH As String
    Dim ClostNO As String
    Dim k As Integer
    ClostH = ""
    ClostNO = ""
    For i = 0 To TAllControlRecord - 1
       If Mid(CLostResume, TComputerControl(i) + 1, 1) = AFalg Then  '所有机号，如果有一个机号没有挂失
          For j = 0 To TRecord - 1                               '本地机号
              If TComputerControl(i) = TcControl(j) Then       '它们的机号相同
                 If Mid(CLostResume, TcControl(j) + 1, 1) = AFalg Then       '本地机号，如果没有挂失
                      If Val(TcControl(j)) = 0 Then                    '本地机号，如果0号机没有挂失
                         ClostH = BFalg & Mid(CLostResume, TComputerControl(i) + 2, 128)
                      Else                                             '本地机号，如果其它机号没有挂失
                         ClostH = Left(CLostResume, TComputerControl(i)) & BFalg & Mid(CLostResume, TComputerControl(i) + 2, 128)
                      End If
                      CLostResume = Left(ClostH, 128)
                 Else
                      TCardsYes = Falg             '已经挂失
                 End If
              End If
          Next j
       Else
         For k = 0 To TRecord - 1
            If TComputerControl(i) = Val(TcControl(k)) Then         '已经挂失、恢复的卡号是否在本计算机上
               TCardsYes = Falg
            End If
         Next k
       End If
    Next i
     FindLostResume = CLostResume
End Function

'检测机号是否已经打开
Public Sub CheckControlOC()
On Error GoTo OpenError
     Cmd.CommandType = adCmdStoredProc
     Cmd.CommandText = "tSystemTableSetup"
     Cmd.Parameters(1) = LoginComputerName
     Set rs = Cmd.Execute
     Do Until rs.EOF
        If Trim(rs(0)) = "1" Then                          '机口存在
           If T_frmMenu.Jsykt_1.OpenEtc_(Val(rs(3)), 4, 20) = "2" Then    '是否联通
              DoEvents
              TCheckControlOC = False
              MsgBox rs(3) & "号机没有打开或者是串口设置错误！", vbCritical, "打开错误"
           End If
         End If
         rs.MoveNext
     Loop
     Set rs = Nothing
Exit Sub
OpenError:
  ' Unload Me
End Sub

'填充网格的数据
Public Sub FillGrid(cntl As Control, IRs As ADODB.Recordset, ParamArray sColumns() As Variant)
On Error GoTo XuErr
    Dim X, Y As Long
    Y = 1
    cntl.Rows = 1
    cntl.Rows = 2
    If IRs.EOF = True And IRs.BOF = True Then Exit Sub
    cntl.Redraw = False
    If (Not IRs.BOF) Then
        Do Until IRs.EOF
            cntl.Row = Y
            For X = 0 To UBound(sColumns)
                With cntl
                    .Col = X + 1
                    .Text = Trim(IRs(CStr(sColumns(X))) & "")
                End With
            Next X
            IRs.MoveNext
            Y = Y + 1
            cntl.Rows = Y + 1
        Loop
    End If
    cntl.Redraw = True
    cntl.Rows = cntl.Rows - 1
    Exit Sub
XuErr:
    MsgBox "Err" & err.Number & err.Description
End Sub

'根据卡的类型找出相应的号码
Function CardModelToCardsON(mStr As String) As String
   Dim SQL As String
   Select Case mStr
          Case "授权卡"
             SQL = "0"
          Case "操作卡"
             SQL = "1"
          Case "月卡"
             SQL = "2"
          Case "储值卡A"
             SQL = "3"
          Case "储值卡B"
             SQL = "4"
          Case "储值卡C"
             SQL = "5"
          Case "临时卡A"
             SQL = "6"
          Case "临时卡B"
             SQL = "7"
          Case "临时卡C"
             SQL = "8"
          Case "免费卡"
             SQL = "9"
   End Select
   CardModelToCardsON = SQL
End Function


'查找IC卡类型
Function FindInCarModel(strNo As String) As String
    Dim cStrModel As String
    Select Case Right(Trim(strNo), 1)
           Case "0"
                cStrModel = "授权卡"
           Case "1"
                cStrModel = "操作卡"
           Case "2"
                cStrModel = "月卡"
           Case "3"
                cStrModel = "储值卡A"
           Case "4"
                cStrModel = "储值卡B"
           Case "5"
                cStrModel = "储值卡C"
           Case "6"
                cStrModel = "临时卡A"
           Case "7"
                cStrModel = "临时卡B"
           Case "8"
                cStrModel = "临时卡C"
           Case "9"
                cStrModel = "免费卡"
    End Select
    If (pubgm = 1 Or pubgm = 2) And Trim(strNo) = "41" Then cStrModel = "免费卡"
    FindInCarModel = cStrModel
 End Function