Sign in to follow this  

winsock and redirecting

This topic is 4713 days old which is more than the 365 day threshold we allow for new replies. Please post a new topic.

If you intended to correct an error in the post then please contact us.

Recommended Posts

i have a dynamic ip and i dont no how to use winsock to connect to a redirector like no-ip.com. I have tried just typin the host name in the remosthost place but it doesnt work. and i have clicked on the ip and port in no-ip.com to test to make sure it was the rigth stuff and my server got the message. any help would be great thx jake

Share this post


Link to post
Share on other sites
Then all you have to do is use winsock and a DNS lookup.. let's see you are jake.noip.com ... then you just connect to jake.noip.com and it does it for you... I could be mistaken, but I'm pretty sure this is how you do it. Others may be able to help better than I.

~zix~

Share this post


Link to post
Share on other sites
welli have tried doing that.


stkClient.RemoteHost = "gneteast.servegame.com"
stkClient.RemotePort = "80"



i got that for setting the host but it doesnt work. I have tried entering no port changing it to commonly used ones, and the one my server monitors. But it doesnt work. When i try and connect with that i get connecting... the server offline (which is supposed to happen when i turn off my server). Then after it fails i usually tell it to connect again ( i tries and connects a couple times then tells the user it cant connect). But then it just says Connecting again for a long time. And never connects.

Share this post


Link to post
Share on other sites
If you "telnet" to the same location, does that work?

C:\> telnet gneteast.servegame.com 80

If that doesn't actually connect, then the problem is in your DNS set-up, or the actual server response code; not in your connection code. Possibly, but not likely, in your firewall.

You can also try ping to that host from the command line, to see if it resolves at all.

Share this post


Link to post
Share on other sites
i did all those things u said and they seemed to work. I was able to ping gneteast.servegame.com, and i think i connected using the telnet thing (when i typed it in it went to a blank screen til i typed soekthing then it went weird).
it could be soething todo with me tho. I am using vb for this and when i connect nothing happens on the server under the ConnectingRequest thing. Also at no-ip.com i can test to see if the redirect is working as well, and it does.

Share this post


Link to post
Share on other sites
well when i try and connect to that site it doesnt work so good. Right after i connect the server state is 4 ( resolvinghost) i dont no wat that means. So after like 3 min its state goes to 7 which could be connected or outofmemory. I would asume that it is out of memory for some reason cause when i try and send some data it gives me and error. so i try adn close it and then it just crashes and i get an error.

Share this post


Link to post
Share on other sites
VB, using the OCX, is simply
socket.remotehost="gneteast.servegame.com"
socket.remoteport=80
socket.connect

forgetting the connect call?? Or maybe a proxy? although I doubt it. If telnet can do it i doubt you would have a problem programming it. Using the TCP protocol, right? That's all I can think of, if your still having problems show us some more code.

~zix~

Share this post


Link to post
Share on other sites
alrite heres the code...


CLIENT
' the user would goto login or create account and the enter the date
' then the program loads frmClient.frm which has all the online code

Private Sub Form_Load()
frmClient.Show
Unload frmCreate
Unload frmLogIn

Log ("Connecting to Ghost.Net...")

Timer1.Enabled = True
Timer2.Enabled = True


' then calls Connect
Connect

Log ("Connected to Ghost.Net")

' all this as u can see is just the creating and login in
If ConnectType = "create" Then
stkClient.SendData "create:" & User.Account & ":" & User.Name & ":" & User.Password
Timer1.Enabled = True
Do
If User.CommandIn = "CS" Then
Log ("Account created!")
frmClient.Caption = "Shooter: " & User.Name
stkClient.SendData "ready"
Timer1.Enabled = False
Exit Do
ElseIf User.CommandIn = "CN" Then
Log ("Name already exists!")
Exit Do
ElseIf User.CommandIn = "CA" Then
Log ("Account already exists!")
Exit Do
ElseIf User.CommandIn = "BANNED" Then
Log ("You have been baned!")
stkClient.Close
Exit Do
Else
DoEvents
End If
Loop
ElseIf ConnectType = "login" Then
stkClient.SendData "login:" & User.Account & ":" & User.Password
Timer1.Enabled = True
Do
If User.CommandIn = "LS" Then
Log ("Loged in!")
stkClient.SendData "requestname"
Timer1.Enabled = False
Exit Do
ElseIf User.CommandIn = "LA" Then
Log ("Incorrect account name!")
Exit Do
ElseIf User.CommandIn = "LP" Then
Log ("Incorrect password!")
Exit Do
ElseIf User.CommandIn = "BANNED" Then
Log ("You have been baned!")
stkClient.Close
Exit Do
Else
DoEvents
End If
Loop
End If
End Sub

Private Sub Connect()
Dim i As Integer

stkClient.RemoteHost = "gneteast.servegame.com"
stkClient.RemotePort = "80"

stkClient.Connect

' when the server sends back a response "connect" then it ends and continues on
Do While User.CommandIn <> "connect"
DoEvents
Loop

Timer1.Enabled = False
End Sub




now for the server code

Private Sub Sock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim iConnection As Integer
Dim arrBuffer() As Byte
Dim lngSize As Long
Dim lngRetVal As Long
Dim lngRows As Long
Dim i As Long
Dim TcpTableRow As MIB_TCPROW

If Index = 0 Then
For i = 1 To NumOfSocks
If Sock(i).State = sckClosed Then
iConnection = i
Exit For
End If
Next i

If iConnection = 0 Then
Info.NumOfClients = Info.NumOfClients + 1

ReDim Preserve Clients(Info.NumOfClients) As ClientAttr

Load Sock(Info.NumOfClients)

NumOfSocks = NumOfSocks + 1

iConnection = Info.NumOfClients
End If

'Set port for this control to 0. (Randomly assigns an available port.)
Sock(iConnection).LocalPort = 0

Sock(iConnection).Accept requestID

Sock(iConnection).SendData "connect"

ReDim Preserve Message(Info.NumOfClients) As String
'
lngSize = 0
'
'Call the GetTcpTable just to get the buffer size into the lngSize variable
lngRetVal = GetTcpTable(ByVal 0&, lngSize, 0)
'
If lngRetVal = ERROR_NOT_SUPPORTED Then
'
Exit Sub
Else
'
'Prepare the buffer
ReDim arrBuffer(0 To lngSize - 1) As Byte
'
'And call the function one more time
lngRetVal = GetTcpTable(arrBuffer(0), lngSize, 0)
'
If lngRetVal = ERROR_SUCCESS Then
'
'The first 4 bytes contain the quantity of the table rows
'Get that value to the lngRows variable
CopyMemory lngRows, arrBuffer(0), 4
'Copy the table row data to the TcpTableRow structure
CopyMemory TcpTableRow, arrBuffer(4 + (Info.NumOfClients) * Len(TcpTableRow)), Len(TcpTableRow)
'
'Add the data to the ListView control
With TcpTableRow
Clients(Info.NumOfClients).IP = GetIpFromLong(.dwLocalAddr)
End With
'
End If
'
End If

Log ("")
Log ("Connection aquired with IP of " & Clients(Info.NumOfClients).IP & "... at " & Time)

RunLog = CopyFile("\RUN.LOG")

Open App.Path & "\RUN.LOG" For Output As #1
For i = 1 To RunLog.LengthOfFile
Print #1, RunLog.strText(i)
Next i

Print #1, ""
Print #1, "Connection aquired with IP of " & Clients(Info.NumOfClients).IP & Time
Close #1
End If
End Sub




if you can see something wrong please tell me and if u can correct it because this is my first time using winsock and i dont no if i am doin it wrong or not

thx in advanced Jake

Share this post


Link to post
Share on other sites
well thats just the connection code thats not all of it, if u want all of it here it is...

SERVER CODE

frmSever.frm

Option Explicit

Dim strText() As String
Dim RunLog As FileAttr
Dim CurMap As Integer
Dim CurUser As Integer
Dim strKick As String
'
Private Type MIB_TCPROW
dwState As Long
dwLocalAddr As Long
dwLocalPort As Long
dwRemoteAddr As Long
dwRemotePort As Long
End Type
'
Private Const ERROR_BUFFER_OVERFLOW = 111&
Private Const ERROR_INVALID_PARAMETER = 87
Private Const ERROR_NO_DATA = 232&
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_SUCCESS = 0&
'
Private Const MIB_TCP_STATE_CLOSED = 1
Private Const MIB_TCP_STATE_LISTEN = 2
Private Const MIB_TCP_STATE_SYN_SENT = 3
Private Const MIB_TCP_STATE_SYN_RCVD = 4
Private Const MIB_TCP_STATE_ESTAB = 5
Private Const MIB_TCP_STATE_FIN_WAIT1 = 6
Private Const MIB_TCP_STATE_FIN_WAIT2 = 7
Private Const MIB_TCP_STATE_CLOSE_WAIT = 8
Private Const MIB_TCP_STATE_CLOSING = 9
Private Const MIB_TCP_STATE_LAST_ACK = 10
Private Const MIB_TCP_STATE_TIME_WAIT = 11
Private Const MIB_TCP_STATE_DELETE_TCB = 12
'
Private Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef pDest As Any, ByRef pSource As Any, ByVal Length As Long)
'

Private Sub cmdKick_Click()
Dim i As Integer

If Info.NumOfClients > 0 Then
For i = 1 To Info.NumOfClients
If Clients(i).Name = strKick Then
Sock(i).Close
Logi ("")
Logi (Clients(i).Name & " the bastard, has been kicked!")
AddToOutgoing (Clients(i).Name & " the bastard, has been kicked!")
End If
Next i
End If
End Sub

Private Sub Command2_Click()
Dim i As Integer

tmrChat.Enabled = False

RunLog = CopyFile("\RUN.LOG")

Open App.Path & "\RUN.LOG" For Output As #2
For i = 1 To RunLog.LengthOfFile
Print #2, RunLog.strText(i)
Next i

Print #2, "Beginning map upload...."
Print #2, ""
Close #2

For i = 1 To Info.NumOfClients
If Sock(i).State = sckConnected Then
Sock(i).SendData ("upload:Server: commencing map upload. The chat will be temporarily disabled. Sorry for this inconvenience.|")
Upload = 4

Do While InStr(Clients(i).CommandIn, "|DONE|") = 0
DoEvents
Loop
Message(i) = ""
End If
Next i

tmrChat.Enabled = True

AddToOutgoing ("|DONE|")
End Sub

Private Sub Command3_Click()
Dim i As Integer

For i = 0 To Info.NumOfClients
If Sock(i).State = sckConnected Then Sock(i).Close
Next i
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim tempStr As String
Dim oFileSystem As New FileSystemObject
Dim oFolder As Folder
Dim oCurrentFile As File
Dim oFileColl As Files
Set oFolder = oFileSystem.GetFolder(App.Path & "\Accounts")
Set oFileColl = oFolder.Files

frmServer.Show

txtLog.Text = "Registering Accounts..."

If oFileColl.Count > 0 Then
For Each oCurrentFile In oFileColl
If Right(oCurrentFile.Name, 4) = ".acc" Then
Info.NumOfAccounts = Info.NumOfAccounts + 1
ReDim Preserve Used(Info.NumOfAccounts) As UsedAttr
Used(Info.NumOfAccounts).Account = Left(oCurrentFile.Name, Len(oCurrentFile.Name) - 4)
Log (" " & Used(Info.NumOfAccounts).Account)

Open App.Path & "\Accounts\" & Used(Info.NumOfAccounts).Account & ".acc" For Input As #1
Line Input #1, Used(Info.NumOfAccounts).Name

Line Input #1, Used(Info.NumOfAccounts).Password

Line Input #1, tempStr
Used(Info.NumOfAccounts).Ban = CBool(tempStr)
Close #1



Log (" Name: " & Used(Info.NumOfAccounts).Name)
Log (" Password: " & Used(Info.NumOfAccounts).Password)
Log (" Baned: " & Used(Info.NumOfAccounts).Ban)
End If
Next
End If

RunLog = CopyFile("\RUN.LOG")

Open App.Path & "\RUN.LOG" For Output As #2
For i = 1 To RunLog.LengthOfFile
Print #2, RunLog.strText(i)
Next i

Print #2, ""
Print #2, "Registering accounts..."

For i = 1 To Info.NumOfAccounts
Print #2, Used(i).Account
Next i

If Info.NumOfAccounts = 0 Then
Log ("No Accounts.")
Log ("Done!")
Print #2, "No Accounts."
Else
Log ("Done!")
End If

Print #2, "Done!"

Close #2

Set oFileSystem = Nothing
Set oFolder = Nothing
Set oFileColl = Nothing
Set oCurrentFile = Nothing

Log ""
Log ("Registering Maps...")

Set oFolder = oFileSystem.GetFolder(App.Path & "\Maps")
Set oFileColl = oFolder.Files

Open App.Path & "\mapdownloads.txt" For Output As #1

If oFileColl.Count > 0 Then
For Each oCurrentFile In oFileColl
If Right(oCurrentFile.Name, 4) = ".exe" Then
Print #1, oCurrentFile.Name
Log (" " & oCurrentFile.Name)
lstDownload.AddItem oCurrentFile.Name
End If
Next
End If

Close #1

Log ("Done!")
Log ""

Set oFileSystem = Nothing
Set oFolder = Nothing
Set oFileColl = Nothing
Set oCurrentFile = Nothing

Sock(0).Close
Sock(0).LocalPort = "5055"
Sock(0).Listen
End Sub

Private Sub Form_Resize()
If frmServer.WindowState = 2 Or frmServer.WindowState = 0 Then
frmServer.WindowState = 0
frmServer.Height = 10665
frmServer.Width = 12225
End If
End Sub

Private Sub Log(ByVal strText As String)
txtLog.Text = strText & vbNewLine & txtLog.Text
End Sub

Private Sub Logi(ByVal strText As String)
txtChat.Text = strText & vbNewLine & txtChat.Text
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer

For i = 0 To Info.NumOfClients
If Sock(i).State = sckConnected Then Sock(i).Close
Next i

End
End Sub

Private Sub lstUsers_Click()
strKick = lstUsers.List(lstUsers.ListIndex)
End Sub

Private Sub Sock_Close(Index As Integer)
If Clients(Index).Name <> "" Then
Log ("")
Log (Clients(Index).Name & " has loged off")

Clients(Index).Ready = False

Dim i As Integer

If Info.NumOfClients > 0 Then
AddToOutgoing (Clients(Index).Name & " has logged off.")
End If
End If

Sock(Index).Close
End Sub

Private Sub Sock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim iConnection As Integer
Dim arrBuffer() As Byte
Dim lngSize As Long
Dim lngRetVal As Long
Dim lngRows As Long
Dim i As Long
Dim TcpTableRow As MIB_TCPROW

If Index = 0 Then
For i = 1 To NumOfSocks
If Sock(i).State = sckClosed Then
iConnection = i
Exit For
End If
Next i

If iConnection = 0 Then
Info.NumOfClients = Info.NumOfClients + 1

ReDim Preserve Clients(Info.NumOfClients) As ClientAttr

Load Sock(Info.NumOfClients)

NumOfSocks = NumOfSocks + 1

iConnection = Info.NumOfClients
End If

'Set port for this control to 0. (Randomly assigns an available port.)
Sock(iConnection).LocalPort = 0

Sock(iConnection).Accept requestID

If lstDownload.List(0) <> "" Then
Dim tempStr As String
tempStr = "connect"

For i = 0 To lstDownload.ListCount
If lstDownload.List(i) <> "" Then
tempStr = tempStr & ":" & lstDownload.List(i)
End If
Next i

Sock(iConnection).SendData tempStr
Else
Sock(iConnection).SendData "connect"
End If

ReDim Preserve Message(Info.NumOfClients) As String
'
lngSize = 0
'
'Call the GetTcpTable just to get the buffer size into the lngSize variable
lngRetVal = GetTcpTable(ByVal 0&, lngSize, 0)
'
If lngRetVal = ERROR_NOT_SUPPORTED Then
'
'This API works only on Win 98//2000 and NT4 with SP4
MsgBox "IP Helper is not supported by this system."
Exit Sub
Else
'
'Prepare the buffer
ReDim arrBuffer(0 To lngSize - 1) As Byte
'
'And call the function one more time
lngRetVal = GetTcpTable(arrBuffer(0), lngSize, 0)
'
If lngRetVal = ERROR_SUCCESS Then
'
'The first 4 bytes contain the quantity of the table rows
'Get that value to the lngRows variable
CopyMemory lngRows, arrBuffer(0), 4
'Copy the table row data to the TcpTableRow structure
CopyMemory TcpTableRow, arrBuffer(4 + (Info.NumOfClients) * Len(TcpTableRow)), Len(TcpTableRow)
'
'Add the data to the ListView control
With TcpTableRow
Clients(Info.NumOfClients).IP = GetIpFromLong(.dwRemoteAddr)
End With
'
End If
'
End If

Log ("")
Log ("Connection aquired with IP of " & Clients(Info.NumOfClients).IP & "... at " & Time)

RunLog = CopyFile("\RUN.LOG")

Open App.Path & "\RUN.LOG" For Output As #1
For i = 1 To RunLog.LengthOfFile
Print #1, RunLog.strText(i)
Next i

Print #1, ""
Print #1, "Connection aquired with IP of " & Clients(Info.NumOfClients).IP & Time
Close #1
End If
End Sub

Private Sub Sock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim i As Integer

Sock(Index).GetData Clients(Index).CommandIn

If InStr(Clients(Index).CommandIn, "|DONE|") <> 0 Then
tmrChat.Enabled = True
Upload = -1
End If

If Upload = 5 Then
If Not Clients(Index).CommandIn = "|COMPLETE|" Then
Put 99, , Clients(Index).CommandIn
Else
Close #99

RunLog = CopyFile("\RUN.LOG")

Open App.Path & "\RUN.LOG" For Output As #2
For i = 1 To RunLog.LengthOfFile
Print #2, RunLog.strText(i)
Next i

Print #2, "Map uploaded: " & Maps.FileName
Close #2

Log (Maps.FileName & " has been successfully uploaded!")
Upload = 4
lstDownload.AddItem Maps.FileName
Sock(Index).SendData "|MAP|"
End If
ElseIf Left(Clients(Index).CommandIn, 6) = "create" Then
Clients(Index).CommandIn = Mid(Clients(Index).CommandIn, 8, Len(Clients(Index).CommandIn))
CreateAccount Index
ElseIf Left(Clients(Index).CommandIn, 5) = "login" Then
Clients(Index).CommandIn = Mid(Clients(Index).CommandIn, 7, Len(Clients(Index).CommandIn))
LogIn Index
ElseIf Left(Clients(Index).CommandIn, 11) = "requestname" Then
Sock(Index).SendData "name:" & Clients(Index).Name
ElseIf Left(Clients(Index).CommandIn, 2) = "CP" Then
For i = 1 To Info.NumOfAccounts
If Used(i).Account = Clients(Index).Account Then
Clients(Index).Password = Mid(Clients(Index).CommandIn, 4, Len(Clients(Index).CommandIn))
Used(i).Password = Clients(Index).Password
Exit For
End If
Next i

Clients(Index).Ready = False
Sock(Index).SendData "|CHANGED|"

Open App.Path & "\Accounts\" & Clients(Index).Account & ".acc" For Output As #1
Print #1, Clients(Index).Name
Print #1, Clients(Index).Password
Print #1, CInt(Used(i).Ban)
Close #1

Clients(Index).Ready = True
ElseIf Left(Clients(Index).CommandIn, 2) = "CN" Then
For i = 1 To Info.NumOfAccounts
If Used(i).Name = Clients(Index).Name Then
Clients(Index).Name = Mid(Clients(Index).CommandIn, 4, Len(Clients(Index).CommandIn))
Used(i).Name = Clients(Index).Name
Exit For
End If
Next i

Clients(Index).Ready = False
Sock(Index).SendData "|CHANGED|"

Open App.Path & "\Accounts\" & Clients(Index).Account & ".acc" For Output As #1
Print #1, Clients(Index).Name
Print #1, Clients(Index).Password
Print #1, CInt(Used(i).Ban)
Close #1

Clients(Index).Ready = True
ElseIf Clients(Index).CommandIn = "close" Then
Clients(Index).Ready = False
ElseIf Clients(Index).CommandIn = "ready" Then
Clients(Index).Ready = True
ElseIf Left(Clients(Index).CommandIn, 6) = "invite" Then
For i = 1 To Info.NumOfClients
If Clients(i).Name = Mid(Clients(Index).CommandIn, 8, Len(Clients(Index).CommandIn)) Then
Message(i) = Clients(Index).Name & " invites you to play a game with them." & vbNewLine & Message(i)
Logi (Clients(Index).Name & " invited " & Clients(i).Name & " to play a game with them.")
Exit For
End If
Next i
ElseIf InStr(Clients(Index).CommandIn, "map:") <> 0 Then
tmrChat.Enabled = False
Maps.FileName = Mid(Clients(Index).CommandIn, InStr(Clients(Index).CommandIn, _
"map:") + 4, Len(Clients(Index).CommandIn))

Dim oFileSystem As New FileSystemObject

If oFileSystem.FileExists(App.Path & "\Maps\" & Maps.FileName) Then
Sock(Index).SendData "willnotdownload:" & Maps.FileName
Log (Maps.FileName & " already exists.")
Else
Sock(Index).SendData "willdownload:" & Maps.FileName
Maps.Download = True
Log ("Will download " & Maps.FileName)
Upload = 5

Pause 400

Open App.Path & "\Maps\" & Maps.FileName For Binary As #99
End If
Else
If Clients(Index).CommandIn <> "|DONE|" Then
AddToOutgoing Clients(Index).CommandIn
Logi (Clients(Index).CommandIn)
End If
End If
End Sub

Private Sub CreateAccount(ByVal i As Integer)
Dim AccountExists As Boolean
Dim NameExists As Boolean
Dim Baned As Boolean
Dim z As Integer

' Set account
Clients(i).Account = Left(Clients(i).CommandIn, InStr(Clients(i).CommandIn, ":") - 1)
Clients(i).CommandIn = Mid(Clients(i).CommandIn, InStr(Clients(i).CommandIn, ":") + 1, Len(Clients(i).CommandIn))

' Set name
Clients(i).Name = Left(Clients(i).CommandIn, InStr(Clients(i).CommandIn, ":") - 1)
Clients(i).CommandIn = Mid(Clients(i).CommandIn, InStr(Clients(i).CommandIn, ":") + 1, Len(Clients(i).CommandIn))

' Set password
Clients(i).Password = Clients(i).CommandIn

If Info.NumOfAccounts <> 0 Then
If i <= Info.NumOfAccounts Then
If Used(i).Ban Then
Baned = True
End If
End If
End If

If Not Baned Then
For z = 1 To Info.NumOfAccounts
If Used(z).Account = Clients(i).Account Then
AccountExists = True
Exit For
End If
Next z

If Not AccountExists Then
For z = 1 To Info.NumOfAccounts
If Used(z).Name = Clients(i).Name Then
NameExists = True
Exit For
End If
Next z

If Not NameExists Then
Sock(i).SendData "CS"

Info.NumOfAccounts = Info.NumOfAccounts + 1
ReDim Preserve Used(Info.NumOfAccounts) As UsedAttr

Used(Info.NumOfAccounts).Account = Clients(i).Account
Used(Info.NumOfAccounts).Name = Clients(i).Name
Used(Info.NumOfAccounts).Password = Clients(i).Password
Used(Info.NumOfAccounts).Ban = False

Log ("")
Log ("Account created...")
Log ("Account: " & Clients(i).Account)
Log ("Name: " & Clients(i).Name)
Log ("Password: " & Clients(i).Password)

RunLog = CopyFile("\RUN.LOG")

Open App.Path & "\RUN.LOG" For Output As #1
For z = 1 To RunLog.LengthOfFile
Print #1, RunLog.strText(z)
Next z

Print #1, ""
Print #1, "Account created..."
Print #1, "Account: " & Clients(i).Account
Print #1, "Name: " & Clients(i).Name
Print #1, "Password: " & Clients(i).Password
Close #1

Open App.Path & "\Accounts\" & Clients(i).Account & ".acc" For Output As #2
Print #2, Clients(i).Name
Print #2, Clients(i).Password
Print #2, 0
Close #2

Clients(i).Ready = True
Else
Sock(i).SendData "CN"
End If
Else
Sock(i).SendData "CA"
End If
Else
Sock(i).SendData "BANNED"
End If
End Sub

Private Sub LogIn(i As Integer)
Dim AccountExists As Boolean
Dim PasswordCorrect As Boolean
Dim Baned As Boolean
Dim z As Integer

' Set account
Clients(i).Account = Left(Clients(i).CommandIn, InStr(Clients(i).CommandIn, ":") - 1)
Clients(i).CommandIn = Mid(Clients(i).CommandIn, InStr(Clients(i).CommandIn, ":") + 1, Len(Clients(i).CommandIn))

' Set name
For z = 1 To Info.NumOfAccounts
If Used(z).Account = Clients(i).Account Then
Clients(i).Name = Used(z).Name
Exit For
End If
Next z

' Set password
Clients(i).Password = Clients(i).CommandIn

If Info.NumOfAccounts <> 0 Then
If Used(z).Account = Clients(i).Account Then
If Used(z).Ban = True Then
Baned = True
End If
End If
End If

If Not Baned Then
For z = 1 To Info.NumOfAccounts
If Used(z).Account = Clients(i).Account Then
AccountExists = True
Exit For
End If
Next z

If AccountExists Then
If Used(z).Password = Clients(i).Password Then
PasswordCorrect = True
End If

If PasswordCorrect Then
Sock(i).SendData "LS"

Log ("")
Log ("Log in...")
Log ("Account: " & Clients(i).Account)
Log ("Name: " & Clients(i).Name)
Log ("Password: " & Clients(i).Password)

RunLog = CopyFile("\RUN.LOG")

Open App.Path & "\RUN.LOG" For Output As #1
For z = 1 To RunLog.LengthOfFile
Print #1, RunLog.strText(z)
Next z

Print #1, ""
Print #1, "Account created..."
Print #1, "Account: " & Clients(i).Account
Print #1, "Name: " & Clients(i).Name
Print #1, "Password: " & Clients(i).Password
Close #1
Else
Sock(i).SendData "LP"
Log ("")
Log ("Failed log in attempt with incorrect password...")
End If
Else
Sock(i).SendData "LA"
Log ("")
Log ("Failed log in attempt with incorrect account...")
End If
Else
Sock(i).SendData "BANNED"
Log ("")
Log ("Failed log in attempt due to being banned...")
End If
End Sub

Private Sub Sock_Error(Index As Integer, 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)
Log ("Socket error on #" & Index & " with error " & Description & ". Source: " & Source)
End Sub

Private Sub tmrChat_Timer()
Static ClientOn As Integer
Static UpgradeType As Integer
Dim i As Integer
Dim strTemp As String
strTemp = "user"


ClientOn = ClientOn + 1

' Updates current chat
If UpgradeType = 0 Then
If Not ClientOn > Info.NumOfClients Then
If Sock(ClientOn).State = sckConnected And Clients(ClientOn).Ready Then
Sock(ClientOn).SendData Message(ClientOn)
Message(ClientOn) = ""
End If
Else
If Upload = 2 Then
Upload = 4
ClientOn = 0
Else
ClientOn = 0
UpgradeType = UpgradeType + 1
End If
End If

' Updates user list
ElseIf UpgradeType = 1 Then
If Not ClientOn > Info.NumOfClients Then
If Sock(ClientOn).State = sckConnected And Clients(ClientOn).Ready Then
For i = 1 To Info.NumOfClients
If Clients(i).Ready Then
strTemp = strTemp & ":" + Clients(i).Name
End If
Next i
Sock(ClientOn).SendData strTemp
End If
Else
ClientOn = 0
UpgradeType = 0
End If
End If
End Sub

Private Sub tmrUser_Timer()
Dim i As Integer

lstUsers.Clear

For i = 1 To Info.NumOfClients
If Clients(i).Ready Then
lstUsers.AddItem Clients(i).Name
End If
Next i
End Sub

Private Sub txtInput_KeyDown(KeyCode As Integer, Shift As Integer)
Dim i As Integer
Dim conn_index As Integer

If txtInput.Text <> "" And KeyCode = 13 Then
Logi ("Server: " & txtInput.Text)

If Info.NumOfClients > 0 Then
AddToOutgoing ("Server: " & txtInput.Text)
End If
txtInput.Text = ""
End If
End Sub

Private Function GetIpFromLong(lngIPAddress As Long) As String
'
Dim arrIpParts(3) As Byte
'
CopyMemory arrIpParts(0), lngIPAddress, 4
'
GetIpFromLong = CStr(arrIpParts(0)) & "." & CStr(arrIpParts(1)) & "." & CStr(arrIpParts(2)) & "." & CStr(arrIpParts(3))
'
End Function

Private Sub Pause(HowLong As Long)
Dim u%, tick As Long
tick = GetTickCount()
Do
u% = DoEvents
Loop Until tick + HowLong < GetTickCount
End Sub

VarDec.bas

Option Explicit

Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Type ClientAttr
Account As String
Name As String
Password As String
CommandIn As String
IP As String
Ready As Boolean
End Type

Public Type UsedAttr
Account As String
Name As String
Ban As Boolean
Password As String
End Type

Public Type InfoAttr
NumOfClients As Integer
NumOfAccounts As Integer
End Type

Public Type FileAttr
strText() As String
LengthOfFile As Integer
End Type

Public Type MapAttr
FileName As String
FileSize As Integer
Download As Boolean
MapID As Integer
End Type

Public Message() As String
Public Clients() As ClientAttr
Public Used() As UsedAttr
'Public Baned() As String
Public Info As InfoAttr
Public NumOfSocks As Integer
Public Upload As Integer
Public Maps As MapAttr

Function CopyFile(ByVal strPath As String) As FileAttr
Dim intLength As Integer
Open App.Path & strPath For Input As #1

Do While Not EOF(1)
intLength = intLength + 1
ReDim Preserve CopyFile.strText(intLength) As String
Line Input #1, CopyFile.strText(intLength)
Loop

Close #1

CopyFile.LengthOfFile = intLength
End Function

Public Sub AddToOutgoing(strText As String)
Dim i As Integer
If Info.NumOfClients > 0 Then
For i = 1 To Info.NumOfClients
If Clients(i).Ready Then
Message(i) = strText & vbNewLine & Message(i)
End If
Next i
End If
End Sub






CLIENT CODE (i have multiple forms but heres the one that uses winsock)


frmClient.frm

Option Explicit

Dim intCount As Integer
Dim UploadCommand As String

Private Sub Command2_Click()
Load frmChangePass
End Sub

Private Sub Command3_Click()
stkClient.SendData User.Name & " has invited someone to play a game!"
End Sub

Private Sub Command5_Click()
stkClient.SendData "invite:" & Invite
Log ("You invited " & Invite & " to play a game with you.")
End Sub

Private Sub Command6_Click()
stkClient.Close
Load Form1
Unload frmClient
End Sub

Private Sub Command7_Click()
Load frmChangeName
End Sub

Private Sub Command8_Click()
End
End Sub

Private Sub Form_Load()
frmClient.Show
Unload frmCreate
Unload frmLogIn

Log ("Connecting to Ghost.Net...")

Timer1.Enabled = True
Timer2.Enabled = True

Connect

Log ("Connected to Ghost.Net")

If ConnectType = "create" Then
stkClient.SendData "create:" & User.Account & ":" & User.Name & ":" & User.Password
Timer1.Enabled = True
Do
If User.CommandIn = "CS" Then
Log ("Account created!")
frmClient.Caption = "Shooter: " & User.Name
stkClient.SendData "ready"
Timer1.Enabled = False
Exit Do
ElseIf User.CommandIn = "CN" Then
Log ("Name already exists!")
Exit Do
ElseIf User.CommandIn = "CA" Then
Log ("Account already exists!")
Exit Do
ElseIf User.CommandIn = "BANNED" Then
Log ("You have been baned!")
stkClient.Close
Timer1.Enabled = False
Pause 2000
End
Else
DoEvents
End If
Loop
ElseIf ConnectType = "login" Then
stkClient.SendData "login:" & User.Account & ":" & User.Password
Timer1.Enabled = True
Do
If User.CommandIn = "LS" Then
Log ("Loged in!")
stkClient.SendData "requestname"
Timer1.Enabled = False
Exit Do
ElseIf User.CommandIn = "LA" Then
Log ("Incorrect account name!")
Exit Do
ElseIf User.CommandIn = "LP" Then
Log ("Incorrect password!")
Exit Do
ElseIf User.CommandIn = "BANNED" Then
Log ("You have been baned!")
stkClient.Close
Timer1.Enabled = False
Pause 2000
End
Else
DoEvents
End If
Loop
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim i As Integer

If stkClient.State = sckConnected Then
stkClient.SendData "close"
End If

tmrEnd.Enabled = True
Cancel = True
End Sub

Private Sub Form_Resize()
If frmClient.WindowState = 0 Or frmClient.WindowState = 2 Then
frmClient.WindowState = 0
frmClient.Width = 11025
frmClient.Height = 9060
End If
End Sub

Private Sub lstUsers_Click()
Invite = lstUsers.List(lstUsers.ListIndex)
End Sub

Private Sub stkClient_DataArrival(ByVal bytesTotal As Long)
stkClient.GetData User.CommandIn

Dim UsersAdd As Boolean
UsersAdd = True

If Uploading Then
UploadCommand = User.CommandIn

If InStr(UploadCommand, "|DONE|") <> 0 Then
UploadCommand = ""
Uploading = False
Log ("Uploading of maps is complete for all clients! Chat has been enabled again.")
End If
Else
If Left(User.CommandIn, 6) = "logoff" Then
Log (Mid(User.CommandIn, 8, Len(User.CommandIn)))
ElseIf Left(User.CommandIn, 4) = "user" Then
ReDim Online(0) As String
NumOnServer = 0
Do While UsersAdd
NumOnServer = NumOnServer + 1
If InStr(User.CommandIn, ":") <> 0 Then
User.CommandIn = Mid(User.CommandIn, InStr(User.CommandIn, ":") + 1, Len(User.CommandIn))
If InStr(User.CommandIn, ":") = 0 Then
ReDim Preserve Online(NumOnServer) As String
Online(NumOnServer) = User.CommandIn
UsersAdd = False
Else
ReDim Preserve Online(NumOnServer) As String
Online(NumOnServer) = Left(User.CommandIn, InStr(User.CommandIn, ":") - 1)
End If
End If
Loop
ElseIf Left(User.CommandIn, 4) = "name" Then
User.Name = Mid(User.CommandIn, 6, Len(User.CommandIn))
frmClient.Caption = "Shooter: " & User.Name
stkClient.SendData "ready"
ElseIf InStr(User.CommandIn, "upload:") <> 0 Then
Log (Mid(User.CommandIn, InStr(User.CommandIn, "upload:") + 7, InStr(User.CommandIn, "|") - 8))
Uploading = True
Upload
Else
If InStr(User.CommandIn, "connect") <> 1 And User.CommandIn <> "LS" And User.CommandIn <> "LA" _
And User.CommandIn <> "LP" And User.CommandIn <> "BANNED" And User.CommandIn <> "CA" And _
User.CommandIn <> "CN" And User.CommandIn <> "CS" And InStr(User.CommandIn, "|CHANGED|") <> 1 Then
LogC (User.CommandIn)
End If
End If
End If
End Sub

Private Sub Connect()
Dim i As Integer

'stkClient.RemoteHost = "gneteast.servegame.com"
'stkClient.RemotePort = "80"
stkClient.RemoteHost = "127.0.0.1"
stkClient.RemotePort = "5055"

stkClient.Connect

Do While InStr(User.CommandIn, "connect") = 0
DoEvents
Loop

Do
If InStr(User.CommandIn, ":") <> 0 Then
User.CommandIn = Mid(User.CommandIn, InStr(User.CommandIn, ":") + 1, Len(User.CommandIn))
If InStr(User.CommandIn, ":") = 0 Then
lstMaps.AddItem User.CommandIn
Exit Do
Else
lstMaps.AddItem Left(User.CommandIn, InStr(User.CommandIn, ":") - 1)
End If
End If
Loop

Timer1.Enabled = False
End Sub

Private Sub stkClient_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)
Log ("Error...")
Log ("Description: " & Description)
Log ("Source: " & Source)
End Sub

Private Sub Timer1_Timer()
intCount = intCount + 1
If intCount < 5 Then
If stkClient.State <> sckConnected Then
If stkClient.State <> sckClosed Then
stkClient.Close
End If
Log ("Connection Attempt " & intCount + 1 & "...")
Connect
End If
Else
MsgBox "Connection has timed out!", vbCritical, "Error"
End
End If
End Sub

Private Sub Log(ByVal strText As String)
txtChat.Text = strText & vbNewLine & txtChat.Text
End Sub

Private Sub LogC(ByVal strText As String)
txtChat.Text = strText & txtChat.Text
End Sub

Private Sub Timer2_Timer()
If stkClient.State <> sckConnected Then
Log ("Server offline")
stkClient.Close
Timer2.Enabled = False
Uploading = False
End If
End Sub

Private Sub tmrEnd_Timer()
If stkClient.State <> sckClosed Then stkClient.Close
End
End Sub

Private Sub tmrUser_Timer()
Dim i As Integer
lstUsers.Clear

For i = 1 To NumOnServer
lstUsers.AddItem Online(i)
Next i
End Sub

Private Sub tmrWait_Timer()
stkClient.SendData "allmapsent"
tmrWait.Enabled = False
End Sub

Private Sub txtOutput_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And txtOutput.Text <> "" And stkClient.State = sckConnected And Not Uploading Then
stkClient.SendData User.Name & ": " & txtOutput.Text
txtOutput.Text = ""
Else
If KeyCode = 13 And Uploading Then
Log ("Chat has been disbaned due to server map uploading...")
txtOutput.Text = ""
End If

If KeyCode = 13 And txtOutput.Text <> "" And txtOutput.Text = "/reconnect" Then
Log ("Connecting to Ghost.Net...")

Timer1.Enabled = True
Timer2.Enabled = True

Connect

Log ("Connected to Ghost.Net")

If ConnectType = "login" Then
stkClient.SendData "login:" & User.Account & ":" & User.Password
Timer1.Enabled = True
Do
If User.CommandIn = "LS" Then
Log ("Loged in!")
stkClient.SendData "requestname"
Timer1.Enabled = False
Exit Do
ElseIf User.CommandIn = "LA" Then
Log ("Incorrect account name!")
Exit Do
ElseIf User.CommandIn = "LP" Then
Log ("Incorrect password!")
Exit Do
ElseIf User.CommandIn = "BANNED" Then
Log ("You have been baned!")
stkClient.Close
Exit Do
Else
DoEvents
End If
Loop
End If
txtOutput.Text = ""
End If
End If
End Sub

Private Sub Pause(HowLong As Long)
Dim u%, tick As Long
tick = GetTickCount()
Do
u% = DoEvents
Loop Until tick + HowLong < GetTickCount
End Sub

Private Sub Upload()
Log ("Server requesting maps...")

Dim i As Integer
Dim TempStr As String
Dim oFileSystem As New FileSystemObject
Dim oFolder As Folder
Dim oCurrentFile As File
Dim oFileColl As Files
Set oFolder = oFileSystem.GetFolder(App.Path & "\Data")
Set oFileColl = oFolder.Files

If oFileColl.Count > 0 Then
For Each oCurrentFile In oFileColl
If Right(oCurrentFile.Name, 4) = ".exe" Then
If oCurrentFile.Name <> "Error.exe" Then
Log ("Checking if " & oCurrentFile.Name & " exist on server...")
stkClient.SendData "map:" & oCurrentFile.Name
Pause 500
Do
If InStr(UploadCommand, "willdownload:") <> 0 Then
Log (Mid(UploadCommand, InStr(UploadCommand, "willdownload:") + 13, Len(UploadCommand)) & " does not exist. Will be downloaded.")
Log (Mid(UploadCommand, InStr(UploadCommand, "willdownload:") + 13, Len(UploadCommand)) & " is downloading...")

Dim LenFile As Long
Dim nCnt As Long
Dim LocData As String
Dim MapName As String

MapName = Mid(UploadCommand, InStr(UploadCommand, "willdownload:") + 13, Len(UploadCommand))

Open App.Path & "\Data\" & MapName For Binary As #99
DoEvents
nCnt = 1
LenFile = LOF(99)
DoEvents
Do Until nCnt >= (LenFile)
LocData = Space$(1024)
Get #99, nCnt, LocData
If nCnt + 1024 > LenFile Then
stkClient.SendData Mid$(LocData, 1, (LenFile - (nCnt - 1)))
Else
stkClient.SendData LocData
End If
DoEvents
nCnt = nCnt + 1024
Loop
Close #99

Log (MapName & " has been downloaded!")
stkClient.SendData "|COMPLETE|"

Do While InStr(UploadCommand, "|MAP|") = 0
DoEvents
Loop

Exit Do
ElseIf InStr(UploadCommand, "willnotdownload:") <> 0 Then
Log (Mid(UploadCommand, InStr(UploadCommand, "willnotdownload:") + 16, Len(UploadCommand)) & " will not be downloaded.")
Exit Do
End If

DoEvents
Loop
End If
End If
Next
Pause 1000
End If
stkClient.SendData " |DONE|"
End Sub





also in this i am using my local address for testing

Share this post


Link to post
Share on other sites

This topic is 4713 days old which is more than the 365 day threshold we allow for new replies. Please post a new topic.

If you intended to correct an error in the post then please contact us.

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

Sign in to follow this