modmain.bas

com口接收数剧的源码程序,接收来自scanner的信号

Attribute VB_Name = "ModMain"
Option Explicit

Const CurrContainer As String = "modFisApi"
Public objServer As New FisApiServer
Public objSession As FisSession
Public MyErr As FisError
Public InOpn As String

Public Sub SendPassEvent(ByVal Serial As String, ByVal Oper As String, ByVal InStatus As Long)

    Dim ret, i, r As Long
    Dim str, gpPartNum As String
                                 
    gpPartNum = "9T6000-000"
                     
    'Creates a Fis Active Session.
    Set objSession = objServer.fisSessions
    
    ' Verify the session was created properly
    If (objSession Is Nothing) Then
        Screen.MousePointer = 0
        MsgBox ("Fail to create FIS Active Session")
        Unload FrmMain
    Else
        
        objSession.enableOnError (True)
        Set MyErr = objSession.Error
        
        On Error GoTo errHandler
   
        'Start - use all default event data
        ret = objSession.start(Serial, Oper)
        objSession.PartNumber = gpPartNum
        objSession.EventStatus = InStatus
        If ret <> 0 Then GoTo errHandler
    
        'Add Attributes
        ret = objSession.Attribute("PART_NUM", "9T6000-000")
        ret = objSession.Attribute("MODEL_NUM", "ST500")
        ret = objSession.Attribute("RIM_TYPE", "T2-500")
                           
        'Send Info
        ret = objSession.send
        If ret <> 0 Then GoTo errHandler
        
        'Save PutRun to File
        'ret = objSession.save("AttributePosRun.txt")
        'If ret <> 0 Then GoTo errHandler
        'End If
                    
        'Close this FisSession
        objSession.closeSession
        
        MsgBox ("Event Updated..... " & Serial)
    
    End If
      
    Set objSession = Nothing
    
    Exit Sub

errHandler:
                   
    str = str + "Start Error Descrip: " + MyErr.Description
    str = str + " Category: " + MyErr.Category
    str = str + " Source: " + MyErr.Source
    str = str + " Code: " + CStr(MyErr.ErrorCode)
    MsgBox str

End Sub


Public Function CheckProcQual(ByVal Serial As String, ByVal Oper As String) As Qualify

    Dim ret, i As Long
    Dim str, gpPartNum As String
    Dim QualResult As Qualify
                                  
    gpPartNum = "9T6000-000"
                     
    'Creates a Fis Active Session.
    Set objSession = objServer.fisSessions
    
    ' Verify the session was created properly
    If (objSession Is Nothing) Then
        MsgBox ("Fail to create FIS Active Session")
        Unload FrmMain
    Else
        
        objSession.enableOnError (True)
        Set MyErr = objSession.Error
        
        On Error GoTo errHandler
   
        'Start - use all default event data
        ret = objSession.start(Serial, Oper)
        objSession.PartNumber = gpPartNum
        If ret <> 0 Then GoTo errHandler
        
        Set QualResult = objSession.processQualify
                        
        Set CheckProcQual = QualResult
        
        Set QualResult = Nothing
                            
        'Close this FisSession
        objSession.closeSession
    
    End If
    Set objSession = Nothing
    
    Exit Function

errHandler:
     
    str = str + "Start Error Descrip: " + MyErr.Description
    str = str + " Category: " + MyErr.Category
    str = str + " Source: " + MyErr.Source
    str = str + " Code: " + CStr(MyErr.ErrorCode)
End Function
Public Sub Read_GPSvr(ByVal IniFile As String)
On Error GoTo Err_ReadGPSvr

Dim fNum, LenInStr, PosEqual As Integer
Dim FName, SLine, ValName, Value, InStrLine As String

    FrmMain.lblAgt1.Caption = ""
    FrmMain.lblAgt2.Caption = ""
    fNum = 100
    FName = IniFile
    Open FName For Input As #fNum

    Do While Not EOF(fNum)
        Line Input #fNum, SLine
        InStrLine = UCase(SLine)
        If InStr(InStrLine, "PRIMARYAGENT") <> 0 Then
            If InStr(InStrLine, "PRIMARYAGENTPORT") = 0 Then
                LenInStr = Len(InStrLine)
                PosEqual = InStr(InStrLine, "=")
                FrmMain.lblAgt1.Caption = Mid(InStrLine, (PosEqual + 1), (LenInStr - PosEqual + 1))
            End If
        End If
        If InStr(InStrLine, "SECONDARYAGENT") <> 0 Then
            If InStr(InStrLine, "SECONDARYAGENTPORT") = 0 Then
                LenInStr = Len(InStrLine)
                PosEqual = InStr(InStrLine, "=")
                FrmMain.lblAgt2.Caption = Mid(InStrLine, (PosEqual + 1), (LenInStr - PosEqual + 1))
            End If
        End If
    Loop
    
    Close #fNum
        
    Exit Sub
    
Err_ReadGPSvr:
End Sub
Public Function Read_IniGPSvr(ByVal IniFile As String, ByVal ChkInStr As String) As String
On Error GoTo Err_ReadIniGPSvr

Dim fNum, LenInStr, PosEqual As Integer
Dim FName, SLine, ValName, Value, InStrLine As String

    fNum = 100
    FName = IniFile
    Open FName For Input As #fNum

    Do While Not EOF(fNum)
        Line Input #fNum, SLine
        InStrLine = UCase(SLine)
        If InStr(InStrLine, "[CONFIG]") <> 0 Then
            Do While Not EOF(fNum)
                Line Input #fNum, SLine
                InStrLine = UCase(SLine)
                
                If InStr(InStrLine, ChkInStr) <> 0 Then
                    LenInStr = Len(InStrLine)
                    PosEqual = InStr(InStrLine, "=")
                    ValName = Mid(InStrLine, 1, LenInStr - (LenInStr - PosEqual + 1))
                    Value = Mid(InStrLine, (PosEqual + 1), (LenInStr - PosEqual + 1))
                End If
            Loop
        End If
    Loop
    
    Close #fNum
    Read_IniGPSvr = Value
    Exit Function
    
Err_ReadIniGPSvr:
    Read_IniGPSvr = ""
End Function