Code:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' HIK CAMERA PICTURE DOWNLOAD UTILITY
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Strict On
Option Explicit On
Imports System.ComponentModel
Imports System.IO
Imports System.Net
Imports System.Net.Http
Imports System.Text
Public Class Form1
Dim PicName(1000000) As String
Dim PicAddress(1000000) As String
Dim PicDTime(1000000) As DateTime
Dim PicSize(1000000) As String
Dim PicPlaybackURI(1000000) As String
Dim picIndex, newStartNum, newEndNum As Integer
Dim searchFrom As DateTime
Dim requestCancel As Boolean = False
Dim cameraCredentials As New NetworkCredential
Dim cameraImage As Drawing.Image
Dim iniFile As FileStream
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MAIN FORM LOAD
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If Not File.Exists("HikCameraPictureDownload.ini") Then
UpdateIniFile()
End If
iniFile = File.Open("HikCameraPictureDownload.ini", CType(FileAccess.ReadWrite, FileMode))
Dim iniReader As New StreamReader(iniFile)
Username.Text = iniReader.ReadLine()
DownloadFolder.Text = iniReader.ReadLine()
Do While Not iniReader.EndOfStream
IpInfo.Items.Add(iniReader.ReadLine())
Loop
iniFile.Close()
UtcOffset.Value = Convert.ToInt32((DateTime.Now - DateTime.UtcNow).TotalHours)
cameraCredentials.UserName = Username.Text
cameraCredentials.Password = Password.Text
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CONNECT BUTTON CLICK
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Async Sub ConnectButton_Click(sender As Object, e As EventArgs) Handles ConnectButton.Click
If Not OkToConnect() Then
Return
End If
EnableConnectInputs(False)
requestCancel = False
CancelButton.Enabled = True
Try ' REQUEST CAMERA NAME
Dim cameraHandler As New HttpClientHandler With {.Credentials = cameraCredentials}
Dim cameraClient As New HttpClient(cameraHandler) With {.Timeout = TimeSpan.FromSeconds(30)}
Dim cameraRequest As New HttpRequestMessage With {
.Method = HttpMethod.Get,
.RequestUri = New Uri("http://" + IpInfo.Text + "/ISAPI/Streaming/channels/101/capabilities"),
.Content = New StringContent("", Encoding.UTF8)
}
Dim cameraResponse = cameraClient.Send(cameraRequest)
cameraResponse.EnsureSuccessStatusCode()
Dim cameraStream = Await cameraResponse.Content.ReadAsStringAsync().ConfigureAwait(True)
Dim Xml = cameraStream.ToString
Xml = Replace(Xml, " version=""2.0"" xmlns=""http://www.hikvision.com/ver20/XMLSchema""", "", 1, 1)
Dim xElement As XElement = XElement.Parse(Xml, options:=LoadOptions.None)
CameraName.Text = VerifyCameraName(xElement.Descendants("channelName").Value).ToString
If CameraName.Text = "" Then
Throw New Exception("Camera has no name.")
Else
CameraName.BackColor = Color.Khaki
If Not IpInfo.Items.Contains(IpInfo.Text) Then
IpInfo.Items.Add(IpInfo.Text)
UpdateIniFile()
End If
End If
Catch exceptionError As Exception
MsgBox(String.Format("Error: {0}", exceptionError.Message), vbDefaultButton2, "Error connecting...")
Disconnect()
EnableConnectInputs(True)
CancelButton.Enabled = False
Return
End Try
If SkipPrevious.Checked Then ' CHECK FILES ON DISK PREVIOUSLY
If Directory.Exists(DownloadFolder.Text + "\" + CameraName.Text) Then
OldCount.Value = Directory.GetFiles(DownloadFolder.Text + "\" + CameraName.Text).Length
If OldCount.Value > 0 Then
Dim oldestFile = Directory.GetFiles(DownloadFolder.Text + "\" + CameraName.Text).
OrderByDescending(Function(f) New FileInfo(f).LastWriteTime).Last()
oldestFile = Replace(oldestFile, DownloadFolder.Text + "\" + CameraName.Text +
"\" + CameraName.Text + "_", "")
oldestFile = Replace(oldestFile, ".jpg", "")
OldStart.Text = StrDateToDT(oldestFile).ToString("yyyy/MM/dd HH:mm:ss")
Dim newestFile = Directory.GetFiles(DownloadFolder.Text + "\" + CameraName.Text).
OrderByDescending(Function(f) New FileInfo(f).LastWriteTime).First()
CameraMainPicture.Load(newestFile) 'Load the picture of just the newest existing file
LoadPicture(CameraMainPicture.Image, False)
newestFile = Replace(newestFile, DownloadFolder.Text + "\" + CameraName.Text + "\" +
CameraName.Text + "_", "")
newestFile = Replace(newestFile, ".jpg", "")
OldEnd.Text = StrDateToDT(newestFile).ToString("yyyy/MM/dd HH:mm:ss")
PicDTime(1) = StrDateToDT(newestFile) 'This is needed to keep the progress bar accurate
searchFrom = StrDateToDT(newestFile).AddSeconds(1)
picIndex = CInt(OldCount.Value + 1)
End If
End If
End If
SkipPrevious.Enabled = False
SkipPrevious.Checked = False
Try ' REQUEST NEW PICTURE BATCHES
Dim searchTo = Now
Dim picBatchAmt = 50
While picBatchAmt = 50
Dim cameraHandler As New HttpClientHandler With {.Credentials = cameraCredentials}
Dim cameraClient As New HttpClient(cameraHandler) With {.Timeout = TimeSpan.FromSeconds(30)}
Dim cameraRequest As New HttpRequestMessage With {
.Method = HttpMethod.Post,
.RequestUri = New Uri("http://" + IpInfo.Text + "/ISAPI/contentMgmt/search"),
.Content = New StringContent("<CMSearchDescription><searchID>ID</searchID><trackIDList>" +
"<trackID>103</trackID></trackIDList><timeSpanList><timeSpan>" +
"<startTime>" + HikDate(searchFrom.AddHours(-UtcOffset.Value)) + "</startTime>" +
"<endTime>" + HikDate(searchTo.AddHours(-UtcOffset.Value)) + "</endTime>" +
"</timeSpan></timeSpanList><contentTypeList>" +
"<contentType>metadata</contentType></contentTypeList>" +
"<maxResults>50</maxResults><searchResultPostion>0</searchResultPostion>" +
"<metadataList><metadataDescriptor>/recordType.meta.std-cgi.com/CMR" +
"</metadataDescriptor></metadataList></CMSearchDescription>", Encoding.UTF8)
}
Dim cameraResponse = cameraClient.Send(cameraRequest)
Dim cameraStream = Await cameraResponse.Content.ReadAsStringAsync().ConfigureAwait(True)
Dim Xml = cameraStream.ToString
Xml = Replace(Xml, " version=""2.0"" xmlns=""http://www.hikvision.com/ver20/XMLSchema""", "", 1, 1)
Dim xElement As XElement = XElement.Parse(Xml, options:=LoadOptions.None)
picBatchAmt = CInt(xElement.Descendants("numOfMatches").Value)
If picBatchAmt = 0 And picIndex = 0 Then
Throw New Exception("No pictures on " + CameraName.Text + ".")
End If
Dim CMSearchResult = xElement.Descendants("playbackURI") ' CREATE ARRAY OF PICTURES
For Each playbackURI As XElement In CMSearchResult
picIndex += 1
PicPlaybackURI(picIndex) = playbackURI.Value
Dim SearchWithinThis = playbackURI.Value
Dim SearchForThis = "http://"
Dim FirstChar = SearchWithinThis.IndexOf(SearchForThis)
SearchForThis = "/ISAPI"
Dim LastChar = SearchWithinThis.IndexOf(SearchForThis)
If LastChar = -1 Then
SearchForThis = "/Streaming"
LastChar = SearchWithinThis.IndexOf(SearchForThis)
End If
PicAddress(picIndex) = Mid(playbackURI.Value, FirstChar + 8, LastChar - FirstChar - 7)
SearchWithinThis = playbackURI.Value
SearchForThis = "starttime="
FirstChar = SearchWithinThis.IndexOf(SearchForThis)
PicDTime(picIndex) = StrDateToDT(Mid(playbackURI.Value, FirstChar + 11, 8) +
Mid(playbackURI.Value, FirstChar + 20, 6))
PicDTime(picIndex) = PicDTime(picIndex).AddHours(UtcOffset.Value)
SearchWithinThis = playbackURI.Value
SearchForThis = "size="
FirstChar = SearchWithinThis.IndexOf(SearchForThis)
PicSize(picIndex) = Mid(playbackURI.Value, FirstChar + 6, playbackURI.Value.Length - FirstChar - 4)
SearchWithinThis = playbackURI.Value
SearchForThis = "name="
FirstChar = SearchWithinThis.IndexOf(SearchForThis)
SearchForThis = "size="
LastChar = SearchWithinThis.IndexOf(SearchForThis)
PicName(picIndex) = Mid(playbackURI.Value, FirstChar + 6, LastChar - FirstChar - 6)
Dim jpgFilename = DownloadFolder.Text + "\" + CameraName.Text + "\" + CameraName.Text + "_" +
PicDTime(picIndex).ToString("yyyyMMddHHmmss") + ".jpg"
If File.Exists(jpgFilename) Then
OldCount.Value += 1
If OldCount.Value = 1 Then
OldStart.Text = PicDTime(picIndex).ToString("yyyy/MM/dd HH:mm:ss")
End If
OldEnd.Text = PicDTime(picIndex).ToString("yyyy/MM/dd HH:mm:ss")
If PreviewOldCheckBox.Checked = True Then
CameraMainPicture.Load(jpgFilename)
LoadPicture(CameraMainPicture.Image, False)
End If
Else
PreviewOldCheckBox.Enabled = False
PreviewOldCheckBox.Checked = False
NewCount.Value += 1
If newStartNum = 0 Then
newStartNum = picIndex
NewStart.Text = PicDTime(picIndex).ToString("yyyy/MM/dd HH:mm:ss")
RequestPicture(picIndex) 'Load just first new pic while connecting
LoadPicture(cameraImage, True)
End If
newEndNum = picIndex
NewEnd.Text = PicDTime(picIndex).ToString("yyyy/MM/dd HH:mm:ss")
End If
searchFrom = PicDTime(picIndex).AddSeconds(1)
ProgressBar.Value = CInt(100 * (1 - (DateDiff("n", PicDTime(picIndex), searchTo) /
DateDiff("n", PicDTime(1), searchTo))))
My.Application.DoEvents()
System.Threading.Thread.Sleep((100 - CpuDelay.Value) * 10)
If requestCancel = True Then
Disconnect()
EnableConnectInputs(True)
Return
End If
Next
End While
Catch exceptionError As Exception
MsgBox(String.Format("Error: {0}", exceptionError.Message), vbDefaultButton2, "Error Connecting")
Disconnect()
EnableConnectInputs(True)
CancelButton.Enabled = False
Return
End Try
PreviewOldCheckBox.Enabled = False
PreviewOldCheckBox.Checked = False
If NewCount.Value > 0 Then
DownloadButton.Enabled = True
PreviewNewCheckBox.Enabled = True
PreviewNewCheckBox.Checked = True
Else
EnableConnectInputs(True)
SkipPrevious.Enabled = True
SkipPrevious.Checked = True
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DOWNLOAD BUTTON CLICK
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub DownloadButton_Click(sender As Object, e As EventArgs) Handles DownloadButton.Click
DownloadButton.Enabled = False
requestCancel = False
Try
If Not Directory.Exists(DownloadFolder.Text + "\" + CameraName.Text) Then
My.Computer.FileSystem.CreateDirectory(DownloadFolder.Text + "\" + CameraName.Text)
End If
For picIndex = newStartNum To newEndNum
RequestPicture(picIndex)
Dim jpgFilename = DownloadFolder.Text + "\" + CameraName.Text + "\" + CameraName.Text + "_" +
StrDate(PicDTime(picIndex)) + ".jpg"
cameraImage.Save(jpgFilename)
If PreviewNewCheckBox.Checked = True Or picIndex = newStartNum Then
LoadPicture(cameraImage, True)
End If
If picIndex = newStartNum And OldStart.Text = "" Then
OldStart.Text = PicDTime(picIndex).ToString("yyyy/MM/dd HH:mm:ss")
End If
OldEnd.Text = PicDTime(picIndex).ToString("yyyy/MM/dd HH:mm:ss")
OldCount.Value = OldCount.Value + 1
If picIndex <> newEndNum Then
NewStart.Text = PicDTime(picIndex + 1).ToString("yyyy/MM/dd HH:mm:ss")
NewCount.Value = NewCount.Value - 1
ProgressBar.Value = CInt(100 * (1 - ((newEndNum - picIndex) / (newEndNum - newStartNum))))
Else
NewStart.Text = ""
NewEnd.Text = ""
NewCount.Value = NewCount.Value - 1
newStartNum = 0
ProgressBar.Value = 100
End If
My.Application.DoEvents()
Threading.Thread.Sleep((100 - CpuDelay.Value) * 5)
If requestCancel = True Then
Disconnect()
EnableConnectInputs(True)
Return
End If
Next
Catch exceptionError As Exception
MsgBox(String.Format("Error: {0}", exceptionError.Message), vbDefaultButton2, "Error Downloading")
Disconnect()
EnableConnectInputs(True)
CancelButton.Enabled = False
Return
End Try
EnableConnectInputs(True)
CancelButton.Enabled = False
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CANCEL BUTTON CLICK
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CancelButton_Click(sender As Object, e As EventArgs) Handles CancelButton.Click
requestCancel = True
DownloadButton.Enabled = False
Disconnect()
EnableConnectInputs(True)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' REQUEST PICTURE FROM CAMERA
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Async Sub RequestPicture(picIndex As Integer)
Dim requestRetry As Integer = 0
Dim noError As Boolean
While requestRetry <= 4
requestRetry += 1
noError = True
Try
Dim cameraHandler As New HttpClientHandler With {.Credentials = cameraCredentials}
Dim cameraClient As New HttpClient(cameraHandler) With {.Timeout = TimeSpan.FromSeconds(30)}
Dim cameraRequest As New HttpRequestMessage With {
.Method = HttpMethod.Get,
.RequestUri = New Uri("http://" + IpInfo.Text + "/ISAPI/contentMgmt/download"),
.Content = New StringContent("<?xml version='1.0'?><downloadRequest><playbackURI>rtsp:/" +
PicAddress(picIndex) + "/Streaming/tracks/120?starttime=" +
HikDate(PicDTime(picIndex).AddDays(-UtcOffset.Value)) + "&endtime=" +
HikDate(PicDTime(picIndex).AddDays(-UtcOffset.Value)) + "&name=" +
PicName(picIndex) + "&size=" +
PicSize(picIndex) + "</playbackURI></downloadRequest>", Encoding.UTF8)
}
Dim cameraResponse = cameraClient.Send(cameraRequest)
cameraResponse.EnsureSuccessStatusCode()
Dim cameraByteStream = Await cameraResponse.Content.ReadAsByteArrayAsync().ConfigureAwait(True)
Dim cameraMemoryStream = New MemoryStream(cameraByteStream)
cameraImage = Drawing.Image.FromStream(cameraMemoryStream)
Catch exceptionError As Exception
If requestRetry = 4 Then
MsgBox(String.Format("Error: {0}", exceptionError.Message), vbDefaultButton2, "Error Requesting Picture")
Return
Else
noError = False
My.Application.DoEvents()
Threading.Thread.Sleep(15000)
End If
End Try
If noError Then Return
End While
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FUNCTIONS
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub EnableConnectInputs(TurnOn As Boolean)
ConnectButton.Enabled = TurnOn
CancelButton.Enabled = Not TurnOn
Username.Enabled = TurnOn
Password.Enabled = TurnOn
IpInfo.Enabled = TurnOn
DownloadFolder.Enabled = TurnOn
UtcOffset.Enabled = TurnOn
If NewCount.Value = 0 Then
PreviewNewCheckBox.Enabled = False
PreviewNewCheckBox.Checked = False
End If
If TurnOn Then
Me.AcceptButton = ConnectButton
Else
Me.AcceptButton = DownloadButton
End If
End Sub
Private Sub Disconnect()
CameraName.Text = "DISCONNECTED"
CameraName.BackColor = Color.Firebrick
CameraMainPicture.Image = Nothing
CameraTimePicture.Image = Nothing
ProgressBar.Value = 0
picIndex = 0
searchFrom = New DateTime(2020, 1, 1, 0, 0, 0, 0)
OldStart.Text = ""
OldEnd.Text = ""
OldCount.Value = 0
NewStart.Text = ""
NewEnd.Text = ""
NewCount.Value = 0
PreviewOldCheckBox.Enabled = False
PreviewOldCheckBox.Checked = False
SkipPrevious.Enabled = True
SkipPrevious.Checked = True
newStartNum = 0
newEndNum = 0
End Sub
Private Sub SkipPrevious_CheckedChanged(sender As Object, e As EventArgs) Handles SkipPrevious.CheckedChanged
If SkipPrevious.Checked Then
PreviewOldCheckBox.Enabled = False
PreviewOldCheckBox.Checked = False
Else
PreviewOldCheckBox.Enabled = True
PreviewOldCheckBox.Checked = True
End If
End Sub
Private Function OkToConnect() As Boolean
If Username.Text = "" Then
MsgBox("Enter Username to connect", vbDefaultButton2, "Username missing")
Return False
End If
If Password.Text = "" Then
MsgBox("Enter Password to connect", vbDefaultButton2, "Password missing")
Return False
End If
If IpInfo.Text = "" Then
MsgBox("Enter IP Address:Port to connect", vbDefaultButton2, "IP Address:Port missing")
Return False
End If
If DownloadFolder.Text = "" Then
MsgBox("Select Download Folder to connect", vbDefaultButton2, "Download Folder missing")
Return False
End If
Return True
End Function
Private Sub UpdateIniFile()
Dim iniFileText As String = Username.Text + Environment.NewLine + DownloadFolder.Text
For x = 0 To IpInfo.Items.Count - 1
iniFileText += Environment.NewLine + IpInfo.Items.Item(x).ToString
Next
File.WriteAllText("HikCameraPictureDownload.ini", iniFileText)
End Sub
Private Sub DownloadFolder_Click(sender As Object, e As EventArgs) Handles DownloadFolder.Click
FolderBrowser.InitialDirectory = DownloadFolder.Text
FolderBrowser.ShowDialog()
DownloadFolder.Text = FolderBrowser.SelectedPath
Disconnect()
UpdateIniFile()
End Sub
Private Sub Username_Leave(sender As Object, e As EventArgs) Handles Username.Leave
cameraCredentials.UserName = Username.Text
Disconnect()
UpdateIniFile()
End Sub
Private Sub Password_Leave(sender As Object, e As EventArgs) Handles Password.Leave
cameraCredentials.Password = Password.Text
Disconnect()
End Sub
Private Sub IpInfo_SelectedValueChanged(sender As Object, e As EventArgs) Handles IpInfo.SelectedValueChanged
Disconnect()
End Sub
Private Sub GmtOffset_ValueChanged(sender As Object, e As EventArgs) Handles UtcOffset.ValueChanged
Disconnect()
End Sub
Private Function VerifyCameraName(cameraName As String) As String
cameraName = Replace(cameraName, " ", "_")
cameraName = Replace(cameraName, "\", "_")
cameraName = Replace(cameraName, "/", "_")
cameraName = Replace(cameraName, ":", "_")
cameraName = Replace(cameraName, "*", "_")
cameraName = Replace(cameraName, "?", "_")
cameraName = Replace(cameraName, "<", "_")
cameraName = Replace(cameraName, ">", "_")
cameraName = Replace(cameraName, "!", "_")
Return cameraName
End Function
Private Function HikDate(normalDate As DateTime) As String ' takes datetime returns "yyyy-mm-ddThh:mm:ssZ"
HikDate = normalDate.ToString("yyyy-MM-dd") + "T" + normalDate.ToString("HH:mm:ss") + "Z"
End Function
Private Function StrDateToDT(dateStr As String) As DateTime ' takes "yyyymmddhhmmss" returns datetime
dateStr = Mid(dateStr, 1, 4) + "/" + Mid(dateStr, 5, 2) + "/" + Mid(dateStr, 7, 2) + " " +
Mid(dateStr, 9, 2) + ":" + Mid(dateStr, 11, 2) + ":" + Mid(dateStr, 13, 2)
StrDateToDT = Convert.ToDateTime(dateStr)
End Function
Private Function StrDate(aDate As DateTime) As String ' takes datetime returns "yyyyMMddHHmmss"
StrDate = aDate.ToString("yyyyMMddHHmmss")
End Function
Private Sub LoadPicture(cameraImage As Image, mainAndTime As Boolean)
Dim cameraBitmap As System.Drawing.Bitmap
Dim cameraGraphics As Graphics
If mainAndTime Then
CameraMainPicture.Image = cameraImage
End If
cameraBitmap = CType(cameraImage, Bitmap)
CameraTimePicture.Image = New Bitmap(950, 55)
cameraGraphics = Graphics.FromImage(CameraTimePicture.Image)
cameraGraphics.DrawImage(image:=cameraBitmap,
destRect:=New Rectangle(x:=0, y:=0, width:=950, height:=55),
srcRect:=New Rectangle(x:=0, y:=0, width:=950, height:=55),
srcUnit:=GraphicsUnit.Pixel)
End Sub
End Class