:pthis is server for webcam freezes up on unload event anyway to fix this
:eek::eek::eek::eek::eek::eek::eek::eek::eek::eek::eek::eek::eek:
Code:
Dim CamHwnd As Long
Private m_Jpeg As cJpeg
Private m_FileName As String
Private m_Image As New cImage
Sub Convert(InputFile As String, OutputFile As String)
On Error Resume Next
Dim MyPic As StdPicture
Set MyPic = LoadPicture(InputFile)
Kill InputFile
Set m_Image = New cImage
m_Image.CopyStdPicture MyPic
m_Jpeg.SampleHDC m_Image.hDC, 320, 240
Kill OutputFile
m_Jpeg.SaveFile OutputFile
Set MyPic = Nothing
End Sub
Private Sub Command1_Click()
TmrPreview.Enabled = True
TmrStream.Enabled = True
End Sub
Private Sub Form_Load()
On Error Resume Next
Winsock1.Close
Winsock1.LocalPort = 636
Winsock1.Listen
Me.Caption = "Listening on Port: " & Winsock1.LocalPort
On Error Resume Next
Set m_Jpeg = New cJpeg
On Error Resume Next
CamHwnd = capCreateCaptureWindow("CamWnd", 0, 0, 0, 320, 240, Me.hwnd, 0)
DoEvents
Call SendMessage(CamHwnd, 1034, 0, 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.TmrPreview.Enabled = False
Me.TmrStream.Enabled = False
DoEvents
Call SendMessage(CamHwnd, 1035, 0, 0)
On Error Resume Next
Set m_Image = Nothing
Set m_Jpeg = Nothing
If Dir(App.Path & "\temp.jsrm", vbNormal) = "temp.jsrm" Then Kill App.Path & "\temp.jsrm"
If Dir(App.Path & "\temp.bsrm", vbNormal) = "temp.bsrm" Then Kill App.Path & "\temp.bsrm"
End
End Sub
Public Sub TakeFrame()
On Error Resume Next
Dim Bjpg As String
If Winsock1.State = sckConnected Then
SavePicture picBox.Picture, App.Path & "\temp.bsrm"
Call Convert(App.Path & "\temp.bsrm", App.Path & "\temp.jsrm")
DoEvents
Bjpg = GetFile(App.Path & "\temp.jsrm")
DoEvents
Winsock1.SendData Bjpg
End If
End Sub
Private Sub TmrPreview_Timer()
On Error Resume Next
SendMessage CamHwnd, 1084, 0, 0
SendMessage CamHwnd, 1054, 0, 0
picBox.Picture = Clipboard.GetData
Clipboard.Clear
End Sub
Private Sub TmrStream_Timer()
On Error Resume Next
TakeFrame
End Sub
Private Sub Winsock1_Close()
On Error Resume Next
Winsock1.Close
Winsock1.LocalPort = 636
Winsock1.Listen
Me.Caption = "Connection Closed."
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
On Error Resume Next
Winsock1.Close
Winsock1.Accept requestID
Me.Caption = "Connection From: " & Winsock1.RemoteHostIP & " Accepted."
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Winsock1.Close
Winsock1.Listen
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim data As String
Winsock1.GetData data
DoEvents
Select Case Mid(data, 1, 10)
Case "vercam"
On Error Resume Next
Dim Aa As String
Aa = MsgBox("user request to se your cam", vbYesNo, "Question")
If Aa = vbYes Then
'TmrPreview.Enabled = True
' TmrStream.Enabled = True
Else
End If
End Select
End