www.pudn.com > VBP-HKWS.zip > Form1.frm, change:2014-10-01,size:13501b


VERSION 5.00 
Begin VB.Form Form1  
   BorderStyle     =   1  'Fixed Single 
   Caption         =   "Form1" 
   ClientHeight    =   9990 
   ClientLeft      =   45 
   ClientTop       =   435 
   ClientWidth     =   8355 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   9990 
   ScaleWidth      =   8355 
   StartUpPosition =   3  '窗口缺省 
   Begin VB.CommandButton Command10  
      Caption         =   "录像停止" 
      Height          =   375 
      Left            =   6540 
      TabIndex        =   25 
      Top             =   9540 
      Width           =   1215 
   End 
   Begin VB.CommandButton Command9  
      Caption         =   "录像开始" 
      Height          =   375 
      Left            =   6540 
      TabIndex        =   24 
      Top             =   9120 
      Width           =   1215 
   End 
   Begin VB.CommandButton Command8  
      Caption         =   "抓图" 
      Height          =   375 
      Left            =   5520 
      TabIndex        =   23 
      Top             =   9120 
      Width           =   735 
   End 
   Begin VB.CommandButton Command7  
      Caption         =   "..." 
      Height          =   375 
      Left            =   4560 
      TabIndex        =   22 
      Top             =   9120 
      Width           =   735 
   End 
   Begin VB.TextBox Text1  
      Height          =   375 
      Left            =   1920 
      TabIndex        =   21 
      Text            =   "Text1" 
      Top             =   9120 
      Width           =   2535 
   End 
   Begin VB.TextBox ChkTime  
      Height          =   375 
      Left            =   1800 
      TabIndex        =   18 
      Text            =   "2009-08-26 00:00:00" 
      Top             =   9600 
      Width           =   2175 
   End 
   Begin VB.CommandButton Command1  
      Caption         =   "校时" 
      Height          =   375 
      Left            =   4320 
      TabIndex        =   17 
      Top             =   9600 
      Width           =   1215 
   End 
   Begin VB.CommandButton Command6  
      Caption         =   "开始预览" 
      Height          =   495 
      Left            =   5160 
      TabIndex        =   16 
      Top             =   7440 
      Width           =   1455 
   End 
   Begin VB.CommandButton Command3  
      Caption         =   "停止预览" 
      Height          =   495 
      Left            =   6720 
      TabIndex        =   13 
      Top             =   7440 
      Width           =   1455 
   End 
   Begin VB.TextBox devCH  
      Height          =   375 
      Left            =   6000 
      TabIndex        =   11 
      Text            =   "Text1" 
      Top             =   6840 
      Width           =   2055 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "登录设备" 
      Height          =   2415 
      Left            =   240 
      TabIndex        =   2 
      Top             =   6480 
      Width           =   4695 
      Begin VB.CommandButton Command5  
         Caption         =   "注销" 
         Height          =   615 
         Left            =   3720 
         TabIndex        =   15 
         Top             =   1320 
         Width           =   855 
      End 
      Begin VB.CommandButton Command4  
         Caption         =   "登陆" 
         Height          =   615 
         Left            =   3720 
         TabIndex        =   14 
         Top             =   360 
         Width           =   855 
      End 
      Begin VB.TextBox devPwd  
         Height          =   375 
         IMEMode         =   3  'DISABLE 
         Left            =   1080 
         PasswordChar    =   "*" 
         TabIndex        =   10 
         Text            =   "Text3" 
         Top             =   1680 
         Width           =   2535 
      End 
      Begin VB.TextBox devName  
         Height          =   375 
         Left            =   1080 
         TabIndex        =   9 
         Text            =   "Text3" 
         Top             =   1200 
         Width           =   2535 
      End 
      Begin VB.TextBox devIP  
         Height          =   375 
         Left            =   1080 
         TabIndex        =   8 
         Text            =   "Text3" 
         Top             =   240 
         Width           =   2535 
      End 
      Begin VB.TextBox devPort  
         Height          =   375 
         Left            =   1080 
         TabIndex        =   7 
         Text            =   "Text3" 
         Top             =   720 
         Width           =   2535 
      End 
      Begin VB.Label Label8  
         AutoSize        =   -1  'True 
         Caption         =   "密码" 
         Height          =   195 
         Left            =   360 
         TabIndex        =   6 
         Top             =   1800 
         Width           =   360 
      End 
      Begin VB.Label Label7  
         AutoSize        =   -1  'True 
         Caption         =   "用户名" 
         Height          =   195 
         Left            =   240 
         TabIndex        =   5 
         Top             =   1320 
         Width           =   540 
      End 
      Begin VB.Label Label5  
         AutoSize        =   -1  'True 
         Caption         =   "端口号" 
         Height          =   195 
         Left            =   240 
         TabIndex        =   4 
         Top             =   840 
         Width           =   630 
      End 
      Begin VB.Label Label6  
         AutoSize        =   -1  'True 
         Caption         =   "设备IP" 
         Height          =   195 
         Left            =   240 
         TabIndex        =   3 
         Top             =   360 
         Width           =   510 
      End 
   End 
   Begin VB.PictureBox Picture1  
      Height          =   6255 
      Left            =   240 
      ScaleHeight     =   6195 
      ScaleWidth      =   7875 
      TabIndex        =   1 
      Top             =   120 
      Width           =   7935 
   End 
   Begin VB.CommandButton Command2  
      Caption         =   "退出系统" 
      Height          =   495 
      Left            =   6840 
      TabIndex        =   0 
      Top             =   8280 
      Width           =   1215 
   End 
   Begin VB.Label 抓图保存地址  
      Caption         =   "抓图保存地址" 
      Height          =   255 
      Left            =   480 
      TabIndex        =   20 
      Top             =   9120 
      Width           =   1215 
   End 
   Begin VB.Label 校时时间  
      Caption         =   "开始时间" 
      Height          =   375 
      Left            =   360 
      TabIndex        =   19 
      Top             =   9600 
      Width           =   1215 
   End 
   Begin VB.Label Label1  
      AutoSize        =   -1  'True 
      Caption         =   "通道号" 
      Height          =   195 
      Left            =   5280 
      TabIndex        =   12 
      Top             =   6840 
      Width           =   660 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
 
'屏蔽主窗体的关闭按钮 
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 As Long 
Private devInfo As NET_DVR_DEVICEINFO_V30 
Private clientInfo As NET_DVR_CLIENTINFO 
'Download by http://www.codefans.net 
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 Command10_Click() 
If (hLoginId >= 0) Then NET_DVR_StopSaveRealData (hLoginId) 
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 Command9_Click() 
    '抓图 
    Dim jg As Boolean 
    Dim mypath As String 
    Dim filename As String 
     
   
    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_SaveRealData(hLoginId, "c:\test.mp4")              '保存 
            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 = "192.168.1.64" 
devPort.Text = "8000" 
devName.Text = "admin" 
devPwd.Text = "12345" 
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) 
    hMonitorId = -1 
    Picture1.Refresh 
End If 
 
If (hLoginId > -1) Then  '已经登录 
    clientInfo.lChannel = devCH.Text 'hMonitorCha     '通道号 
    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, PtrToLong(AddressOf REALDATACALLBACK), 0, True)   '实时预览 
    Debug.Print hMonitorId 
End If 
 
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(0) 
    hMonitorId = -1 
    Picture1.Refresh 
End If 
 
End Sub 
 
 
 
Private Sub Command2_Click() '退出 
 
On Error Resume Next 
 
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