基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：78630559

本次赞助数额为： 2 元　

支付宝支付

微信支付

   源码介绍

---

'屏蔽主窗体的关闭按钮
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Const MF_BYPOSITION = &H1000&
Private Const SC_CLOSE = &HF060 '关闭
Private Const SC_MAXIMIZE = &HF030 '最大化
Private Const SC_MINIMIZE = &HF020 '最小化

Private Const NET_DVR_SET_TIMECFG As Long = 119     '设置DVR时间
Private Time As LPNET_DVR_TIME

Private bInited, bout As Boolean
Private hLoginId, hMonitorId, hMonitorId1 As Long
Private devInfo As NET_DVR_DEVICEINFO_V30
Private clientInfo As NET_DVR_CLIENTINFO
Private clientInfo1 As NET_DVR_CLIENTINFO
Public lVoiceHanle As Long



Private Sub Command1_Click()
    Time.dwYear = Mid(ChkTime.Text, 1, 4) ' 2009
    Time.dwMonth = Mid(ChkTime.Text, 6, 2) '7
    Time.dwDay = Mid(ChkTime.Text, 9, 2) '20
    Time.dwHour = Mid(ChkTime.Text, 12, 2) '9
    Time.dwMinute = Mid(ChkTime.Text, 15, 2) '38
    Time.dwSecond = Mid(ChkTime.Text, 18, 2) ' 0
    bSucc = NET_DVR_SetDVRConfig(hLoginId, NET_DVR_SET_TIMECFG, 0, Time, LenB(Time))
End Sub

Private Sub Command9_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 21, 0, 3)
End Sub

Private Sub Command9_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 21, 1, 3)
End Sub

Private Sub Command10_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 22, 0, 3)
End Sub

Private Sub Command10_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 22, 1, 3)
End Sub

Private Sub Command11_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 23, 0, 3)
End Sub

Private Sub Command11_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 23, 1, 3)
End Sub

Private Sub Command12_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 24, 0, 3)
End Sub

Private Sub Command12_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 24, 1, 3)
End Sub

Private Sub Command13_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 11, 0, 3)
End Sub

Private Sub Command13_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 11, 1, 3)
End Sub

Private Sub Command14_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 12, 0, 3)
End Sub

Private Sub Command14_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 12, 1, 3)
End Sub


Private Sub Command15_Click()
    lVoiceHanle = NET_DVR_StartVoiceCom_V30(hLoginId1, 1, 1, 0, 0)
    Command15.Caption = lVoiceHanle
End Sub

Private Sub Command16_Click()
    Dim aa As Long
    aa = NET_DVR_StopVoiceCom(lVoiceHanle)
    Command16.Caption = aa
End Sub

Private Sub Command7_Click()
    Dim str As String
    str = BrowseForFolder(hwnd, "请选择抓图目录.")
    If str <> "" Then
        Dim strLast As String
        strLast = Right(str, 1)
        If strLast <> "\" Then
            Text1.Text = str   "\"
        Else
            Text1.Text = str
        End If
    End If
End Sub

Private Sub Command8_Click()
    '抓图
    Dim jg As Boolean
    Dim bl As LPNET_DVR_JPEGPARA
    Dim mypath As String
    Dim filename As String
    
    bl.wPicSize = 0
    bl.wPicQuality = 0
    
    jg = False

    mypath = Text1.Text
    If Trim(mypath) = "" Then
        mypath = App.Path   "\"
    End If
    
    
        If (hLoginId < 0) Then
            MsgBox "没有登录", vbInformation, "提示"
            Exit Sub
        Else
            filename = mypath   "text1.jpg"
'            jg = NET_DVR_CapturePicture(hMonitorId, "c:\test1.bmp")                '保存成.bmp文件
            jg = NET_DVR_CaptureJPEGPicture(hLoginId, 1, bl, filename)             '保存成.jpg文件
            GoTo exit1
        End If


exit1:
    
    If (jg = False) Then
        MsgBox "抓图失败", vbInformation, "提示"
    Else
        MsgBox "抓图成功", vbInformation, "提示"
    End If
    

End Sub





Private Sub Form_Load() '窗体加载
 
On Error GoTo loaderror

RemoveMenu GetSystemMenu(Me.hwnd, 0), SC_CLOSE, MF_BYPOSITION '关闭按钮不可用
bInited = False
bout = False
hLoginId = -1
hMonitorId = -1
devIP.Text = "10.28.9.152"
devPort.Text = "8000"
devName.Text = "abc"
devPwd.Text = "123"
devCH.Text = "1"


Exit Sub

loaderror:
MsgBox "系统出错1"

End Sub


Private Sub Command4_Click() '登陆

On Error GoTo loaderror

If devIP.Text = "" Then

   MsgBox "请输入IP"
   devIP.SetFocus
   Exit Sub
   
End If

If devPort.Text = "" Then

   MsgBox "请输入端口"
  devPort.SetFocus
   Exit Sub
   
End If

If devName.Text = "" Then

   MsgBox "请输入用户名"
   devName.SetFocus
   Exit Sub
   
End If

If devCH.Text = "" Then

   MsgBox "请输入通道号"
   devCH.SetFocus
   Exit Sub
   
End If
   

bInited = NET_DVR_Init() '初始化SDK

On Error Resume Next

If (bInited = False) Then
    MsgBox "初始化失败"
    Exit Sub
End If
    hLoginId = NET_DVR_Login_V30(devIP.Text, devPort.Text, devName.Text, devPwd.Text, devInfo)     '用户注册
         
If (hLoginId = -1) Then
    MsgBox "登陆失败"
    Exit Sub
End If

Text4.Text = hLoginId
MsgBox "登陆成功"

Exit Sub

loaderror:
MsgBox "系统出错2"
   
End Sub


Private Sub Command5_Click() '注销

On Error Resume Next

If hMonitorId > -1 Then
    Call NET_DVR_StopRealPlay(hMonitorId)
    hLoginId = -1
    Picture1.Refresh
End If

 If hLoginId > -1 Then
    bout = NET_DVR_Logout(hLoginId)
    hLoginId = -1
    Call NET_DVR_Cleanup
End If

If bout = False Then
    MsgBox "注销设备失败"
    Exit Sub
End If

MsgBox "注销设备成功"

End Sub

Private Sub Command6_Click() '预览

On Error Resume Next

If (hMonitorId > -1) Then
    Call NET_DVR_StopRealPlay(hMonitorId)
    Call NET_DVR_StopRealPlay(hMonitorId1)
    
    hMonitorId = -1
    hMonitorId1 = -1
    Picture1.Refresh
    Picture2.Refresh
End If
 Picture1.Refresh
If (hLoginId > -1) Then  '已经登录
    clientInfo.lChannel = 1 'Val(devCH)    '通道号
    clientInfo.lLinkMode = 0    '最高位(31)为0表示主码流，为1表示子，0－30位表示码流连接方式: 0：TCP方式,1：UDP方式,2：多播方式,3 - RTP方式，4-音视频分开(TCP)
    clientInfo.hPlayWnd = Picture1.hwnd '播放窗口的句柄,为NULL表示不播放图象
    clientInfo.sMultiCastIP = 0 '多播组地址
    hMonitorId = NET_DVR_RealPlay_V30(hLoginId, clientInfo, 0, 0, 0)   '实时预览
    
  '  hMonitorId = NET_DVR_RealPlay_V30(hLoginId, clientInfo, PtrToLong(AddressOf REALDATACALLBACK), 0, True)   '实时预览
 
    clientInfo1.lChannel = 2 'Val(devCH)    '通道号
    clientInfo1.lLinkMode = 0    '最高位(31)为0表示主码流，为1表示子，0－30位表示码流连接方式: 0：TCP方式,1：UDP方式,2：多播方式,3 - RTP方式，4-音视频分开(TCP)
    clientInfo1.hPlayWnd = Picture2.hwnd '播放窗口的句柄,为NULL表示不播放图象
    clientInfo1.sMultiCastIP = 0 '多播组地址
    hMonitorId1 = NET_DVR_RealPlay_V30(hLoginId, clientInfo1, 0, 0, 0)    '实时预览
    
    
    
    
    Debug.Print hMonitorId

    Debug.Print hMonitorId1


End If
'Picture1.Refresh



If (hMonitorId = -1) Then
    MsgBox "实时预览失败"
    Exit Sub
End If

End Sub


Private Sub Command3_Click() '停止预览

On Error Resume Next

If hMonitorId > -1 Then
    Debug.Print "hello"
    Debug.Print hMonitorId
    Call NET_DVR_StopRealPlay(hMonitorId)
    Call NET_DVR_StopRealPlay(hMonitorId1)
    hMonitorId = -1
    hMonitorId1 = -1
    Picture1.Refresh
    Picture2.Refresh
End If

End Sub



Private Sub Command2_Click() '退出

On Error Resume Next
If lVoiceHanle > 0 Then
    aa = NET_DVR_StopVoiceCom(lVoiceHanle)
End If
If hMonitorId > -1 Then
    Call NET_DVR_StopRealPlay(hMonitorId)
    Call NET_DVR_StopRealPlay(hMonitorId1)
    hMonitorId = -1
    Picture1.Refresh
End If

 If hLoginId > -1 Then
    Call NET_DVR_Logout(hLoginId)
    hLoginId = -1
    Call NET_DVR_Cleanup
End If

End

End Sub


Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
If lVoiceHanle > 0 Then
    aa = NET_DVR_StopVoiceCom(lVoiceHanle)
End If
If hMonitorId > -1 Then
    Call NET_DVR_StopRealPlay(hMonitorId)
    hMonitorId = -1
    Picture1.Refresh
End If

 If hLoginId > -1 Then
    Call NET_DVR_Logout(hLoginId)
    hLoginId = -1
    Call NET_DVR_Cleanup
End If

End
End Sub