Hvordan sender man data (besked) mellem 2 pc er i vb

Fandt en løsning på vbsourcecode.com:

'Fand en løsning på vbsourcecode.com:

'Har lavet lidt om på den

'Send(Data) = Sender data
'srtData = Modtaget Data

'--- FORM1 ----

Option Explicit
Dim strData As String
Private Const INT_PORT_MAX As Long = 65535
Private Const INT_PORT_START As Long = 2235
Private Const HostPort As Long = 2235
Private Const HostIP As String = "localhost"

Private Sub cmdGo_Click()
    Call Send(txtSend)
End Sub

Private Sub txtPort_LostFocus()
    If Not isPort(HostPort) Then
        MsgBox "Invalid port specified!", vbExclamation + vbOKOnly, "Failure"
        HostPort = INT_PORT_START
    Else
        If HostPort <> Socket.LocalPort Then
            Bind HostPort
        End If
    End If
End Sub

Private Sub txtSend_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Send(txtSend)
    End If
End Sub

Private Function Send(Data As String)
    If Data <> "" Then
        If HostIP <> "" Then
            If isPort(HostPort) Then
                On Error Resume Next
                With Socket
                    .RemoteHost = HostIP
                    .RemotePort = HostPort
                    .SendData txtSend.Text
                End With
                Data = ""
                If Err.Number <> 0 Then
                    MsgBox "Error occured: " & Err.Description, vbExclamation + vbOKOnly, "Failure"
                End If
            Else
                MsgBox "Invalid port specified!", vbExclamation + vbOKOnly, "Failure"
             
            End If
        Else
            MsgBox "Host not specified!", vbExclamation + vbOKOnly, "Failure"
        End If
    Else
        MsgBox "SOME DATA PLEASE", vbExclamation + vbOKOnly, "Failure"
    End If
End Function

Private Sub Form_Load()
    Call Bind(INT_PORT_START)
End Sub

Private Function Bind(ByVal lPort As Long)
    On Error Resume Next
    If Socket.State <> sckClosed Then Socket.Close
    Socket.Bind lPort
    If Err.Number <> 0 Then
        MsgBox "Error occured: " & vbNewLine & Err.Description, vbExclamation + vbOKOnly, "Failure"
    End If
End Function

Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
   
    On Error Resume Next
    Socket.GetData strData
    If Len(strData) > 0 Then
      MsgBox (Socket.RemoteHostIP & ":" & strData)
       
    End If
    If Err.Number <> 0 Then
        MsgBox "Error occured: " & vbNewLine & Err.Description, vbExclamation + vbOKOnly, "Failure"
    End If
End Sub

Private Function isPort(ByVal vData) As Boolean
    If IsNumeric(vData) Then
        If vData > 0 And vData < INT_PORT_MAX Then
            isPort = True
        Else
            isPort = False
        End If
    Else
        isPort = False
    End If
End Function

'---Form1---

Venter med at svare til i morgen (5-Juni-2005) hvis der skulle være en der havde en mere smart måde at gøre det på... :)

Ups i
Private Function Send(Data as string)

Skal
With Socket
                    .RemoteHost = HostIP
                    .RemotePort = HostPort
                    .SendData txtSend.Text
                End With
udskiftes med
With Socket
                    .RemoteHost = HostIP
                    .RemotePort = HostPort
                    .SendData Data
                End With
:DD

Smart. Copy-paster lige :o)

Har du prøvet det - hvordan "modtages" data på modtager-PC'en?

'>Martion_moth: Har du prøvet det - hvordan "modtages" data på modtager-PC'en?
'Har testet den og den virker. både med
'Eneste fejl, er hvis man har en router. Hvis man har skal man sætter routeren op til at vidre sende data'erne til pc'ens ip
'Modtagedelen er: Socket_DataArrival(ByVal bytesTotal As Long)

'Hvorfor send og modtag i en?
'Jeg har samlet både sende og modtage delen i samme kode
'Da programmet på modtagepc'en så har mulighed for at svare tilbage at det faktisk har modtaget data til "Sendepc'en"

'Ændringer i koden
'Har kommentereret koden lidt og sat en svar tilbage funktion på samt en "send data og vent på svar før ny data kan sendes"

'<---Form1--->
'Formen skal indeholde: 1 Winsock (navngivet "Socket", Protocol = sckUDPProtocol), 2 textbox ("txtStatus" og "txtSend"), 1 Command knap ("cmdSend")

Option Explicit
Dim strData As String
Dim AnswerBack As Boolean
Dim OneDataOnly As Boolean
'Max port range
Private Const INT_PORT_MAX As Long = 65535
Private Const INT_PORT_START As Long = 2235

'Modtagers IP OG PORT
Private Const HostPort As Long = 2235 ' Skal ligge imellem INT_PORT_START og INT_PORT_MAX
Private Const HostIP As String = "Localhost"



Private Sub Form_Load()
    Call Bind(INT_PORT_START)
    'Skal fjernpc svare tilbage når data modtages?
    AnswerBack = True
   
    'Skal der kun kunne sendes 1 data (modtager pc skal svare tilbage før ny data kan sendes)
    OneDataOnly = True  'Kræver Anserback = True

   
    'angiv tekst og captions
    txtStatus = "Status: "
    cmdSend.Caption = "Send Data"
    txtSend = "<-DATA DER SKAL SENDES->"
End Sub


Private Sub txtSend_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Send(txtSend)
        txtSend = ""
    End If
End Sub
Private Sub cmdSend_Click()
Call Send(txtSend)
End Sub


'Selve sende funktionen (Data er det der skal sendes (tekst))
Private Function Send(Data As String)
    If Data <> "" Then
        If HostIP <> "" Then
           
           
            If isPort(HostPort) Then
                On Error Resume Next
                With Socket
                    .RemoteHost = HostIP
                    .RemotePort = HostPort
                    .SendData Data
                txtStatus = "Status: Data sendt to " & HostIP
                If OneDataOnly = True Then
                txtSend.Enabled = False
                cmdSend.Enabled = False
                End If
                End With
                Data = ""
                If Err.Number <> 0 Then
                    MsgBox "Error occured: " & Err.Description, vbExclamation + vbOKOnly, "Failure"
                End If
            Else
                MsgBox "Invalid port specified!", vbExclamation + vbOKOnly, "Failure"
             
            End If
        Else
            MsgBox "Host not specified!", vbExclamation + vbOKOnly, "Failure"
        End If
    Else
        MsgBox "SOME DATA PLEASE", vbExclamation + vbOKOnly, "Failure"
    End If
End Function



'Data modtagelse
Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
   
    On Error Resume Next
    Socket.GetData strData
    If strData = "Recived" Then
        txtStatus = "Data Delivered:  " & Now()
    Else
        If Len(strData) > 0 Then
           
            If AnswerBack = True Then
                Call Send("Recived")
               
                If OneDataOnly = True Then
                txtSend.Enabled = True
                cmdSend.Enabled = True
                End If
            End If
           
            MsgBox (Socket.RemoteHostIP & ":" & strData)    'DATA MODTAGET
        End If
    End If
   
    If Err.Number <> 0 Then
        MsgBox "Error occured: " & vbNewLine & Err.Description, vbExclamation + vbOKOnly, "Failure"
    End If
End Sub

'Tjek om socket er lukket
Private Function Bind(ByVal lPort As Long)
    On Error Resume Next
    If Socket.State <> sckClosed Then
        Socket.Close
    End If
   
    Socket.Bind lPort
       
    If Err.Number <> 0 Then
            MsgBox "Error occured: " & vbNewLine & Err.Description, vbExclamation + vbOKOnly, "Failure"
    End If
End Function

Private Function isPort(ByVal vData) As Boolean
    If IsNumeric(vData) Then
        If vData > 0 And vData < INT_PORT_MAX Then
            isPort = True
        Else
            isPort = False
        End If
    Else
        isPort = False
    End If
End Function

'<---Form1--->

Lukker spørgsmålet da der ikke kom nogle andre muligheder :oD

Det skal lige siges at "grund" koden strammer fra er fra et program UDPCHAT fra vbsourcecode.com, hvor jeg har lavet om på koden, så den passer til kommunikation mellem 2 pc'er og ikke som chat program