frmmain.frm

瑞立德门禁控制器VB源程 4门网络控制器 产品级源程

        End If
    Else
        ' 关闭辅助电锁输出，Output代码为0
        intret = M8_SetOutput(nIP, nDoorAddr, 0, 2)
    End If
    
    If intret = -1 Then
        MsgBox "成功操作"
    Else
        MsgBox "失败" & CStr(intret), vbCritical
    End If
    
End Sub

Private Sub cmdOpenDoor_Click()
    
    Dim intret As Integer
    Dim nDoorAddr As Byte
    
    nDoorAddr = CInt(Me.cmbDoorAddr3.Text)
    
    intret = M8_OpenDoor(nIP, nDoorAddr)
    
    If intret = -1 Then
        MsgBox "成功打开"
    Else
        MsgBox "失败" & CStr(intret), vbCritical
    End If
    
End Sub

Private Sub cmdSearchDC_Click()
    Dim nDCSN(7) As Long
    Dim nDCAddrs(7) As Byte
    Dim nRealCount As Byte
    Dim intret As Integer
    
    intret = M8_SearchDoorCtrls(nIP, nDCSN(0), nDCAddrs(0), 8, nRealCount)
    If intret = -1 Then
        MsgBox "成功！找到" & CStr(nRealCount) & "个读卡器接口，第一个读卡器接口的序列号为：" & CStr(nDCSN(0))
        Me.txtDCSN.Text = CStr(nDCSN(0))
    Else
        MsgBox "失败，返回码：" & CStr(intret), vbCritical, "Error!"
    End If
End Sub

Private Sub cmdSearchIP_Click()
    
    Dim IntIP(14) As Long
    Dim intCount As Integer
    Dim intRealCount As Integer
    Dim intret As Integer
    Dim strIP As String
    Dim MacAddr(14) As TYPEMAC
    
    intCount = 15
    
    intret = M8_SearchEventServers(IntIP(0), MacAddr(0), intCount, intRealCount)
    
    If intret = -1 Then
        MsgBox "成功，找到" & CStr(intRealCount) & "个控制器"
        MsgBox IntIPToStrIP(IntIP(0))
        nIP = IntIP(0)
        Me.txtCtrlIP.Text = IntIPToStrIP(IntIP(0))
        nCommPwd = 88888888
        Me.txtCommPwd.Text = CStr(nCommPwd)
    Else
        MsgBox "搜索失败！返回：" & CStr(intret)
    End If
    
End Sub

Private Sub cDecToHex(ByVal dblConvert As Double, ByRef strResult As String)
    
    Dim i As Integer
    
    strResult = Hex(dblConvert - (Int(dblConvert / 16) * 16)) & strResult
    dblConvert = Int(dblConvert / 16)
    If dblConvert >= 16 Then
        Call cDecToHex(dblConvert, strResult)
    ElseIf dblConvert <> 0 Then
        strResult = Hex(dblConvert) & strResult
    End If
    
    If Len(strResult) > 8 Then
        strResult = Right(strResult, 8)
    ElseIf Len(strResult) < 8 Then
        For i = Len(strResult) To 7
            strResult = "0" & strResult
        Next
    End If
    
End Sub

Private Sub cmdSetAccessLevel_Click()
    
    Dim intret As Integer
    Dim nDoorAddr As Integer
    Dim i As Integer
    
    Dim pAccessLevel As TYPEACCESSLEVEL
    
    nDoorAddr = CInt(Me.cmbDoorAddr.Text)
    
    pAccessLevel.nLevelID = CInt(Me.txtLevelID.Text)
    pAccessLevel.nHolidayFlag = 1     ' 不需要节假日时将其设置为1
    
    pAccessLevel.nOperation = 1
    pAccessLevel.nOperationMask = 1
    
    For i = 0 To 9
        pAccessLevel.nTimezoneID(i) = CInt(Me.txtAccessLevelTZID(i).Text)
    Next
    
    intret = M8_SetPurview(nIP, nDoorAddr, pAccessLevel)
    
    If intret <> -1 Then
        MsgBox "Fail, Return Code:" & CStr(intret), vbCritical, "Error!"
    Else
        MsgBox "成功"
    End If
    
End Sub

Private Sub cmdSetCard_Click()
    
    Dim intret As Integer
    Dim pCard As TYPECARD
    Dim nCount As Long
    Dim nRealCount As Long
    
    pCard.nAccessLevelID = CLng(Me.txtCardLevelID.Text)
    pCard.nAPB = 0
    pCard.nReserve1 = 0
    pCard.nReserve2 = 0
    pCard.nPassword(0) = 0
    pCard.nPassword(1) = 0
    pCard.nNumber = CLng(Me.txtCardNumber.Text)
    pCard.nExpireYear = CInt(Right(Format(Me.DTPicker1.Value, "yyyy"), 2))
    pCard.nExpireMonth = CInt(Right(Format(Me.DTPicker1.Value, "yyyy-mm"), 2))
    pCard.nExpireDay = CInt(Right(Format(Me.DTPicker1.Value, "yyyy-mm-dd"), 2))
    nCount = 1
    
    intret = M8_SetGeneralCards(nIP, pCard, nCount, nRealCount)
    
    If intret <> -1 Then
        MsgBox "Fail: Return Code:" & CStr(intret), vbCritical, "Error!"
    Else
        MsgBox "成功"
    End If
    
End Sub

Private Sub cmdSetTimeOut_Click()
    
    If M8_SetTimeout(100, 3000) = -1 Then
        MsgBox "OK!"
    Else
        MsgBox "Failed", vbCritical, "Error!"
    End If
    
End Sub

Private Sub cmdSetDoorCtrl_Click()
        
    Dim intret As Integer
    Dim pDoorCtrl As TYPEDC
    
    ' 将该读卡器接口信息保存到控制器中 （以记录形式）
    With pDoorCtrl
        .nID = CLng(Me.txtDCSN.Text)
        .nAddr = CInt(Me.cmbDoorAddr4.Text)
        .nOutReaderType = 1
        .nInReaderType = 1
        .nOutLedPolar = 1
        .nInLedPolar = 1
        .nLockType = 1
        .bCheckReader = 0
        .bFirstCardOpen = 0
        .bCheckSensor = 0
        .nState = 1
        .nHolidayState = 1
        .bAutoMode = 1
        .nCountCard = 1
        .nTimeOfDelay = 6
        .nTimeOfAlert = 10
        '缺省胁迫密码为9999 （&H 270F）
        .nForceCode(0) = 15
        .nForceCode(1) = 39
        '缺省超级密码为88888888 （&H ）
        .nSuperPassword(0) = 56
        .nSuperPassword(1) = 86
        .nSuperPassword(2) = 76
        .nSuperPassword(3) = 5
        .bEnableSuperPwd = 1
        .nAPBType = 0
        .nOutArea = 0
        .nInArea = 0
        .nInterLocked = 0
    End With
        
    intret = M8_SetDoorCtrl(nIP, pDoorCtrl)
    
    If intret = -1 Then
        MsgBox "成功设置读卡器接口！"
    Else
        MsgBox "设置读卡器接口失败，返回值：" & CStr(intret), vbCritical, "Error!"
    End If

End Sub

Private Sub cmdSetIPAddr_Click()
    
    Dim intret As Integer
    Dim pEvent As TYPECTRL
    
    Dim nNewIP As Long
    
    nNewIP = StrIPToIntIP(Me.txtIPAddr.Text)
    
    pEvent.nIP = nIP
    
    intret = M8_GetEventServer(pEvent)
    
    If intret = -1 Then
        pEvent.nIP = nNewIP
        intret = M8_SetEventServer(nIP, pEvent)
        If intret = -1 Then
            intret = M8_DisconnectEventServer(nIP)
            If intret = -1 Then
                intret = M8_ConnectToEventServer(nNewIP, nCommPwd)
                If intret = -1 Then
                    nIP = nNewIP
                    MsgBox "修改IP成功，并已经重新连接", vbInformation
                Else
                    MsgBox "修改IP成功，但重新连接失败！", vbCritical
                End If
            Else
                MsgBox "修改IP成功，但尝试重新连接时失败！", vbCritical
            End If
        Else
            MsgBox "修改IP失败！返回值：" & CStr(intret), vbCritical
        End If
    Else
        MsgBox "失败！返回值：" & CStr(intret), vbCritical, "Error!"
    End If
    
End Sub

Private Sub cmdSetRelayTime_Click()
    
    Dim pDoorCtrl As TYPEDC
    Dim intret As Integer
    
    pDoorCtrl.nAddr = CInt(Me.cmbDoorAddr2.Text)
    intret = M8_GetDoorCtrl(nIP, pDoorCtrl)
    
    If intret = -1 Then
        pDoorCtrl.nTimeOfDelay = CInt(Me.txtRelayTime.Text)
        intret = M8_SetDoorCtrl(nIP, pDoorCtrl)
        If intret = -1 Then
            MsgBox "成功设置"
        Else
            MsgBox "失败，返回：" & CStr(intret), vbCritical, "Error!"
        End If
    Else
        MsgBox "获取读卡器接口失败，返回值：" & CStr(intret), vbCritical, "Error!"
    End If
    
End Sub

Private Sub cmdSetTime_Click()
    
    Dim intret As Integer
    Dim pTime As TYPETIME
    
    pTime.nYear = CInt(Right(Left(Format(Date, "yyyy-mm-dd"), 4), 2))
    pTime.nMonth = CInt(Right(Format(Date, "yyyy-mm"), 2))
    pTime.nDay = CInt(Right(Format(Date, "yyyy-mm-dd"), 2))
    pTime.nHour = CInt(Left(Format(Now, "hh:mm"), 2))
    pTime.nMinute = CInt(Right(Format(Now, "hh:mm"), 2))
    pTime.nSec = CInt(Right(Format(Now, "hh:mm:ss"), 2))
    pTime.nWeek = Weekday(Now) - 1
        
    intret = M8_SetTime(nIP, pTime)
    
    If intret <> -1 Then
        MsgBox "Fail: Return Code:" & CStr(intret), vbCritical, "Error!"
    Else
        MsgBox "成功"
    End If

End Sub

Private Sub cmdSetTimezone_Click()
    
    Dim intret As Integer
    Dim pTimezone As TYPETIMEZONE
    
    Dim intWeek As Integer
    
    pTimezone.nTZID = CInt(Me.txtTimezoneID.Text)
    pTimezone.nFlag = 1   ' 在 RALID-TCP控制器中，这个标志设置为1
    
    pTimezone.StartTime.nYear = CInt(Right(Format(Me.dtpStartTime.Value, "yyyy"), 2))
    pTimezone.StartTime.nMonth = CInt(Right(Format(Me.dtpStartTime.Value, "yyyy-mm"), 2))
    pTimezone.StartTime.nDay = CInt(Right(Format(Me.dtpStartTime.Value, "yyyy-mm-dd"), 2))
    
    pTimezone.StartTime.nHour = CInt(Left(Format(Me.dtpStartTime.Value, "hh:mm:ss"), 2))
    pTimezone.StartTime.nMinute = CInt(Right(Format(Me.dtpStartTime.Value, "hh:mm"), 2))
    pTimezone.StartTime.nSec = CInt(Right(Format(Me.dtpStartTime.Value, "hh:mm:ss"), 2))
    
    intWeek = 0
    For i = 0 To 6
        intWeek = intWeek + IIf(Me.chkWeekDay(i).Value = 1, 2 ^ i, 0)
    Next
    
    pTimezone.StartTime.nWeek = intWeek
    
    pTimezone.EndTime.nYear = CInt(Right(Format(Me.dtpEndTime.Value, "yyyy"), 2))
    pTimezone.EndTime.nMonth = CInt(Right(Format(Me.dtpEndTime.Value, "yyyy-mm"), 2))
    pTimezone.EndTime.nDay = CInt(Right(Format(Me.dtpEndTime.Value, "yyyy-mm-dd"), 2))
    
    pTimezone.EndTime.nHour = CInt(Left(Format(Me.dtpEndTime.Value, "hh:mm:ss"), 2))
    pTimezone.EndTime.nMinute = CInt(Right(Format(Me.dtpEndTime.Value, "hh:mm"), 2))
    pTimezone.EndTime.nSec = CInt(Right(Format(Me.dtpEndTime.Value, "hh:mm:ss"), 2))
    
    pTimezone.nTimeMask = 128 + IIf(Me.chkCheckDay.Value = 1, 104, 0) + IIf(Me.chkCheckWeek.Value = 1, 16, 0) + IIf(Me.chkCheckTime.Value = 1, 7, 0)
    
    intret = M8_SetTimePeriod(nIP, pTimezone)
    
    If intret <> -1 Then
        MsgBox "Fail, Return Code:" & CStr(intret), vbCritical, "Error!"
    Else
        MsgBox "成功"
    End If
    
End Sub

Private Sub Form_Load()
    nIP = StrIPToIntIP(Me.txtCtrlIP.Text)
    nCommPwd = CLng(Me.txtCommPwd.Text)
    Me.cmbDoorAddr.Text = "1"
    Me.cmbDoorAddr2.Text = "1"
    Me.cmbDoorAddr3.Text = "1"
    Me.cmbDoorAddr4.Text = "1"
    Me.cmbDoorAddr5.Text = "1"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    Dim intret As Integer
    
    intret = M8_DisconnectEventServer(nIP)
    
End Sub

Private Sub tmrGetEvent_Timer()
    
    Call cmdGetEvents_Click
    
End Sub