Option Explicit
Dim g_Video_Handle As Long
Private Sub Form_Load()
    Dim iport As Integer
    Connect
    'iport = 10010   'Port definieren
    'Picture1.Visible = False
    'Livebild starten und im Fenster anzeien
    g_Video_Handle = CreateCaptureWindow(VideoBild.hwnd)
 End Sub
Private Sub Connect()
    Dim iport As Integer
   iport = 10010   'Port definieren
    'Horchen starten
    'Winsock1.Protocol = sckTCPProtocol
    'Winsock1.LocalIP = "127.0.0.1"
    Winsock1.Close
    Winsock1.LocalPort = iport
    Winsock1.Listen
End Sub
Private Sub Winsock1_Close()
    Connect
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Verbindung zur Kamera schließen
    Disconnect (g_Video_Handle)
    'Das Abhören wird beendet
    Winsock1.Close
End Sub
Private Sub Save_Click()
    Dim sFilename As String
    'Dateinamen definieren
    sFilename = "Testbild"
    sFilename = AddExtension(sFilename)
    MakeAbsPath (sFilename)
    'Foto schießen und in Picture1 zwischenspeichern
    CapturePicture g_Video_Handle, Picture1
    'Foto von Picture1 holen und speichern
    Save_JPG Picture1, sFilename
End Sub
Private Sub Beenden_Click()
    Unload Me
End Sub
Private Sub Timer1_Timer()
    Dim sMessage As String
    'lblStatus gibt den Status wieder
    'lblStatus.Caption = Winsock1.State
    Select Case Winsock1.State
        Case 0
            sMessage = "Socket ist geschlossen"
        Case 1
            sMessage = "Socket ist geöffnet"
        Case 2
            sMessage = "Der Socket ist empfangsbereit"
        Case 3
            sMessage = "Die Verbindung wird aufgebaut"
        Case 4
            sMessage = "Der Remote-Host-Name wird in eine IP-Adresse" & _
              "umgewandelt"
        Case 5
            sMessage = "Der Remote-Host-Name wurde in eine IP-Adresse" & _
              "umgewandelt"
        Case 6
            sMessage = "Der Socket verbindet sich zu dem Remote"
        Case 7
            sMessage = "Der Socket hat sich zu dem Remote verbunden"
        Case 8
            sMessage = "Der Remote hat die Verbindung getrennt"
        Case 9
            sMessage = "Ein Fehler ist aufgetreten"
    End Select
    lblStatus.Caption = sMessage
End Sub
'Reaktion des Winsock bei Verbindungsanfrage
Private Sub Winsock1_ConnectionRequest(ByVal requestid As Long)
    Label2.Caption = requestid
    'Das Abhören wird beendet
    Winsock1.Close
    'Die Verbindung wird akzeptiert
    Winsock1.Accept requestid
End Sub
'Reaktion des Winsock, wenn Daten empfangen werden
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim sData As String
    'ankommende Daten in sData speichern
    Winsock1.GetData sData
    'sData interpretieren
    InterpretData sData
End Sub
'Daten interpretieren
Private Sub InterpretData(ByVal sData As String)
    Dim sFilename As String
    Dim sCommand_Shot, sCommand_Save As String
    'Codenummer für Befehle definieren
    sCommand_Shot = "1"
    sCommand_Save = "2"
    'Entscheidung, welcher Befehl versendet wurde...
    '...und entsprechende Reaktion
    If Left$(sData, 1) = sCommand_Shot Then
        FotoSchiessen
    ElseIf Left$(sData, 1) = sCommand_Save Then
        sFilename = GetFilename(sData)
        sFilename = AddExtension(sFilename)
        sFilename = MakeAbsPath(sFilename)
        FotoSpeichern (sFilename)
    End If
End Sub
'absolute Pfadangabe vor den Dateinamen schreiben
Private Function MakeAbsPath(ByRef sFilename As String)
    Dim sFile As String
    Dim sPath As String
    sPath = App.Path '?
    If Mid$(sFilename, 2, 1) <> ":" Then
        sFile = sPath
    End If
    If Right$(sFile, 1) <> "\" Then
        sFile = sFile & "\"
    End If
    sFilename = sFile & sFilename
    MakeAbsPath = sFilename
End Function
'Dateiendung anhängen
Private Function AddExtension(ByRef sFilename As String)
    Dim iLen As Integer
    Dim sExt As String
    iLen = Len(sFilename)
    sExt = ".jpg"
    If Mid$(sFilename, iLen - 3, 1) <> "." Then
        AddExtension = sFilename & sExt
    End If
    If Mid$(sFilename, iLen - 3, 1) = "." Then
        AddExtension = sFilename
    End If
End Function
'Dateinamen aus sData extrahieren
Private Function GetFilename(ByVal sData As String)
    Dim sFilename As String
    Dim iLen As Integer
    iLen = Len(sData)
    sFilename = Right$(sData, iLen - 2)
    GetFilename = sFilename
End Function
Private Sub FotoSpeichern(ByVal sFilename As String)
    Save_JPG Picture1, sFilename
    'SavePicture Picture1, sFilename
End Sub
Private Sub FotoSchiessen()
    CapturePicture g_Video_Handle, Picture1
End Sub