ZorkNo
asked on
Send and recive command arguments trough Winsock (TCP) - Client & server
I need a two programs that read, send and save command arguments - server and client.
The client: (client.exe)
Read argument from external program, send the argument to the server. Recive string from the server and save returned data to a file - overwrite to the file every time.
I got a script program(procom) that sends out an argument to the client.exe file ex: "client.exe 1234 4321"
The client should then send the "1234 4321" argument to the server.
The server: (server.exe)
The server.exe file should then recive and give the argument string "1234 4321" to an other program.exe, ex: "program.exe 1234 4321"
the program.exe returns a string - the server should then recive this and return it to the client.exe - the client.exe shuld then write this string to a file ex: "string.txt" localy
The program.exe
The command arguments that's used now. ex: program.exe 1234 4321>string.txt
the string.txt file is now moved to the computer.
The hard part:
The server.exe must recive multiple connections. Up to 25 clients. -
It shuld check if the data was sendt correctly.
How far am I?
I have used the Winsock and got connections on my local computer. (client / server)
I have used the command() to get the argument from the external program (program.exe)
I can send the argument string from the client.exe to the server.exe winsock1.senddata
I can recive the argument in the server.exe - winsock1.getdata
The client: (client.exe)
Read argument from external program, send the argument to the server. Recive string from the server and save returned data to a file - overwrite to the file every time.
I got a script program(procom) that sends out an argument to the client.exe file ex: "client.exe 1234 4321"
The client should then send the "1234 4321" argument to the server.
The server: (server.exe)
The server.exe file should then recive and give the argument string "1234 4321" to an other program.exe, ex: "program.exe 1234 4321"
the program.exe returns a string - the server should then recive this and return it to the client.exe - the client.exe shuld then write this string to a file ex: "string.txt" localy
The program.exe
The command arguments that's used now. ex: program.exe 1234 4321>string.txt
the string.txt file is now moved to the computer.
The hard part:
The server.exe must recive multiple connections. Up to 25 clients. -
It shuld check if the data was sendt correctly.
How far am I?
I have used the Winsock and got connections on my local computer. (client / server)
I have used the command() to get the argument from the external program (program.exe)
I can send the argument string from the client.exe to the server.exe winsock1.senddata
I can recive the argument in the server.exe - winsock1.getdata
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Be VERY careful using the WaitForSingleObject API with the INFINITE setting, as it causes the calling thread to HALT until the object you are waiting for has finished.
Who cares? Well, when your app halts, it will no longer process messages, included ones intended for your Winsock control. This will result in your app not being able to receive any new clients or respond to any existing ones while you are waiting for program.exe to finish. I haven't played with this type of scenario in a while so I don't remember if the messages get queued or if they are just lost.
I can show you how to use the WaitForSingleObject API without causing your app to halt if you like.
Idle_Mind
Who cares? Well, when your app halts, it will no longer process messages, included ones intended for your Winsock control. This will result in your app not being able to receive any new clients or respond to any existing ones while you are waiting for program.exe to finish. I haven't played with this type of scenario in a while so I don't remember if the messages get queued or if they are just lost.
I can show you how to use the WaitForSingleObject API without causing your app to halt if you like.
Idle_Mind
Which part specifically do you want to attack first?
ASKER
I would be nice if you could show me how to "get" the data from the "program.exe" file.
And what to be careful of.. The program can't stop... Could the server put the "client" data in mem so it would be processed when the "program.exe" is ready for the next input? and so on..
And what to be careful of.. The program can't stop... Could the server put the "client" data in mem so it would be processed when the "program.exe" is ready for the next input? and so on..
You should be able to open and read the file normaly, like any other text file
Dim lngFile As Long
Dim strContents As String
strPath = "C:\Dir" ' You will need to adjust this to your working directory
strFile = strPath & "\string.txt"
If Dir$(strFile) <> "" Then
lngFile = FreeFile
Open strFile For Input As #lngFile
Do While Not EOF(lngFile)
Line Input #lngFile, strContents
' process line from file
Loop
Close #lngFile
End If
Dim lngFile As Long
Dim strContents As String
strPath = "C:\Dir" ' You will need to adjust this to your working directory
strFile = strPath & "\string.txt"
If Dir$(strFile) <> "" Then
lngFile = FreeFile
Open strFile For Input As #lngFile
Do While Not EOF(lngFile)
Line Input #lngFile, strContents
' process line from file
Loop
Close #lngFile
End If
ASKER
Hi.
I have been looking around on the net for a while now, searching for some of the clues you have posted (WaitForSingleObject did open a lot of doors for me). I think i got the problem solved. The program is still in the beta-stage, but it seems to be working. Would you like to se the sourcecode posted her? And i hope you can give me some tips for improvement..
There is some functions i would like to add, but i have to search some more on the net, and see if i could figure it out myself..
Thanks..
I have been looking around on the net for a while now, searching for some of the clues you have posted (WaitForSingleObject did open a lot of doors for me). I think i got the problem solved. The program is still in the beta-stage, but it seems to be working. Would you like to se the sourcecode posted her? And i hope you can give me some tips for improvement..
There is some functions i would like to add, but i have to search some more on the net, and see if i could figure it out myself..
Thanks..
Sure, I'd be interested in seeing it. (If you open each file with notepad and post everything, it would include your layout and control selection along with your code. Just separate the contents of the files somehow : )
ASKER
This is the Client.exe
The layout is for test only.. In the working version there is no visible form for the client.
The FrmFile:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC- 0080C7E7B7 8D}#1.0#0" ; "MSWINSCK.OCX"
Begin VB.Form frmClient
Caption = "RK Client"
ClientHeight = 1965
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 1965
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdConnect
Caption = "Connect"
Height = 375
Left = 3240
TabIndex = 2
Top = 720
Visible = 0 'False
Width = 1455
End
Begin VB.TextBox txtOutput
Height = 375
Left = 120
MultiLine = -1 'True
TabIndex = 1
Text = "frmClient.frx":0000
Top = 1320
Visible = 0 'False
Width = 4215
End
Begin VB.TextBox txtSend
Height = 375
Left = 720
TabIndex = 0
Text = "Text1"
Top = 120
Visible = 0 'False
Width = 3015
End
Begin MSWinsockLib.Winsock tcpClient
Left = 3840
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label Label1
Caption = "Label1"
Height = 495
Left = 240
TabIndex = 3
Top = 720
Width = 4095
End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdConnect_Click()
' Invoke the Connect method to initiate a
' connection.
'tcpClient.Connect
End Sub
Private Sub Form_Activate()
'MsgBox "Formload"
Dim txtSendText As String
Dim txtTempText As String
Dim CommandSelv As String
'txtSendText = """" & Command() & """"
'txtTempText = "c:\test_ttc\rel_k\rk.exe" & " " & Command() ' String som kjøres
If Command() = "" Then
frmClient.Show
Label1.Caption = "Programmet her stoppet pga. sikkerhetsmessige grunner"
'MsgBox "Det sendes ikke parameter fra Procom - Start på nytt"
CommandSelv = InputBox("Det sendes ikke parameter fra Procom - Tast inn nr: - Blank for å avslutte!")
If CommandSelv = "" Then
End
Else
'txtTempText = "c:\winnt\system32\help.ex e" & " " & CommandSelv
txtTempText = "c:\test_ttc\rel_k\rk.exe" & " " & CommandSelv ' String som kjøres
End If
Else
frmClient.Hide
'txtTempText = "c:\winnt\system32\help.ex e" & " " & Command()
txtTempText = "c:\test_ttc\rel_k\rk.exe" & " " & Command() ' String som kjøres
End If
'MsgBox txtTempText
txtSendText = """" & txtTempText & """"
'txtSendText = "c:\winnt\system32\help.ex e help"
'MsgBox txtSendText
'Do While tcpClient.State <> 7
'MsgBox tcpClient.State & "Command blir sendt over TCP til Server: " & txtSendText
'Loop
'Legges i en timer......
Dim strState As String
Select Case tcpClient.State
Case sckClosed
strState = "Closed"
Case sckOpen
strState = "Open"
Case sckListening
strState = "Listening"
Case sckConnectionPending
strState = "Connection pending"
Case sckResolvingHost
strState = "Resolving host"
Case sckHostResolved
strState = "Host resolved"
Case sckConnecting
strState = "Connecting"
Case sckConnected
strState = "Connected"
Case sckClosing
strState = "Peer is closing the connection"
Case sckError
strState = "Error"
End Select
Label1.Caption = strState
If tcpClient.State <> 7 Then
MsgBox strState
ElseIf tcpClient.State = 7 Then
tcpClient.SendData txtSendText
'MsgBox strState
Label1.Caption = "Data sendt - venter på retur"
Else
'------------------------- ---------- ----------
'ElseIf tcpClient.State = 0 Or 9 Then
'
' Dim Msg, Style, Title, Help, Ctxt, Response, MyString
' Msg = "Start server og prøv på nytt!" ' Define message.
' Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
' Title = "Serverfeil - Er den startet?" ' Define title.
' Response = MsgBox(Msg, Style, Title, Help, Ctxt)
'
' If Response = vbYes Then ' User chose Yes.
' Call Form_Activate ' Perform some action.
' Else ' User chose No.
' 'MyString = "No" ' Perform some action.
' End If
End If
End Sub
Private Sub Form_Load()
If App.PrevInstance Then End
Open "G:\FELLES\Ttctest\RK client - server\Tor ver\ip.txt" For Input As #1
'Open "c:\test.txt" For Input As #1
Line Input #1, ip
Close #1
'tcpClient.RemoteHost = "192.168.12.251"
tcpClient.RemoteHost = ip
tcpClient.RemotePort = "10101" '1001 Orginal
tcpClient.Connect
End Sub
Private Sub Form_Terminate()
'MsgBox tcpClient.State
tcpClient.Close
End Sub
Private Sub Form_Unload(Cancel As Integer)
tcpClient.Close
End Sub
Private Sub tcpClient_DataArrival(ByVa l bytesTotal As Long)
Dim strData As String
tcpClient.GetData strData
txtOutput.Text = strData
'txtSendText = "Close connection from: " & tcpClient.LocalIP
'MsgBox txtSendText
'tcpClient.SendData txtSendText
Label1.Caption = "Data mottatt"
tcpClient.Close
Open ("c:\rk.txt") For Output As #1
Print #1, strData
Close #1
'MsgBox "Sjekk fil"
'MsgBox "Client-state DataArrival: " & tcpClient.State
End
End Sub
'_________________________ __________ __________ __________ __________ __________ __________ _______
'Private Sub txtSend_KeyDown(KeyCode As Integer, Shift As Integer)
'Dim txtSendText As String
'If KeyCode = 13 Then
'txtSendText = """" & Command() & """"
'txtSendText = """" & txtSend.Text & """"
'Else
'End If
'End Sub
End of FrmFile
__________________________ __________ __________ __________ __________ __________ __________ __________ ______
The project file
Type=Exe
Reference=*\G{00020430-000 0-0000-C00 0-00000000 0046}#2.0# 0#C:\WINNT \system32\ stdole2.tl b#OLE Automation
Object={248DD890-BB45-11CF -9ABC-0080 C7E7B78D}# 1.0#0; MSWINSCK.OCX
Form=frmClient.frm
IconForm="frmClient"
Startup="frmClient"
HelpFile=""
Title="RK_Client"
ExeName32="Client 11-62.exe"
Command32=""
Name="RK_Client"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1
end of projectfile
The layout is for test only.. In the working version there is no visible form for the client.
The FrmFile:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-
Begin VB.Form frmClient
Caption = "RK Client"
ClientHeight = 1965
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 1965
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdConnect
Caption = "Connect"
Height = 375
Left = 3240
TabIndex = 2
Top = 720
Visible = 0 'False
Width = 1455
End
Begin VB.TextBox txtOutput
Height = 375
Left = 120
MultiLine = -1 'True
TabIndex = 1
Text = "frmClient.frx":0000
Top = 1320
Visible = 0 'False
Width = 4215
End
Begin VB.TextBox txtSend
Height = 375
Left = 720
TabIndex = 0
Text = "Text1"
Top = 120
Visible = 0 'False
Width = 3015
End
Begin MSWinsockLib.Winsock tcpClient
Left = 3840
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label Label1
Caption = "Label1"
Height = 495
Left = 240
TabIndex = 3
Top = 720
Width = 4095
End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdConnect_Click()
' Invoke the Connect method to initiate a
' connection.
'tcpClient.Connect
End Sub
Private Sub Form_Activate()
'MsgBox "Formload"
Dim txtSendText As String
Dim txtTempText As String
Dim CommandSelv As String
'txtSendText = """" & Command() & """"
'txtTempText = "c:\test_ttc\rel_k\rk.exe"
If Command() = "" Then
frmClient.Show
Label1.Caption = "Programmet her stoppet pga. sikkerhetsmessige grunner"
'MsgBox "Det sendes ikke parameter fra Procom - Start på nytt"
CommandSelv = InputBox("Det sendes ikke parameter fra Procom - Tast inn nr: - Blank for å avslutte!")
If CommandSelv = "" Then
End
Else
'txtTempText = "c:\winnt\system32\help.ex
txtTempText = "c:\test_ttc\rel_k\rk.exe"
End If
Else
frmClient.Hide
'txtTempText = "c:\winnt\system32\help.ex
txtTempText = "c:\test_ttc\rel_k\rk.exe"
End If
'MsgBox txtTempText
txtSendText = """" & txtTempText & """"
'txtSendText = "c:\winnt\system32\help.ex
'MsgBox txtSendText
'Do While tcpClient.State <> 7
'MsgBox tcpClient.State & "Command blir sendt over TCP til Server: " & txtSendText
'Loop
'Legges i en timer......
Dim strState As String
Select Case tcpClient.State
Case sckClosed
strState = "Closed"
Case sckOpen
strState = "Open"
Case sckListening
strState = "Listening"
Case sckConnectionPending
strState = "Connection pending"
Case sckResolvingHost
strState = "Resolving host"
Case sckHostResolved
strState = "Host resolved"
Case sckConnecting
strState = "Connecting"
Case sckConnected
strState = "Connected"
Case sckClosing
strState = "Peer is closing the connection"
Case sckError
strState = "Error"
End Select
Label1.Caption = strState
If tcpClient.State <> 7 Then
MsgBox strState
ElseIf tcpClient.State = 7 Then
tcpClient.SendData txtSendText
'MsgBox strState
Label1.Caption = "Data sendt - venter på retur"
Else
'-------------------------
'ElseIf tcpClient.State = 0 Or 9 Then
'
' Dim Msg, Style, Title, Help, Ctxt, Response, MyString
' Msg = "Start server og prøv på nytt!" ' Define message.
' Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
' Title = "Serverfeil - Er den startet?" ' Define title.
' Response = MsgBox(Msg, Style, Title, Help, Ctxt)
'
' If Response = vbYes Then ' User chose Yes.
' Call Form_Activate ' Perform some action.
' Else ' User chose No.
' 'MyString = "No" ' Perform some action.
' End If
End If
End Sub
Private Sub Form_Load()
If App.PrevInstance Then End
Open "G:\FELLES\Ttctest\RK client - server\Tor ver\ip.txt" For Input As #1
'Open "c:\test.txt" For Input As #1
Line Input #1, ip
Close #1
'tcpClient.RemoteHost = "192.168.12.251"
tcpClient.RemoteHost = ip
tcpClient.RemotePort = "10101" '1001 Orginal
tcpClient.Connect
End Sub
Private Sub Form_Terminate()
'MsgBox tcpClient.State
tcpClient.Close
End Sub
Private Sub Form_Unload(Cancel As Integer)
tcpClient.Close
End Sub
Private Sub tcpClient_DataArrival(ByVa
Dim strData As String
tcpClient.GetData strData
txtOutput.Text = strData
'txtSendText = "Close connection from: " & tcpClient.LocalIP
'MsgBox txtSendText
'tcpClient.SendData txtSendText
Label1.Caption = "Data mottatt"
tcpClient.Close
Open ("c:\rk.txt") For Output As #1
Print #1, strData
Close #1
'MsgBox "Sjekk fil"
'MsgBox "Client-state DataArrival: " & tcpClient.State
End
End Sub
'_________________________
'Private Sub txtSend_KeyDown(KeyCode As Integer, Shift As Integer)
'Dim txtSendText As String
'If KeyCode = 13 Then
'txtSendText = """" & Command() & """"
'txtSendText = """" & txtSend.Text & """"
'Else
'End If
'End Sub
End of FrmFile
__________________________
The project file
Type=Exe
Reference=*\G{00020430-000
Object={248DD890-BB45-11CF
Form=frmClient.frm
IconForm="frmClient"
Startup="frmClient"
HelpFile=""
Title="RK_Client"
ExeName32="Client 11-62.exe"
Command32=""
Name="RK_Client"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1
end of projectfile
ASKER
This is the Server.
fMain file
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC- 0000F8754D A1}#2.0#0" ; "MSCOMCTL.OCX"
Begin VB.Form fMain
AutoRedraw = -1 'True
Caption = "WinsockArray echo server"
ClientHeight = 6930
ClientLeft = 60
ClientTop = 345
ClientWidth = 9285
Icon = "fMain.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 6930
ScaleWidth = 9285
StartUpPosition = 2 'CenterScreen
Begin VB.CheckBox chkDataEvents
Caption = "Show data events"
Height = 255
Left = 5160
TabIndex = 8
Top = 4680
Width = 2655
End
Begin VB.Timer tmrProperties
Interval = 100
Left = 7920
Top = 4680
End
Begin VB.ListBox lstEvents
Height = 1815
Left = 0
TabIndex = 4
Top = 2760
Width = 7695
End
Begin VB.CommandButton cmdStopServer
Caption = "Stop server"
Height = 375
Left = 1320
TabIndex = 2
Top = 4800
Width = 1095
End
Begin VB.CommandButton cmdStartServer
Caption = "Start server"
Height = 375
Left = 120
TabIndex = 1
Top = 4800
Width = 1095
End
Begin MSComctlLib.ListView lvwClients
Height = 2655
Left = 0
TabIndex = 0
Top = 0
Width = 7695
_ExtentX = 13573
_ExtentY = 4683
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin WinsockServer.WinsockArray WinsockArray1
Left = 7800
Top = 3960
_ExtentX = 847
_ExtentY = 847
End
Begin VB.Label lblSocketCount
Caption = "SocketCount"
Height = 255
Left = 5160
TabIndex = 7
Top = 5040
Width = 2535
End
Begin VB.Label lblBytesReceived
Caption = "Bytes Received:"
Height = 255
Left = 2520
TabIndex = 6
Top = 5040
Width = 2655
End
Begin VB.Label lblBytesSent
Caption = "Bytes Sent:"
Height = 255
Left = 2520
TabIndex = 5
Top = 4800
Width = 2535
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fixed Single
Caption = "Offline"
ForeColor = &H000000FF&
Height = 255
Left = 0
TabIndex = 3
Top = 5640
Width = 2295
End
End
Attribute VB_Name = "fMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdStartServer_Click()
'
With WinsockArray1
'
.MaxClients = 1 '25
.RaiseErrors = True
.LocalPort = 10101
'
If (.StartListening = False) Then
Call lstEvents.AddItem("Start() failed")
Else
With lblStatus
.Caption = "Online"
.ForeColor = vbBlue
End With
End If
'
End With
'
End Sub
Private Sub cmdStopServer_Click()
'
If (WinsockArray1.Shutdown) Then
'
With lblStatus
.Caption = "Offline"
.ForeColor = vbRed
End With
'
lvwClients.ListItems.Clear
'
Else
Call lstEvents.AddItem("Shutdow n() failed")
End If
'
End Sub
Private Sub Form_Load()
'
With lvwClients
.View = lvwReport
Call .ColumnHeaders.Add(, , "Index")
Call .ColumnHeaders.Add(, , "State")
Call .ColumnHeaders.Add(, , "RemoteHost")
Call .ColumnHeaders.Add(, , "RemoteHostIP")
Call .ColumnHeaders.Add(, , "RemotePort")
Call .ColumnHeaders.Add(, , "Error")
End With
'
End Sub
Private Sub Form_Resize()
'
On Error Resume Next
'
With lblStatus
.Top = Me.ScaleHeight - .Height
.Width = Me.ScaleWidth
End With
'
With cmdStartServer
.Top = Me.ScaleHeight - lblStatus.Height - .Height - 100
cmdStopServer.Top = .Top
End With
'
With lvwClients
.Width = Me.ScaleWidth
.Height = (Me.ScaleHeight \ 3) * 2
End With
'
With lstEvents
.Width = Me.ScaleWidth
.Top = lvwClients.Height + 50
.Height = Me.ScaleHeight - lvwClients.Height - 850
End With
'
With lblBytesSent
.Top = lvwClients.Height + lstEvents.Height + 100
End With
With lblBytesReceived
.Top = lvwClients.Height + lstEvents.Height + lblBytesSent.Height + 100
End With
With lblSocketCount
.Top = lvwClients.Height + lstEvents.Height + lblBytesSent.Height + 100
End With
With chkDataEvents
.Top = lvwClients.Height + lstEvents.Height + 100
End With
'
End Sub
Private Sub tmrProperties_Timer()
'
With WinsockArray1
lblBytesSent.Caption = "Bytes sent: " & .BytesSent
lblBytesReceived.Caption = "Bytes received: " & .BytesReceived
lblSocketCount.Caption = "Socket count: " & .SocketCount
End With
'
End Sub
Private Sub WinsockArray1_ConnectionCl osed(ByVal lngIndex As Long)
'
Dim objList As ListItem
Dim i As Long
'
For i = 1 To lvwClients.ListItems.Count
If (lvwClients.ListItems(i).T ext = CStr(lngIndex)) Then
Set objList = lvwClients.ListItems(i)
Exit For
End If
Next i
'
If (Not objList Is Nothing) Then
objList.SubItems(1) = "Closed"
objList.SubItems(2) = "---"
objList.SubItems(3) = "---"
objList.SubItems(4) = "---"
End If
'
End Sub
Private Sub WinsockArray1_DataArrival( ByVal lngIndex As Long, ByVal strData As String)
'
If (chkDataEvents.Value) Then
Call lstEvents.AddItem("Data on client " & lngIndex & " : " & strData)
lstEvents.ListIndex = lstEvents.ListCount - 1
End If
'
Call WinsockArray1.Send(lngInde x, strData)
'
End Sub
Private Sub WinsockArray1_NewConnectio n(ByVal lngIndex As Long, blnCancel As Boolean)
'
Dim objList As ListItem
Dim i As Long
'
For i = 1 To lvwClients.ListItems.Count
If (lvwClients.ListItems(i).T ext = CStr(lngIndex)) Then
Set objList = lvwClients.ListItems(i)
Exit For
End If
Next i
'
If (objList Is Nothing) Then
Set objList = lvwClients.ListItems.Add(, , lngIndex)
End If
With objList
.SubItems(1) = "Connected"
.SubItems(2) = WinsockArray1.RemoteHost(l ngIndex)
.SubItems(3) = WinsockArray1.RemoteHostIP (lngIndex)
.SubItems(4) = WinsockArray1.RemotePort(l ngIndex)
.SubItems(5) = ""
End With
Set objList = Nothing
'
End Sub
Private Sub WinsockArray1_WinsockError (ByVal lngIndex As Long, ByVal lngNumber As Long, ByVal strSource As String, ByVal strDescription As String)
'
Dim objList As ListItem
Dim i As Long
'
Call lstEvents.AddItem("Error on client " & lngIndex & " : " & strDescription)
lstEvents.ListIndex = lstEvents.ListCount - 1
'
If (lngIndex > 0) Then
'
For i = 1 To lvwClients.ListItems.Count
If (lvwClients.ListItems(i).T ext = CStr(lngIndex)) Then
Set objList = lvwClients.ListItems(i)
Exit For
End If
Next i
'
If (Not objList Is Nothing) Then
objList.SubItems(1) = "Closed"
objList.SubItems(2) = "---"
objList.SubItems(3) = "---"
objList.SubItems(4) = "---"
objList.SubItems(5) = strDescription
End If
'
End If
'
End Sub
End of fMain file
-------------------------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
The project file:
Type=Exe
Form=..\..\..\..\temp\wins ockserver1 \fMain.frm
Reference=*\G{00020430-000 0-0000-C00 0-00000000 0046}#2.0# 0#..\..\.. \..\WINNT\ system32\s tdole2.tlb #OLE Automation
UserControl=..\..\..\..\te mp\winsock server1\Wi nsockArray .ctl
Object={248DD890-BB45-11CF -9ABC-0080 C7E7B78D}# 1.0#0; MSWINSCK.OCX
Object={831FDD16-0C5C-11D2 -A9FC-0000 F8754DA1}# 2.0#0; MSCOMCTL.OCX
IconForm="fMain"
Startup="fMain"
ExeName32="tcpServer.exe"
Path32="..\Tor ver"
Command32=""
Name="WinsockServer"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1
End of project file
-------------------------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -
The WinSockArray.ctl file (userControl)
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC- 0080C7E7B7 8D}#1.0#0" ; "MSWINSCK.OCX"
Begin VB.UserControl WinsockArray
ClientHeight = 810
ClientLeft = 0
ClientTop = 0
ClientWidth = 1245
InvisibleAtRuntime= -1 'True
ScaleHeight = 810
ScaleWidth = 1245
ToolboxBitmap = "WinsockArray.ctx":0000
Begin MSWinsockLib.Winsock Winsocks
Index = 0
Left = 600
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Image imgIcon
Height = 480
Left = 0
Picture = "WinsockArray.ctx":0312
Stretch = -1 'True
Top = 0
Width = 480
End
End
Attribute VB_Name = "WinsockArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Declare Function CreatePipe Lib "kernel32" ( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
Private Declare Function ReadFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As Any, lpProcessInformation As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const NORMAL_PRIORITY_CLASS = &H20& 'private
Const STARTF_USESTDHANDLES = &H100& 'private
Const STARTF_USESHOWWINDOW = &H1 'private
Const SW_HIDE = 0 'private
'
' -------------------------- ---------- ---------- ---------- ---------- ---------- ---
' File...........: WinsockArray.ctl
' Author.........: Will Barden
' Created........: 16/05/03
' Modified.......: 30/06/03
' Version........: 1.3
' Website........: http://www.WinsockVB.com
' Contact........: admin@winsockvb.com
'
' Completely rewritten WinsockArray usercontrol. Handles a control array of
' MS Winsock objects, and manages events between them and the parent.
'
' The LastError property is only used when RaiseErrors is turned off.
'
' All the methods will return a boolean value, and may raise errors is
' RaiseErrors is turned on.
'
' No direct access to the clients is given to the parent, since it could give
' rise to situations that mess up internal usercontrol counters, and won't allow
' raising of proper events to the parent.
'
' MaxClients is used to limit the amount of concurrent clients (and also the
' number of Winsock objects loaded into the array).
'
' If any error is fired during the use of a particular Winsock object, it is
' closed and the client disconnected.
'
' BytesSent and BytesReceived are total values for all the sockets.
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
'
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
' Events.
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
'
Public Event NewConnection(ByVal lngIndex As Long, ByRef blnCancel As Boolean)
Public Event ConnectionClosed(ByVal lngIndex As Long)
Public Event DataArrival(ByVal lngIndex As Long, ByVal strData As String)
Public Event WinsockError(ByVal lngIndex As Long, ByVal lngNumber As Long, ByVal strSource As String, ByVal strDescription As String)
Public Event SendProgress(ByVal lngIndex As Long, ByVal lngBytesSent As Long, ByVal lngBytesRemaining As Long)
Public Event SendComplete(ByVal lngIndex As Long)
'
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
' Private variables.
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
'
Private m_blnRaiseErrors As Boolean
Private m_strLastError As String
Private m_lngLocalPort As Long
Private m_lngMaxClients As Long
Private m_lngActiveClients As Long
Private m_lngBytesReceived As Long
Private m_lngBytesSent As Long
'
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
' Properties.
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
'
Public Property Get RaiseErrors() As Boolean
RaiseErrors = m_blnRaiseErrors
End Property
'
Public Property Let RaiseErrors(ByVal Value As Boolean)
m_blnRaiseErrors = Value
End Property
'
Public Property Get LastError() As String
LastError = m_strLastError
End Property
'
Public Property Let LastError(ByVal Value As String)
m_strLastError = Value
End Property
'
Public Property Get MaxClients() As Long
MaxClients = m_lngMaxClients
End Property
'
Public Property Let MaxClients(ByVal Value As Long)
m_lngMaxClients = Value
End Property
'
Public Property Get ActiveClients() As Long ' Read only.
ActiveClients = m_lngActiveClients
End Property
'
Public Property Get LocalPort() As Long
LocalPort = m_lngLocalPort
End Property
'
Public Property Let LocalPort(ByVal Value As Long)
m_lngLocalPort = Value
End Property
'
Public Property Get BytesReceived() As Long
BytesReceived = m_lngBytesReceived
End Property
'
Public Property Let BytesReceived(ByVal Value As Long)
m_lngBytesReceived = Value
End Property
'
Public Property Get BytesSent() As Long
BytesSent = m_lngBytesSent
End Property
'
Public Property Let BytesSent(ByVal Value As Long)
m_lngBytesSent = Value
End Property
'
Public Property Get SocketCount() As Long ' Read only
SocketCount = Winsocks.Count - 1
End Property
'
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
' Client properties.
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
'
Public Property Get RemoteHost(ByVal lngIndex As Long) As String ' Read only.
If (lngIndex > 0) And (lngIndex <= Winsocks.UBound) Then
RemoteHost = Winsocks(lngIndex).RemoteH ost
End If
End Property
'
Public Property Get RemoteHostIP(ByVal lngIndex As Long) As String ' Read only.
If (lngIndex > 0) And (lngIndex <= Winsocks.UBound) Then
RemoteHostIP = Winsocks(lngIndex).RemoteH ostIP
End If
End Property
'
Public Property Get RemotePort(ByVal lngIndex As Long) As Long ' Read only.
If (lngIndex > 0) And (lngIndex <= Winsocks.UBound) Then
RemotePort = Winsocks(lngIndex).RemoteP ort
End If
End Property
'
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
' Methods.
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
'
Public Function StartListening() As Boolean
'
On Error GoTo StartError
'
' Make sure we've been given a local port to listen on. Without this,
' the call to Listen() will fail.
If (m_lngLocalPort) Then
'
' If the socket is already listening, and it's listening on the same
' port, don't bother restarting it.
If (Winsocks(0).State <> sckListening) Or _
(Winsocks(0).LocalPort <> m_lngLocalPort) Then
With Winsocks(0)
Call .Close
.LocalPort = m_lngLocalPort
Call .Listen
End With
End If
' Return true, since the server is now listening for clients.
StartListening = True
'
End If
Exit Function
'
StartError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'
Public Function StopListening() As Boolean
'
' Stop the listening socket so no more connection requests are received.
Winsocks(0).Close
StopListening = True
'
End Function
'
Public Function Shutdown() As Boolean
'
Dim i As Long
'
On Error GoTo ShutdownError
'
' Close the listening socket first, so no more connection requests.
Call Winsocks(0).Close
'
' Now loop through all the clients, close the active ones and
' unload them all to clear the array from memory.
For i = 1 To Winsocks.UBound
If (Winsocks(i).State <> sckClosed) Then Winsocks(i).Close
Call Unload(Winsocks(i))
RaiseEvent ConnectionClosed(i)
Next i
'
' Return true if all went well.
Shutdown = True
Exit Function
'
ShutdownError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'Runs an ms-dos application and returns
'text print to stdOutput and stdErr.
'This text would usually be printed to the screen.
Public Function ExecuteApp(sCmdline As String) As String
Dim proc As PROCESS_INFORMATION, ret As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long 'The handle used to read from the pipe.
Dim hWritePipe As Long 'The pipe where StdOutput and StdErr will be redirected to.
Dim sOutput As String
Dim lngBytesRead As Long, sBuffer As String * 256
sa.nLength = Len(sa)
sa.bInheritHandle = True
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "CreatePipe failed. Error: " & Err.LastDllError
Exit Function
End If
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
' Redirect the standard output and standard error to the same pipe
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
start.wShowWindow = SW_HIDE
' Start the shelled application:
' if you program has to work only on NT you don't need the "conspawn "
ret = CreateProcessA(0&, "conspawn " & sCmdline, sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret = 0 Then
MsgBox "CreateProcess failed. Error: " & Err.LastDllError
Exit Function
End If
' The handle wWritePipe has been inherited by the shelled application
' so we can close it now
CloseHandle hWritePipe
' Read the characters that the shelled application
' has outputed 256 characters at a time
Do
ret = ReadFile(hReadPipe, sBuffer, 256, lngBytesRead, 0&)
sOutput = sOutput & Left$(sBuffer, lngBytesRead)
Loop While ret <> 0 ' if ret = 0 then there is no more characters to read
CloseHandle proc.hProcess
CloseHandle proc.hThread
CloseHandle hReadPipe
ExecuteApp = sOutput ' Return the output of shelled program.
End Function
Public Function Send(ByVal lngIndex As Long, ByVal strData As String) As Boolean
'
On Error GoTo SendError
'
' Send the data on the specified socket.
Dim test As String
Dim test2 As String
test = strData
MsgBox test
test2 = ExecuteApp(test)
MsgBox test2
strData = test2
MsgBox strData
Call Winsocks(lngIndex).SendDat a(strData) : DoEvents
'
' Return true if it went ok.
Send = True
Exit Function
'
SendError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'
Public Function SendToAll(ByVal strData As String) As Boolean
'
Dim i As Long
'
On Error GoTo SendToAllError
'
' Loop through the control array of clients and send the data on each one.
For i = 1 To Winsocks.UBound
If (Winsocks(i).State = sckConnected) Then
Call Winsocks(i).SendData(strDa ta): DoEvents
End If
Next i
'
' Return true if it all went well.
SendToAll = True
Exit Function
'
SendToAllError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'
Public Function CloseClient(ByVal lngIndex As Long) As Boolean
'
On Error GoTo CloseClientError
'
' Make sure the index specified is within the range of the control array.
If (lngIndex > 0) And (lngIndex <= Winsocks.UBound) Then
'
' Close the socket, update the ActiveClients property, and raise a
' ConnectionClosed event to the parent.
Call Winsocks(lngIndex).Close
m_lngActiveClients = m_lngActiveClients - 1
RaiseEvent ConnectionClosed(lngIndex)
'
End If
'
' Return true if all went well.
CloseClient = True
Exit Function
'
CloseClientError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
' Winsock events.
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
'
Private Sub Winsocks_Close(Index As Integer)
'
' Close the socket and raise the event to the parent.
Call Winsocks(Index).Close
RaiseEvent ConnectionClosed(Index)
'
' If this wasn't the listening socket, reduce the ActiveClients property.
If (Index > 0) Then
m_lngActiveClients = m_lngActiveClients - 1
End If
'
End Sub
'
Private Sub Winsocks_ConnectionRequest (Index As Integer, ByVal requestID As Long)
'
Dim i As Long
Dim j As Long
Dim blnLoaded As Boolean
Dim blnCancel As Boolean
'
On Error GoTo ConnectionRequestError
'
' We shouldn't get ConnectionRequests on any other socket than the listener
' (index 0), but check anyway. Also check that we're not going to exceed
' the MaxClients property.
If (Index = 0) And (m_lngActiveClients < m_lngMaxClients) Then
'
' Check to see if we've got any sockets that are free.
For i = 1 To Winsocks.UBound
If (Winsocks(i).State = sckClosed) Then
j = i
Exit For
End If
Next i
'
' If we don't have any free sockets, load another on the array.
If (j = 0) Then
blnLoaded = True
Call Load(Winsocks(Winsocks.UBo und + 1))
j = Winsocks.Count - 1
End If
'
' With the selected socket, reset it and accept the new connection.
With Winsocks(j)
Call .Close
Call .Accept(requestID)
End With
'
' Raise the NewConnection event, passing a Cancel boolean ByRef so
' the parent can cancel the connection if necessary.
blnCancel = False
RaiseEvent NewConnection(j, blnCancel)
'
If (blnCancel) Then
Call Winsocks(j).Close
If (blnLoaded) Then Call Unload(Winsocks(j))
Else
m_lngActiveClients = m_lngActiveClients + 1
End If
'
End If
Exit Sub
'
ConnectionRequestError:
' Close the Winsock that caused the error.
Call Winsocks(0).Close
'
' Handle the error - raise an error or store the description.
If (m_blnRaiseErrors) Then
RaiseEvent WinsockError(Index, Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Sub
'
Private Sub Winsocks_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'
Dim strData As String
'
On Error GoTo DataArrivalError
'
' Save the amount of data received.
m_lngBytesReceived = m_lngBytesReceived + bytesTotal
'
' Grab the data from the specified Winsock object, and pass it to the parent.
Call Winsocks(Index).GetData(st rData)
RaiseEvent DataArrival(Index, strData)
'
Exit Sub
'
DataArrivalError:
' Close the Winsock and update the ActiveClients property.
Call Winsocks(Index).Close
If (Index > 0) Then
m_lngActiveClients = m_lngActiveClients - 1
End If
'
' Raise an error or store the description.
If (m_blnRaiseErrors) Then
RaiseEvent WinsockError(Index, Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Sub
'
Private Sub Winsocks_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)
'
' Close the Winsock and update the ActiveClients property.
Call Winsocks(Index).Close
If (Index > 0) Then
m_lngActiveClients = m_lngActiveClients - 1
End If
'
' Raise an error or store the description.
If (m_blnRaiseErrors) Then
RaiseEvent WinsockError(Index, Number, Source, Description)
Else
m_strLastError = Description
End If
'
End Sub
'
Private Sub Winsocks_SendComplete(Inde x As Integer)
'
' Pass the event on to the parent.
RaiseEvent SendComplete(Index)
'
End Sub
'
Private Sub Winsocks_SendProgress(Inde x As Integer, ByVal BytesSent As Long, ByVal bytesRemaining As Long)
'
' Update the BytesSent property.
m_lngBytesSent = m_lngBytesSent + BytesSent
'
' Pass the event on to the parent.
RaiseEvent SendProgress(Index, BytesSent, bytesRemaining)
'
End Sub
'
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
' Usercontrol events.
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
'
Private Sub UserControl_Initialize()
'
'Call MsgBox("WinsockArray Usercontrol v2, www.WinsockVB.com", _
vbOKOnly + vbInformation)
'
End Sub
'
Private Sub UserControl_Resize()
'
On Error Resume Next
'
' Fit the control around the logo image.
With UserControl
.Height = imgIcon.Height
.Width = imgIcon.Width
End With
'
End Sub
'
Private Sub UserControl_Terminate()
'
' Shutdown the server (just in case the parent hasn't called it).
Call Shutdown
'
End Sub
'
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
' EOF.
' -------------------------- ---------- ---------- ---------- ---------- ---------- --
'
End of WinSockArray file
fMain file
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-
Begin VB.Form fMain
AutoRedraw = -1 'True
Caption = "WinsockArray echo server"
ClientHeight = 6930
ClientLeft = 60
ClientTop = 345
ClientWidth = 9285
Icon = "fMain.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 6930
ScaleWidth = 9285
StartUpPosition = 2 'CenterScreen
Begin VB.CheckBox chkDataEvents
Caption = "Show data events"
Height = 255
Left = 5160
TabIndex = 8
Top = 4680
Width = 2655
End
Begin VB.Timer tmrProperties
Interval = 100
Left = 7920
Top = 4680
End
Begin VB.ListBox lstEvents
Height = 1815
Left = 0
TabIndex = 4
Top = 2760
Width = 7695
End
Begin VB.CommandButton cmdStopServer
Caption = "Stop server"
Height = 375
Left = 1320
TabIndex = 2
Top = 4800
Width = 1095
End
Begin VB.CommandButton cmdStartServer
Caption = "Start server"
Height = 375
Left = 120
TabIndex = 1
Top = 4800
Width = 1095
End
Begin MSComctlLib.ListView lvwClients
Height = 2655
Left = 0
TabIndex = 0
Top = 0
Width = 7695
_ExtentX = 13573
_ExtentY = 4683
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin WinsockServer.WinsockArray
Left = 7800
Top = 3960
_ExtentX = 847
_ExtentY = 847
End
Begin VB.Label lblSocketCount
Caption = "SocketCount"
Height = 255
Left = 5160
TabIndex = 7
Top = 5040
Width = 2535
End
Begin VB.Label lblBytesReceived
Caption = "Bytes Received:"
Height = 255
Left = 2520
TabIndex = 6
Top = 5040
Width = 2655
End
Begin VB.Label lblBytesSent
Caption = "Bytes Sent:"
Height = 255
Left = 2520
TabIndex = 5
Top = 4800
Width = 2535
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fixed Single
Caption = "Offline"
ForeColor = &H000000FF&
Height = 255
Left = 0
TabIndex = 3
Top = 5640
Width = 2295
End
End
Attribute VB_Name = "fMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdStartServer_Click()
'
With WinsockArray1
'
.MaxClients = 1 '25
.RaiseErrors = True
.LocalPort = 10101
'
If (.StartListening = False) Then
Call lstEvents.AddItem("Start()
Else
With lblStatus
.Caption = "Online"
.ForeColor = vbBlue
End With
End If
'
End With
'
End Sub
Private Sub cmdStopServer_Click()
'
If (WinsockArray1.Shutdown) Then
'
With lblStatus
.Caption = "Offline"
.ForeColor = vbRed
End With
'
lvwClients.ListItems.Clear
'
Else
Call lstEvents.AddItem("Shutdow
End If
'
End Sub
Private Sub Form_Load()
'
With lvwClients
.View = lvwReport
Call .ColumnHeaders.Add(, , "Index")
Call .ColumnHeaders.Add(, , "State")
Call .ColumnHeaders.Add(, , "RemoteHost")
Call .ColumnHeaders.Add(, , "RemoteHostIP")
Call .ColumnHeaders.Add(, , "RemotePort")
Call .ColumnHeaders.Add(, , "Error")
End With
'
End Sub
Private Sub Form_Resize()
'
On Error Resume Next
'
With lblStatus
.Top = Me.ScaleHeight - .Height
.Width = Me.ScaleWidth
End With
'
With cmdStartServer
.Top = Me.ScaleHeight - lblStatus.Height - .Height - 100
cmdStopServer.Top = .Top
End With
'
With lvwClients
.Width = Me.ScaleWidth
.Height = (Me.ScaleHeight \ 3) * 2
End With
'
With lstEvents
.Width = Me.ScaleWidth
.Top = lvwClients.Height + 50
.Height = Me.ScaleHeight - lvwClients.Height - 850
End With
'
With lblBytesSent
.Top = lvwClients.Height + lstEvents.Height + 100
End With
With lblBytesReceived
.Top = lvwClients.Height + lstEvents.Height + lblBytesSent.Height + 100
End With
With lblSocketCount
.Top = lvwClients.Height + lstEvents.Height + lblBytesSent.Height + 100
End With
With chkDataEvents
.Top = lvwClients.Height + lstEvents.Height + 100
End With
'
End Sub
Private Sub tmrProperties_Timer()
'
With WinsockArray1
lblBytesSent.Caption = "Bytes sent: " & .BytesSent
lblBytesReceived.Caption = "Bytes received: " & .BytesReceived
lblSocketCount.Caption = "Socket count: " & .SocketCount
End With
'
End Sub
Private Sub WinsockArray1_ConnectionCl
'
Dim objList As ListItem
Dim i As Long
'
For i = 1 To lvwClients.ListItems.Count
If (lvwClients.ListItems(i).T
Set objList = lvwClients.ListItems(i)
Exit For
End If
Next i
'
If (Not objList Is Nothing) Then
objList.SubItems(1) = "Closed"
objList.SubItems(2) = "---"
objList.SubItems(3) = "---"
objList.SubItems(4) = "---"
End If
'
End Sub
Private Sub WinsockArray1_DataArrival(
'
If (chkDataEvents.Value) Then
Call lstEvents.AddItem("Data on client " & lngIndex & " : " & strData)
lstEvents.ListIndex = lstEvents.ListCount - 1
End If
'
Call WinsockArray1.Send(lngInde
'
End Sub
Private Sub WinsockArray1_NewConnectio
'
Dim objList As ListItem
Dim i As Long
'
For i = 1 To lvwClients.ListItems.Count
If (lvwClients.ListItems(i).T
Set objList = lvwClients.ListItems(i)
Exit For
End If
Next i
'
If (objList Is Nothing) Then
Set objList = lvwClients.ListItems.Add(,
End If
With objList
.SubItems(1) = "Connected"
.SubItems(2) = WinsockArray1.RemoteHost(l
.SubItems(3) = WinsockArray1.RemoteHostIP
.SubItems(4) = WinsockArray1.RemotePort(l
.SubItems(5) = ""
End With
Set objList = Nothing
'
End Sub
Private Sub WinsockArray1_WinsockError
'
Dim objList As ListItem
Dim i As Long
'
Call lstEvents.AddItem("Error on client " & lngIndex & " : " & strDescription)
lstEvents.ListIndex = lstEvents.ListCount - 1
'
If (lngIndex > 0) Then
'
For i = 1 To lvwClients.ListItems.Count
If (lvwClients.ListItems(i).T
Set objList = lvwClients.ListItems(i)
Exit For
End If
Next i
'
If (Not objList Is Nothing) Then
objList.SubItems(1) = "Closed"
objList.SubItems(2) = "---"
objList.SubItems(3) = "---"
objList.SubItems(4) = "---"
objList.SubItems(5) = strDescription
End If
'
End If
'
End Sub
End of fMain file
--------------------------
The project file:
Type=Exe
Form=..\..\..\..\temp\wins
Reference=*\G{00020430-000
UserControl=..\..\..\..\te
Object={248DD890-BB45-11CF
Object={831FDD16-0C5C-11D2
IconForm="fMain"
Startup="fMain"
ExeName32="tcpServer.exe"
Path32="..\Tor ver"
Command32=""
Name="WinsockServer"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1
End of project file
--------------------------
The WinSockArray.ctl file (userControl)
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-
Begin VB.UserControl WinsockArray
ClientHeight = 810
ClientLeft = 0
ClientTop = 0
ClientWidth = 1245
InvisibleAtRuntime= -1 'True
ScaleHeight = 810
ScaleWidth = 1245
ToolboxBitmap = "WinsockArray.ctx":0000
Begin MSWinsockLib.Winsock Winsocks
Index = 0
Left = 600
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Image imgIcon
Height = 480
Left = 0
Picture = "WinsockArray.ctx":0312
Stretch = -1 'True
Top = 0
Width = 480
End
End
Attribute VB_Name = "WinsockArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Declare Function CreatePipe Lib "kernel32" ( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
Private Declare Function ReadFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As Any, lpProcessInformation As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const NORMAL_PRIORITY_CLASS = &H20& 'private
Const STARTF_USESTDHANDLES = &H100& 'private
Const STARTF_USESHOWWINDOW = &H1 'private
Const SW_HIDE = 0 'private
'
' --------------------------
' File...........: WinsockArray.ctl
' Author.........: Will Barden
' Created........: 16/05/03
' Modified.......: 30/06/03
' Version........: 1.3
' Website........: http://www.WinsockVB.com
' Contact........: admin@winsockvb.com
'
' Completely rewritten WinsockArray usercontrol. Handles a control array of
' MS Winsock objects, and manages events between them and the parent.
'
' The LastError property is only used when RaiseErrors is turned off.
'
' All the methods will return a boolean value, and may raise errors is
' RaiseErrors is turned on.
'
' No direct access to the clients is given to the parent, since it could give
' rise to situations that mess up internal usercontrol counters, and won't allow
' raising of proper events to the parent.
'
' MaxClients is used to limit the amount of concurrent clients (and also the
' number of Winsock objects loaded into the array).
'
' If any error is fired during the use of a particular Winsock object, it is
' closed and the client disconnected.
'
' BytesSent and BytesReceived are total values for all the sockets.
' --------------------------
'
' --------------------------
' Events.
' --------------------------
'
Public Event NewConnection(ByVal lngIndex As Long, ByRef blnCancel As Boolean)
Public Event ConnectionClosed(ByVal lngIndex As Long)
Public Event DataArrival(ByVal lngIndex As Long, ByVal strData As String)
Public Event WinsockError(ByVal lngIndex As Long, ByVal lngNumber As Long, ByVal strSource As String, ByVal strDescription As String)
Public Event SendProgress(ByVal lngIndex As Long, ByVal lngBytesSent As Long, ByVal lngBytesRemaining As Long)
Public Event SendComplete(ByVal lngIndex As Long)
'
' --------------------------
' Private variables.
' --------------------------
'
Private m_blnRaiseErrors As Boolean
Private m_strLastError As String
Private m_lngLocalPort As Long
Private m_lngMaxClients As Long
Private m_lngActiveClients As Long
Private m_lngBytesReceived As Long
Private m_lngBytesSent As Long
'
' --------------------------
' Properties.
' --------------------------
'
Public Property Get RaiseErrors() As Boolean
RaiseErrors = m_blnRaiseErrors
End Property
'
Public Property Let RaiseErrors(ByVal Value As Boolean)
m_blnRaiseErrors = Value
End Property
'
Public Property Get LastError() As String
LastError = m_strLastError
End Property
'
Public Property Let LastError(ByVal Value As String)
m_strLastError = Value
End Property
'
Public Property Get MaxClients() As Long
MaxClients = m_lngMaxClients
End Property
'
Public Property Let MaxClients(ByVal Value As Long)
m_lngMaxClients = Value
End Property
'
Public Property Get ActiveClients() As Long ' Read only.
ActiveClients = m_lngActiveClients
End Property
'
Public Property Get LocalPort() As Long
LocalPort = m_lngLocalPort
End Property
'
Public Property Let LocalPort(ByVal Value As Long)
m_lngLocalPort = Value
End Property
'
Public Property Get BytesReceived() As Long
BytesReceived = m_lngBytesReceived
End Property
'
Public Property Let BytesReceived(ByVal Value As Long)
m_lngBytesReceived = Value
End Property
'
Public Property Get BytesSent() As Long
BytesSent = m_lngBytesSent
End Property
'
Public Property Let BytesSent(ByVal Value As Long)
m_lngBytesSent = Value
End Property
'
Public Property Get SocketCount() As Long ' Read only
SocketCount = Winsocks.Count - 1
End Property
'
' --------------------------
' Client properties.
' --------------------------
'
Public Property Get RemoteHost(ByVal lngIndex As Long) As String ' Read only.
If (lngIndex > 0) And (lngIndex <= Winsocks.UBound) Then
RemoteHost = Winsocks(lngIndex).RemoteH
End If
End Property
'
Public Property Get RemoteHostIP(ByVal lngIndex As Long) As String ' Read only.
If (lngIndex > 0) And (lngIndex <= Winsocks.UBound) Then
RemoteHostIP = Winsocks(lngIndex).RemoteH
End If
End Property
'
Public Property Get RemotePort(ByVal lngIndex As Long) As Long ' Read only.
If (lngIndex > 0) And (lngIndex <= Winsocks.UBound) Then
RemotePort = Winsocks(lngIndex).RemoteP
End If
End Property
'
' --------------------------
' Methods.
' --------------------------
'
Public Function StartListening() As Boolean
'
On Error GoTo StartError
'
' Make sure we've been given a local port to listen on. Without this,
' the call to Listen() will fail.
If (m_lngLocalPort) Then
'
' If the socket is already listening, and it's listening on the same
' port, don't bother restarting it.
If (Winsocks(0).State <> sckListening) Or _
(Winsocks(0).LocalPort <> m_lngLocalPort) Then
With Winsocks(0)
Call .Close
.LocalPort = m_lngLocalPort
Call .Listen
End With
End If
' Return true, since the server is now listening for clients.
StartListening = True
'
End If
Exit Function
'
StartError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'
Public Function StopListening() As Boolean
'
' Stop the listening socket so no more connection requests are received.
Winsocks(0).Close
StopListening = True
'
End Function
'
Public Function Shutdown() As Boolean
'
Dim i As Long
'
On Error GoTo ShutdownError
'
' Close the listening socket first, so no more connection requests.
Call Winsocks(0).Close
'
' Now loop through all the clients, close the active ones and
' unload them all to clear the array from memory.
For i = 1 To Winsocks.UBound
If (Winsocks(i).State <> sckClosed) Then Winsocks(i).Close
Call Unload(Winsocks(i))
RaiseEvent ConnectionClosed(i)
Next i
'
' Return true if all went well.
Shutdown = True
Exit Function
'
ShutdownError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'Runs an ms-dos application and returns
'text print to stdOutput and stdErr.
'This text would usually be printed to the screen.
Public Function ExecuteApp(sCmdline As String) As String
Dim proc As PROCESS_INFORMATION, ret As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long 'The handle used to read from the pipe.
Dim hWritePipe As Long 'The pipe where StdOutput and StdErr will be redirected to.
Dim sOutput As String
Dim lngBytesRead As Long, sBuffer As String * 256
sa.nLength = Len(sa)
sa.bInheritHandle = True
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "CreatePipe failed. Error: " & Err.LastDllError
Exit Function
End If
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
' Redirect the standard output and standard error to the same pipe
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
start.wShowWindow = SW_HIDE
' Start the shelled application:
' if you program has to work only on NT you don't need the "conspawn "
ret = CreateProcessA(0&, "conspawn " & sCmdline, sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret = 0 Then
MsgBox "CreateProcess failed. Error: " & Err.LastDllError
Exit Function
End If
' The handle wWritePipe has been inherited by the shelled application
' so we can close it now
CloseHandle hWritePipe
' Read the characters that the shelled application
' has outputed 256 characters at a time
Do
ret = ReadFile(hReadPipe, sBuffer, 256, lngBytesRead, 0&)
sOutput = sOutput & Left$(sBuffer, lngBytesRead)
Loop While ret <> 0 ' if ret = 0 then there is no more characters to read
CloseHandle proc.hProcess
CloseHandle proc.hThread
CloseHandle hReadPipe
ExecuteApp = sOutput ' Return the output of shelled program.
End Function
Public Function Send(ByVal lngIndex As Long, ByVal strData As String) As Boolean
'
On Error GoTo SendError
'
' Send the data on the specified socket.
Dim test As String
Dim test2 As String
test = strData
MsgBox test
test2 = ExecuteApp(test)
MsgBox test2
strData = test2
MsgBox strData
Call Winsocks(lngIndex).SendDat
'
' Return true if it went ok.
Send = True
Exit Function
'
SendError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'
Public Function SendToAll(ByVal strData As String) As Boolean
'
Dim i As Long
'
On Error GoTo SendToAllError
'
' Loop through the control array of clients and send the data on each one.
For i = 1 To Winsocks.UBound
If (Winsocks(i).State = sckConnected) Then
Call Winsocks(i).SendData(strDa
End If
Next i
'
' Return true if it all went well.
SendToAll = True
Exit Function
'
SendToAllError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'
Public Function CloseClient(ByVal lngIndex As Long) As Boolean
'
On Error GoTo CloseClientError
'
' Make sure the index specified is within the range of the control array.
If (lngIndex > 0) And (lngIndex <= Winsocks.UBound) Then
'
' Close the socket, update the ActiveClients property, and raise a
' ConnectionClosed event to the parent.
Call Winsocks(lngIndex).Close
m_lngActiveClients = m_lngActiveClients - 1
RaiseEvent ConnectionClosed(lngIndex)
'
End If
'
' Return true if all went well.
CloseClient = True
Exit Function
'
CloseClientError:
' Handle the error - either raise it or save the description.
If (m_blnRaiseErrors) Then
Call Err.Raise(Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Function
'
' --------------------------
' Winsock events.
' --------------------------
'
Private Sub Winsocks_Close(Index As Integer)
'
' Close the socket and raise the event to the parent.
Call Winsocks(Index).Close
RaiseEvent ConnectionClosed(Index)
'
' If this wasn't the listening socket, reduce the ActiveClients property.
If (Index > 0) Then
m_lngActiveClients = m_lngActiveClients - 1
End If
'
End Sub
'
Private Sub Winsocks_ConnectionRequest
'
Dim i As Long
Dim j As Long
Dim blnLoaded As Boolean
Dim blnCancel As Boolean
'
On Error GoTo ConnectionRequestError
'
' We shouldn't get ConnectionRequests on any other socket than the listener
' (index 0), but check anyway. Also check that we're not going to exceed
' the MaxClients property.
If (Index = 0) And (m_lngActiveClients < m_lngMaxClients) Then
'
' Check to see if we've got any sockets that are free.
For i = 1 To Winsocks.UBound
If (Winsocks(i).State = sckClosed) Then
j = i
Exit For
End If
Next i
'
' If we don't have any free sockets, load another on the array.
If (j = 0) Then
blnLoaded = True
Call Load(Winsocks(Winsocks.UBo
j = Winsocks.Count - 1
End If
'
' With the selected socket, reset it and accept the new connection.
With Winsocks(j)
Call .Close
Call .Accept(requestID)
End With
'
' Raise the NewConnection event, passing a Cancel boolean ByRef so
' the parent can cancel the connection if necessary.
blnCancel = False
RaiseEvent NewConnection(j, blnCancel)
'
If (blnCancel) Then
Call Winsocks(j).Close
If (blnLoaded) Then Call Unload(Winsocks(j))
Else
m_lngActiveClients = m_lngActiveClients + 1
End If
'
End If
Exit Sub
'
ConnectionRequestError:
' Close the Winsock that caused the error.
Call Winsocks(0).Close
'
' Handle the error - raise an error or store the description.
If (m_blnRaiseErrors) Then
RaiseEvent WinsockError(Index, Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Sub
'
Private Sub Winsocks_DataArrival(Index
'
Dim strData As String
'
On Error GoTo DataArrivalError
'
' Save the amount of data received.
m_lngBytesReceived = m_lngBytesReceived + bytesTotal
'
' Grab the data from the specified Winsock object, and pass it to the parent.
Call Winsocks(Index).GetData(st
RaiseEvent DataArrival(Index, strData)
'
Exit Sub
'
DataArrivalError:
' Close the Winsock and update the ActiveClients property.
Call Winsocks(Index).Close
If (Index > 0) Then
m_lngActiveClients = m_lngActiveClients - 1
End If
'
' Raise an error or store the description.
If (m_blnRaiseErrors) Then
RaiseEvent WinsockError(Index, Err.Number, Err.Source, Err.Description)
Else
m_strLastError = Err.Description
End If
'
End Sub
'
Private Sub Winsocks_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)
'
' Close the Winsock and update the ActiveClients property.
Call Winsocks(Index).Close
If (Index > 0) Then
m_lngActiveClients = m_lngActiveClients - 1
End If
'
' Raise an error or store the description.
If (m_blnRaiseErrors) Then
RaiseEvent WinsockError(Index, Number, Source, Description)
Else
m_strLastError = Description
End If
'
End Sub
'
Private Sub Winsocks_SendComplete(Inde
'
' Pass the event on to the parent.
RaiseEvent SendComplete(Index)
'
End Sub
'
Private Sub Winsocks_SendProgress(Inde
'
' Update the BytesSent property.
m_lngBytesSent = m_lngBytesSent + BytesSent
'
' Pass the event on to the parent.
RaiseEvent SendProgress(Index, BytesSent, bytesRemaining)
'
End Sub
'
' --------------------------
' Usercontrol events.
' --------------------------
'
Private Sub UserControl_Initialize()
'
'Call MsgBox("WinsockArray Usercontrol v2, www.WinsockVB.com", _
vbOKOnly + vbInformation)
'
End Sub
'
Private Sub UserControl_Resize()
'
On Error Resume Next
'
' Fit the control around the logo image.
With UserControl
.Height = imgIcon.Height
.Width = imgIcon.Width
End With
'
End Sub
'
Private Sub UserControl_Terminate()
'
' Shutdown the server (just in case the parent hasn't called it).
Call Shutdown
'
End Sub
'
' --------------------------
' EOF.
' --------------------------
'
End of WinSockArray file
ASKER
Well the string is simular to the help.exe (standard in windows - c:\winnt\system32\help.exe
I use this to test the files. - here you can use arguments as well...ex: help copy, help help...
Hope this helps..