jrb
Level: Guest
|
Re: Winsock
Hi.
Hopefully the following VB code will bring you one step further!
***************************************************
Startup module
***************************************************
Option Explicit
Sub Main()
frmServer.Show
frmClient.Show
End Sub
***************************************************
frmServer
***************************************************
Option Explicit
' Decide how many clients to support
Private Const MAX_NO_OF_CLIENTS = 1000 ' No more than 32535!
' Characters used for transmitting data
Private Const EOF_Char = "¤"
Private Const SEP_Char = "|"
' Decide which port to listen
Private Const LISTEN_PORT = 4711
' Define client states
Private Enum CLIENT_STATE
Client_Closed = 0
Client_Open = 1
End Enum
' Define client type
Private Type CLIENT_TYPE
Index As Integer
State As CLIENT_STATE
End Type
' Dim Clients as array
Dim Clients() As CLIENT_TYPE
Dim IDNumber As String
Dim Pass As String
Dim Password As String
Dim StrData As String
Dim AppPath As String
Private Sub Form_Load()
ReDim Clients(MAX_NO_OF_CLIENTS)
AppPath = App.Path
If Mid(AppPath, Len(AppPath)) <> "" Then ' Add separator
AppPath = AppPath & ""
End If
With wskClient(0) ' Element 0 (zero) is used to listen for
' connection requests
.LocalPort = LISTEN_PORT
.Listen
End With
End Sub
Private Sub cmdLogin_Click()
CheckForInput
End Sub
Private Function CheckForInput(Optional Index As Integer) As String
If IDNumber = "" Then
CheckForInput = "You must enter a username!"
GoTo ExitNow
End If
Pass = ReadINI(IDNumber, "Password", AppPath & "settings.ini")
If Pass = "" Then
CheckForInput = "Invalid Username"
End If
If Password <> Pass Then
CheckForInput = "Incorrect Password"
End If
ExitNow:
If Index = 0 Then
' cmdLogin is pressed
If CheckForInput <> "" Then
Beep
MsgBox CheckForInput, vbCritical
End If
Else
' Input from client
If wskClient(Index).State = sckConnected Then
If CheckForInput <> "" Then
wskClient(Index).SendData CheckForInput & vbCrLf
Else
wskClient(Index).SendData "Login OK" & vbCrLf
End If
End If
End If
End Function
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim counter As Integer
For counter = 1 To MAX_NO_OF_CLIENTS
With Clients(counter)
If .State = Client_Open Then
wskClient(.Index).Close
Unload wskClient(.Index)
.Index = 0
.State = Client_Closed
End If
End With
Next counter
End Sub
Private Sub wskClient_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim counter As Integer
'
' Index is 0. This is the only winsock object in listen state
'
' Find free entry in client table
'
For counter = 1 To MAX_NO_OF_CLIENTS
With Clients(counter)
If .Index = Client_Closed Then ' Available entry
.Index = counter
.State = Client_Open
txtClientsConnected = txtClientsConnected + 1
Load wskClient(.Index) ' Load new winsocket
wskClient(.Index).Accept requestID ' Accept request
Exit Sub ' and exit sub
End If
End With
Next counter
' Limit has been reached. No more entries. Do not accept request
End Sub
Private Sub wskClient_Close(Index As Integer)
CloseClient Index
End Sub
Private Sub wskClient_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim s As String
Do
wskClient(Index).GetData s, , bytesTotal
StrData = StrData & s
Loop Until s = ""
If InStr(StrData, EOF_Char) Then
'
Do
IDNumber = Mid(StrData, 1, InStr(StrData, SEP_Char) - 1)
Password = Mid(StrData, InStr(StrData, SEP_Char) + 1)
Password = Mid(Password, 1, InStr(Password, EOF_Char) - 1)
CheckForInput Index
StrData = Mid(StrData, InStr(StrData, EOF_Char) + 1)
Loop Until InStr(StrData, EOF_Char) = 0
Else
' Data stream not complete. Exit sub and wait for more
End If
End Sub
Private Sub wskClient_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)
CloseClient Index
End Sub
Private Sub CloseClient(ByVal Index As Integer)
Dim counter As Integer
wskClient(Index).Close
Unload wskClient(Index)
txtClientsConnected = txtClientsConnected - 1
For counter = 1 To MAX_NO_OF_CLIENTS
With Clients(counter)
If Index = .Index Then
.Index = 0
.State = Client_Closed
Exit Sub
End If
End With
Next counter
End Sub
Private Function ReadINI(ByVal UserID As Integer, _
ByVal Section As String, _
ByVal IniPath As String) As String
' Read fromn ini file
End Function
***************************************************
frmClient
***************************************************
Option Explicit
' Characters used for transmitting data
Private Const EOF_Char = "¤"
Private Const SEP_Char = "|"
' Decide which IP and port to connect to
Private Const SERVER_IP = "127.0.0.1"
Private Const SERVER_PORT = 4711
Private Sub cmdLogin_Click()
wskServer.Connect SERVER_IP, SERVER_PORT
End Sub
Private Sub Form_Load()
End Sub
Private Sub wskServer_Connect()
wskServer.SendData txtIDNumber & SEP_Char & txtPassword & EOF_Char
End Sub
Private Sub wskServer_DataArrival(ByVal bytesTotal As Long)
Dim s As String
wskServer.GetData s, , bytesTotal
MsgBox s, vbInformation
wskServer.Close
End Sub
Private Sub wskServer_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)
wskServer.Close
Beep
MsgBox Description, vbCritical
End Sub
|
Winsock
