Option Explicit
Private ip As String
Private port As Integer
Private Connection As Boolean
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Sub Command1_Click()
sckMain.Close
status.Caption = sckMain.State
End Sub
 
Private Sub Form_Load()
    'MousePointer = vbHourglass
    MousePointer = vbDefault
    Connection = False
    Label1.Caption = "Warte auf Program Start ..."
    Label2.Caption = "Noch keine Daten vorhanden ..."
    wipadd.Text = "10.10.56.1"
    waageport.Text = "8000"
    uncpath.Text = "C:\test1.txt"
    'Call Connect
End Sub
Private Sub start_Click()
If wipadd.Text = Empty Then
MsgBox "Bitte IP-Adresse der Waage richtig eingeben."
End If
If waageport.Text = Empty Then
MsgBox "Bitte Port richtig eingeben."
End If
If uncpath.Text = Empty Then
MsgBox "Bitte UNC-Pfad richtig eingeben. (Vollständige Pfadangabe)"
End If
Call Verbind1
End Sub
Private Sub Verbind1()
    sckMain.Close
    Label1.Caption = "Verbinde..."
    'ip = "10.10.56.2"
    ip = wipadd.Text
    'port = 8000
    port = waageport.Text
    sckMain.RemoteHost = ip
    sckMain.RemotePort = port
    sckMain.Connect
    status.Caption = sckMain.State
    Call sckMain_Connect
End Sub
 
Private Sub sckMain_Connect()
    Label1.Caption = "Verbindung OK"
    Connection = True
    Sleep (600)
    Timer1.Interval = 1000
    Timer1.Enabled = True
End Sub
Private Sub Send()
If sckMain.State <> sckConnected Then
   Timer1.Enabled = False
   'Connect
End If
On Error Resume Next
If Connection Then sckMain.SendData "S" Else
status.Caption = "Verbindung down"
 'sckMain.SendData "S"
 'Label3.Caption "Send S"
End Sub
 
Private Sub sckMain_DataArrival(ByVal bytesTotal As Long)
Dim Message As String
Dim F As Integer
   sckMain.GetData Message
   F = FreeFile
   Message = Right(Message, Len(Message) - 4)
   Label2.Caption = Message
   'Open "C:\test.txt" For Output As #F
   Open uncpath.Text For Output As #F
   Print #F, Message
   Close #F
End Sub
 
Private Sub Timer1_Timer()
   Send
   DoEvents
End Sub
Private Sub sckMain_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)
    'alert the user to the error
    Label1.Caption = "Program-Error | Grund:" & Description
    'MsgBox "Program-Error | Grund:" & Description
 
End Sub

Skype: ip-style