Solved

Send and recive command arguments trough Winsock (TCP) - Client & server

Posted on 2003-11-13
10
717 Views
Last Modified: 2013-12-25
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









0
Comment
Question by:ZorkNo
  • 5
  • 3
  • 2
10 Comments
 
LVL 9

Accepted Solution

by:
Dang123 earned 125 total points
ID: 9739225
ZorkNo,

"program.exe returns a string "  How is it returning the string?

In any event, your server will need to wait for program.exe to finish so take a look at this

http://www.thescarms.com/VBasic/wait.asp

Dang123

0
 

Author Comment

by:ZorkNo
ID: 9739572
Thanks... I did't think of that..


Well the string is simular to the help.exe (standard in windows - c:\winnt\system32\help.exe), but for the most is just a single line..
I use this to test the files. - here you can use arguments as well...ex: help copy, help help...

Hope this helps..

0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 9740612
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
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 9749840
Which part specifically do you want to attack first?
0
 

Author Comment

by:ZorkNo
ID: 9762305
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..

 
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 9

Expert Comment

by:Dang123
ID: 9763525
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
0
 

Author Comment

by:ZorkNo
ID: 9795742
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..

0
 
LVL 9

Expert Comment

by:Dang123
ID: 9796568
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   : )
0
 

Author Comment

by:ZorkNo
ID: 9796734
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-0080C7E7B78D}#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.exe" & " " & CommandSelv
            txtTempText = "c:\test_ttc\rel_k\rk.exe" & " " & CommandSelv ' String som kjøres

        End If

Else
    frmClient.Hide
    'txtTempText = "c:\winnt\system32\help.exe" & " " & 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.exe 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(ByVal 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-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\system32\stdole2.tlb#OLE Automation
Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#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






0
 

Author Comment

by:ZorkNo
ID: 9796853
This is the Server.

fMain file


VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#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("Shutdown() 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_ConnectionClosed(ByVal lngIndex As Long)
   '
Dim objList    As ListItem
Dim i          As Long
   '
   For i = 1 To lvwClients.ListItems.Count
      If (lvwClients.ListItems(i).Text = 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(lngIndex, strData)
   '
End Sub

Private Sub WinsockArray1_NewConnection(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).Text = 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(lngIndex)
      .SubItems(3) = WinsockArray1.RemoteHostIP(lngIndex)
      .SubItems(4) = WinsockArray1.RemotePort(lngIndex)
      .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).Text = 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\winsockserver1\fMain.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINNT\system32\stdole2.tlb#OLE Automation
UserControl=..\..\..\..\temp\winsockserver1\WinsockArray.ctl
Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#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-0080C7E7B78D}#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).RemoteHost
   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).RemoteHostIP
   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).RemotePort
   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).SendData(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(strData): 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.UBound + 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(strData)
   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(Index As Integer)
   '
   ' Pass the event on to the parent.
   RaiseEvent SendComplete(Index)
   '
End Sub
'
Private Sub Winsocks_SendProgress(Index 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











0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now