Private WithEvents WSK_Cam As Winsock '連接攝像頭用
'=================================
Private Jpeg() As Byte '接收到的影像資料
Private NewFram As Boolean '新的一幀開始
Private Fram_Size As Long '一幀的長度
'Private FramCounter As Integer '幀計數，用于計算幀率
Private bCameraEnable As Boolean '開始接收攝像頭影像
'Public fps As Integer '攝像頭幀率
Private Shot As Boolean '是否截圖
'定義事件
Public Event CamConnected(CamConnState) '小車攝像頭連接
Public Event CamUnconnected() '小車攝像頭斷開
Public Event CamPicBuiled(pic As IPicture) '視頻中一幀畫面完成
Public Event CamEnable() '視頻開啟
Public Event CamDisable() '視頻關閉
Private Const S_OK = 0 ' indicates successful HRESULT
Private Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const GMEM_MOVEABLE = &H2
Private Type GUID ' 16 bytes (128 bits)
dwData1 As Long ' 4 bytes
wData2 As Integer ' 2 bytes
wData3 As Integer ' 2 bytes
abData4(7) As Byte ' 8 bytes, zero based
End Type
Private Enum CBoolean ' enum members are Long data types
CFalse = 0
CTrue = 1
End Enum
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pCLSID As GUID) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As CBoolean, riid As GUID, ppvObj As Any) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As CBoolean, ppstm As Any) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
'解構式
Private Sub Class_Terminate()
WSK_Cam.Close
End Sub
'初始化winsock和timer
Public Sub CamInitialize(ByRef ObjWskCam As Winsock)
Set WSK_Cam = ObjWskCam
End Sub
'建立與小車攝像頭的通信連接
Public Sub ConnectCamera()
'設定winsocket
WSK_Cam.Close
WSK_Cam.RemoteHost = Form1.txtCameraIP.Text
WSK_Cam.RemotePort = Form1.txtCameraPort.Text
WSK_Cam.Connect
End Sub
Private Sub WSK_Cam_Connect()
If WSK_Cam.State = 7 Then
WSK_Cam.SendData "GET " & Form1.txtCameraURL.Text & " HTTP/1.1" & vbCrLf & vbCrLf
End If
'觸發小車攝像頭連接準備就緒事件
RaiseEvent CamConnected(WSK_Cam.State)
End Sub
'請求視頻
Public Sub CameraEnable()
bCameraEnable = True
RaiseEvent CamEnable
End Sub
'斷開視頻
Public Sub CameraDisable()
bCameraEnable = False
RaiseEvent CamDisable
End Sub
'斷開攝像頭連接
Public Sub UnconnectCam()
WSK_Cam.Close
RaiseEvent CamUnconnected
End Sub
'視頻截圖
Public Sub SnapShot()
Shot = True
End Sub
'攝像頭資料到達
Private Sub WSK_Cam_DataArrival(ByVal bytesTotal As Long)
If Not bCameraEnable Then Exit Sub
Dim s() As Byte, index_1 As Long, index_2 As Long, index_3 As Long, i As Long, L As Long
Static J As Variant '記錄jpeg陣列中當前元素位置
ReDim s(bytesTotal - 1)
WSK_Cam.GetData s
'DoEvents
NF: '開始jpeg新幀
If Not NewFram Then
index_1 = FindChar(0, s, "Content-Length: ")
If index_1 > 0 Then
NewFram = True '新的一幀開始
'每一幀JPEG影像由FFD8開始，在其前面有兩組vbCrLf標志幀說明資訊的結束
index_2 = FindChar(index_1, s, vbCrLf)
If index_2 Then
If index_2 < 0 Then
index_2 = bytesTotal
End If
tempsize = ""
For i = index_1 + 16 To index_2 - 1
tempsize = tempsize + Chr(s(i))
Next
Fram_Size = CLng(tempsize) '獲取幀的大小
' Debug.Print Fram_Size
ReDim Jpeg(Fram_Size - 1) '重新定義幀陣列
index_2 = FindChar(index_2, s, vbCrLf & vbCrLf)
J = 0: index_2 = index_2 + 4: L = UBound(s)
'將當前批次中的JPEG影像資料復制到幀陣列中
For i = index_2 To L
Jpeg(J) = s(i)
J = J + 1
Next
If J > 0 Then
Fram_Size = Fram_Size - J '計算幀剩余位元組數
'Debug.Print "Fram Head=" & J
End If
End If
End If
Else
If Fram_Size >= bytesTotal Then
For i = 0 To bytesTotal - 1
Jpeg(J) = s(i)
J = J + 1
Next
Fram_Size = Fram_Size - bytesTotal
'Debug.Print "Fram Body=" & bytesTotal
Else
'當前批次的資料中包含一幀的結束標志
For i = 0 To Fram_Size - 1
Jpeg(J) = s(i)
J = J + 1
Next
Fram_Size = Fram_Size - (i - 1)
If Shot Then '執行截圖
filenum = FreeFile
Open App.Path & "\" & Format(Now(), "yyyymmddhhmmss") & ".jpg" For Binary As filenum
Put filenum, , Jpeg()
Shot = False
Close filenum
End If
RaiseEvent CamPicBuiled(PictureFromBits(Jpeg()))
NewFram = False '一幀結束
GoTo NF
End If
End If
End Sub
'將用位元組陣列存盤的JPEG影像轉換成記憶體影像供picbox或image控制加載
Private Function PictureFromBits(abPic() As Byte) As IPicture ' not a StdPicture!!
Dim nLow As Long, cbMem As Long, hMem As Long
Dim lpMem As Long, IID_IPicture As GUID
Dim IStm As stdole.IUnknown, IPic As IPicture
' Get the size of the picture's bits
On Error GoTo Out
nLow = LBound(abPic)
On Error GoTo 0
cbMem = (UBound(abPic) - nLow) + 1
' Allocate a global memory object
hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
If hMem Then
' Lock the memory object and get a pointer to it.
lpMem = GlobalLock(hMem)
If lpMem Then
' Copy the picture file bytes to the memory pointer
' and unlock the handle.
MoveMemory ByVal lpMem, abPic(nLow), cbMem
Call GlobalUnlock(hMem)
' Create an ISteam from the pictures bits (we can
' explicitly free hMem below, but we'll have the
' call do it here...)
If (CreateStreamOnHGlobal(hMem, CTrue, IStm) = S_OK) Then
If (CLSIDFromString(StrPtr(sIID_IPicture), _
IID_IPicture) = S_OK) Then
' Create an IPicture from the IStream (the docs
' say the call does not AddRef its last param, but
'it looks like the reference counts are correct..)
Call OleLoadPicture(ByVal ObjPtr(IStm), cbMem, CFalse, IID_IPicture, PictureFromBits)
End If ' CLSIDFromString
End If ' CreateStreamOnHGlobal
End If ' lpMem
Call GlobalFree(hMem)
End If ' hMem
Out:
End Function
'在位元組陣列中查找指定的字串位置，回傳陣列中第一個相同字串首字符的下標值
'b開始位置,a()參考的字符陣列,str需要查找的字串
Private Function FindChar(b As Long, ByRef a() As Byte, str As String) As Long
Dim i As Long, L As Long, L2 As Integer, Flag As Boolean
L = UBound(a) - Len(str) + 1
L2 = Len(str)
'b值一般從0開始
For i = b To L
Flag = True
For J = 1 To L2
Flag = Flag And (a(i + J - 1) = Asc(Mid(str, J, 1)))
If Not Flag Then Exit For '當前匹配時有不符合的字符就不再繼續匹配，繼續下一輪
Next
If Flag Then Exit For '找到匹配字串就退出
Next
If Flag Then
FindChar = i
Else
FindChar = -1
End If
End Function
uj5u.com熱心網友回復：
有懂的可以聯系我QQ229197205轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/95322.html
標籤：網絡編程