VB6 Winsock Trouble

[one-trick-pony]

Hi,

New user here. I recently got into developing a simple communications application for client-server model over the internet. I am using winsock in VB6 and trying to send text based messages just to get me going. However, i have been unsuccessful. I am able to connect on same computer, i.e, run client-server software on same computer and communicating with another computers on my home LAN. I can not connect to a computer over the internet. I tried connecting with few friends of mine and i get the message tcp/ip error:Connection Timed out. They are not behind firewall or a router. Following is my client and server code in VB6:

CLIENT CODE:

' A simple client using TCP sockets
Option Explicit
Private Sub Form_Load()
   cmdSend.Enabled = False
   
   ' set up local port and wait for connection
   tcpClient.RemoteHost = _
      InputBox("Enter the remote host IP address", _
         "IP Address", "localhost")
   
   If tcpClient.RemoteHost = "" Then
      tcpClient.RemoteHost = "localhost"
   End If
   
   tcpClient.RemotePort = 5000  ' server port
   Call tcpClient.Connect  ' connect to RemoteHost address
End Sub
Private Sub Form_Terminate()
   Call tcpClient.Close
End Sub
Private Sub Form_Resize()
   On Error Resume Next
   Call cmdSend.Move(ScaleWidth - cmdSend.Width, 0)
   Call txtSend.Move(0, 0, ScaleWidth - cmdSend.Width)
   Call txtOutput.Move(0, txtSend.Height, ScaleWidth, _
      ScaleHeight - txtSend.Height)
End Sub
Private Sub tcpClient_Connect()
   ' when connection occurs, display a message
   cmdSend.Enabled = True
   txtOutput.Text = "Connected to IP Address: " & _
      tcpClient.RemoteHostIP & vbCrLf & "Port #: " & _
      tcpClient.RemotePort & vbCrLf & vbCrLf
End Sub
Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
   Dim message As String
   Call tcpClient.GetData(message)  ' get data from server
   txtOutput.Text = txtOutput.Text & message & vbCrLf & vbCrLf
   txtOutput.SelStart = Len(txtOutput.Text)
End Sub
Private Sub tcpClient_Close()
   cmdSend.Enabled = False
   Call tcpClient.Close  ' server closed, client should too
   txtOutput.Text = _
      txtOutput.Text & "Server closed connection." & vbCrLf
   txtOutput.SelStart = Len(txtOutput.Text)
End Sub
Private Sub tcpClient_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)
   Dim result As Integer
   result = MsgBox(Source & ": " & Description, _
      vbOKOnly, "TCP/IP Error")
   End
End Sub
Private Sub cmdSend_Click()
   ' send data to server
   Call tcpClient.SendData("CLIENT >>> " & txtSend.Text)
   txtOutput.Text = txtOutput.Text & _
      "CLIENT >>> " & txtSend.Text & vbCrLf & vbCrLf
   txtOutput.SelStart = Len(txtOutput.Text)
   txtSend.Text = ""
End Sub

SERVER CODE:

' A simple server using TCP sockets
Option Explicit
Private Sub Form_Load()
   cmdSend.Enabled = False
   
   ' set up local port and wait for connection
   tcpServer.LocalPort = 5000
   Call tcpServer.Listen
End Sub
Private Sub Form_Resize()
   On Error Resume Next
   Call cmdSend.Move(ScaleWidth - cmdSend.Width, 0)
   Call txtSend.Move(0, 0, ScaleWidth - cmdSend.Width)
   Call txtOutput.Move(0, txtSend.Height, ScaleWidth, _
      ScaleHeight - txtSend.Height)
End Sub
Private Sub Form_Terminate()
   Call tcpServer.Close
End Sub
Private Sub tcpServer_ConnectionRequest( _
      ByVal requestID As Long)
   ' Ensure that tcpServer is closed
   ' before accepting a new connection
   If tcpServer.State <> sckClosed Then
      Call tcpServer.Close
   End If
   
   cmdSend.Enabled = True
   Call tcpServer.Accept(requestID)  ' accept connection
   txtOutput.Text = _
      "Connection from IP address: " & _
      tcpServer.RemoteHostIP & vbCrLf & _
      "Port #: " & tcpServer.RemotePort & vbCrLf & vbCrLf
End Sub
Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long)
   Dim message As String
   Call tcpServer.GetData(message)   ' get data from client
   txtOutput.Text = _
      txtOutput.Text & message & vbCrLf & vbCrLf
   txtOutput.SelStart = Len(txtOutput.Text)
End Sub
Private Sub tcpServer_Close()
   cmdSend.Enabled = False
   Call tcpServer.Close   ' client closed, server should too
   txtOutput.Text = txtOutput.Text & _
      "Client closed connection." & vbCrLf & vbCrLf
   txtOutput.SelStart = Len(txtOutput.Text)
   Call tcpServer.Listen  ' listen for next connection
End Sub
Private Sub tcpServer_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)
   Dim result As Integer
   result = MsgBox(Source & ": " & Description, _
      vbOKOnly, "TCP/IP Error")
   End
End Sub
Private Sub cmdSend_Click()
   ' send data to the client
   Call tcpServer.SendData("SERVER >>> " & txtSend.Text)
   txtOutput.Text = txtOutput.Text & _
      "SERVER >>> " & txtSend.Text & vbCrLf & vbCrLf
   txtSend.Text = ""
   txtOutput.SelStart = Len(txtOutput.Text)
End Sub

[jinojpmathew]

how to connect LAN

[kinwang2009]

Hi One_Trick_Pony,
There is no error in your code.

I find Internet and LAN is different. When you are trying to Connect to Internet your IP will be different from your original IP Address. Such chating facilities should be used on LAN but ofcourse you can use on Internet if your friend know Host IP after connecting Internet (remember this IP will not remain same.).

If you want to know more about this. Try Below.

Go to Start then Click Run.
Type ipconfig /all and click OK
You will see your Original IP Adderess. After connecting to internet again Run ipconfig /all. This time I am sure you will get different IP address.

Hope this helps.

[jason8100]

eeeuhm your internal ip doesn't change every 5 minutes.... and then you can still make your internal ip static on your router config page. same for external ip... you can use a dns like noip.com to update your ip if changed. your external ip may change once a half year.

[mustibh]

maybe this answer to be late.
your problem is connection is not live.i live same problem.
Just add timer and send every 1-2 second ping.
Just send every second ping or you will be disconnected.
example:
function timer1_tick.......
server.send "ping"

[diamondw]

Hey,
i need some guidance.Im working on a project in vba(in excel).I am trying to create a shift cipher(example dog would be fqi)
i want the input to be in an input box(have that part) with the text to be shifted and amount that it will be shifted.The output will be in excel in a 20 column by n row array.I made a function to remove all non alphabetic lower case characters.This is what i have so far(theres a lot of things I just need help finishing and putting it all together).

Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text) = 97 And Asc(Mid(tempText, i, 1)) <= 122 Then '97 is ascii a and 122 is ascii z tempOutput = tempOutput & (Mid(tempText, i, 1)) End If Next i Remove = tempOutput 'outputs the textEnd Function Function ShiftCipher(text, shiftamount) shiftamount = InputBox("Input how many numbers to shift by") Select Case letter Case "a" letter = Chr(97 + shiftamount) Case "b" letter = Chr(98 + shiftamount) Case "c" letter = Chr(99 + shiftamount) Case "d" letter = Chr(100 + shiftamount) Case "e" letter = Chr(101 + shiftamount) Case "f" letter = Chr(102 + shiftamount) Case "g" letter = Chr(103 + shiftamount) Case "h" letter = Chr(104 + shiftamount) Case "i" letter = Chr(105 + shiftamount) Case "j" letter = Chr(106 + shiftamount) Case "k" letter = Chr(107 + shiftamount) Case "l" letter = Chr(108 + shiftamount) Case "m" letter = Chr(109 + shiftamount) Case "n" letter = Chr(110 + shiftamount) Case "o" letter = Chr(111 + shiftamount) Case "p" letter = Chr(112 + shiftamount) Case "q" letter = Chr(113 + shiftamount) Case "r" letter = Chr(114 + shiftamount) Case "s" letter = Chr(115 + shiftamount) Case "t" letter = Chr(116 + shiftamount) Case "u" letter = Chr(117 + shiftamount) Case "v" letter = Chr(118 + shiftamount) Case "w" letter = Chr(119 + shiftamount) Case "x" letter = Chr(120 + shiftamount) Case "y" letter = Chr(121 + shiftamount) Case "z" letter = Chr(122 + shiftamount) End Select ShiftCipher = text + shiftamount End Function" alt="'Ask for dimensions of array and output numbers in arraySub NumberArray() 'this puts up input boxes and then stores the inputs to variables NumRows = InputBox("Input the number of rows.") NumColumns = InputBox("Input the number of columns.") For i = 1 To NumRows ' completes 1 row at a time For j = 1 To NumColumns 'goes through each column 1 at time Cells(i, j).Value = j + (i - 1) * NumColumns Next j Next iEnd Sub 'change all letters to lowercase'remove all non alphabetic charactersFunction Remove(x) tempText = LCase(x) 'change all letters to lowercase For i = 1 To Len(x) 'len is number of characters in the script If Asc(Mid(tempText, i, 1)) >= 97 And Asc(Mid(tempText, i, 1)) <= 122 Then '97 is ascii a and 122 is ascii z tempOutput = tempOutput & (Mid(tempText, i, 1)) End If Next i Remove = tempOutput 'outputs the textEnd Function Function ShiftCipher(text, shiftamount) shiftamount = InputBox("Input how many numbers to shift by") Select Case letter Case "a" letter = Chr(97 + shiftamount) Case "b" letter = Chr(98 + shiftamount) Case "c" letter = Chr(99 + shiftamount) Case "d" letter = Chr(100 + shiftamount) Case "e" letter = Chr(101 + shiftamount) Case "f" letter = Chr(102 + shiftamount) Case "g" letter = Chr(103 + shiftamount) Case "h" letter = Chr(104 + shiftamount) Case "i" letter = Chr(105 + shiftamount) Case "j" letter = Chr(106 + shiftamount) Case "k" letter = Chr(107 + shiftamount) Case "l" letter = Chr(108 + shiftamount) Case "m" letter = Chr(109 + shiftamount) Case "n" letter = Chr(110 + shiftamount) Case "o" letter = Chr(111 + shiftamount) Case "p" letter = Chr(112 + shiftamount) Case "q" letter = Chr(113 + shiftamount) Case "r" letter = Chr(114 + shiftamount) Case "s" letter = Chr(115 + shiftamount) Case "t" letter = Chr(116 + shiftamount) Case "u" letter = Chr(117 + shiftamount) Case "v" letter = Chr(118 + shiftamount) Case "w" letter = Chr(119 + shiftamount) Case "x" letter = Chr(120 + shiftamount) Case "y" letter = Chr(121 + shiftamount) Case "z" letter = Chr(122 + shiftamount) End Select ShiftCipher = text + shiftamount End Function" border="0" />= 97 And Asc(Mid(tempText, i, 1)) <= 122 Then '97 is ascii a and 122 is ascii z tempOutput = tempOutput & (Mid(tempText, i, 1)) End If Next i Remove = tempOutput 'outputs the text End Function Function ShiftCipher(text, shiftamount) shiftamount = InputBox("Input how many numbers to shift by") Select Case letter Case "a" letter = Chr(97 + shiftamount) Case "b" letter = Chr(98 + shiftamount) Case "c" letter = Chr(99 + shiftamount) Case "d" letter = Chr(100 + shiftamount) Case "e" letter = Chr(101 + shiftamount) Case "f" letter = Chr(102 + shiftamount) Case "g" letter = Chr(103 + shiftamount) Case "h" letter = Chr(104 + shiftamount) Case "i" letter = Chr(105 + shiftamount) Case "j" letter = Chr(106 + shiftamount) Case "k" letter = Chr(107 + shiftamount) Case "l" letter = Chr(108 + shiftamount) Case "m" letter = Chr(109 + shiftamount) Case "n" letter = Chr(110 + shiftamount) Case "o" letter = Chr(111 + shiftamount) Case "p" letter = Chr(112 + shiftamount) Case "q" letter = Chr(113 + shiftamount) Case "r" letter = Chr(114 + shiftamount) Case "s" letter = Chr(115 + shiftamount) Case "t" letter = Chr(116 + shiftamount) Case "u" letter = Chr(117 + shiftamount) Case "v" letter = Chr(118 + shiftamount) Case "w" letter = Chr(119 + shiftamount) Case "x" letter = Chr(120 + shiftamount) Case "y" letter = Chr(121 + shiftamount) Case "z" letter = Chr(122 + shiftamount) End Select ShiftCipher = text + shiftamount End Function" alt="'Ask for dimensions of array and output numbers in array Sub NumberArray() 'this puts up input boxes and then stores the inputs to variables NumRows = InputBox("Input the number of rows.") NumColumns = InputBox("Input the number of columns.") For i = 1 To NumRows ' completes 1 row at a time For j = 1 To NumColumns 'goes through each column 1 at time Cells(i, j).Value = j + (i - 1) * NumColumns Next j Next i End Sub

'change all letters to lowercase
'remove all non alphabetic characters
Function Remove(x)
tempText = LCase(x) 'change all letters to lowercase

For i = 1 To Len(x) 'len is number of characters in the script
If Asc(Mid(tempText, i, 1)) >= 97 And Asc(Mid(tempText, i, 1)) <= 122 Then '97 is ascii a and 122 is ascii z
tempOutput = tempOutput & (Mid(tempText, i, 1))
End If
Next i
Remove = tempOutput 'outputs the text
End Function
Function ShiftCipher(text, shiftamount)
shiftamount = InputBox("Input how many numbers to shift by")
Select Case letter
Case "a"
letter = Chr(97 + shiftamount)
Case "b"
letter = Chr(98 + shiftamount)
Case "c"
letter = Chr(99 + shiftamount)
Case "d"
letter = Chr(100 + shiftamount)
Case "e"
letter = Chr(101 + shiftamount)
Case "f"
letter = Chr(102 + shiftamount)
Case "g"
letter = Chr(103 + shiftamount)
Case "h"
letter = Chr(104 + shiftamount)
Case "i"
letter = Chr(105 + shiftamount)
Case "j"
letter = Chr(106 + shiftamount)
Case "k"
letter = Chr(107 + shiftamount)
Case "l"
letter = Chr(108 + shiftamount)
Case "m"
letter = Chr(109 + shiftamount)
Case "n"
letter = Chr(110 + shiftamount)
Case "o"
letter = Chr(111 + shiftamount)
Case "p"
letter = Chr(112 + shiftamount)
Case "q"
letter = Chr(113 + shiftamount)
Case "r"
letter = Chr(114 + shiftamount)
Case "s"
letter = Chr(115 + shiftamount)
Case "t"
letter = Chr(116 + shiftamount)
Case "u"
letter = Chr(117 + shiftamount)
Case "v"
letter = Chr(118 + shiftamount)
Case "w"
letter = Chr(119 + shiftamount)
Case "x"
letter = Chr(120 + shiftamount)
Case "y"
letter = Chr(121 + shiftamount)
Case "z"
letter = Chr(122 + shiftamount)
End Select

ShiftCipher = text + shiftamount



End Function" border="0" />

[Joe Shmoe]

I think you may need to forward the ports on your router.