Runtime error 40006 - After connection established
Hi
I have set up a client server application, where the client connects to a
server and the client application can shutdown the server application using
the Windows API.
However I have tried sending the API to the machine where the server program
is hosted, via a string, then allowing the server to receive the incoming
data and calling the API.
However i get the following error:
Run-time error '40006'
Wrong protocol or connection state for the requested transaction or request.
Does anyone know what this means and how i should correct my code?
Client Code:
Option Explicit
Private Sub cmdAction_Click()
Actions.Visible = True
End Sub
Private Sub cmdClose_Click()
wsRat.Close
cmdClose.Enabled = False
cmdConnect.Enabled = True
End Sub
Private Sub cmdConnect_Click()
If txtIP.Text = "" Then
MsgBox "Please Enter IP Address Before Clicking Connect", vbCritical,
"Error"
End If
wsRat.Close
wsRat.Connect txtIP.Text, 1234
cmdClose.Enabled = True
End Sub
Private Sub wsRat_Connect()
Do
DoEvents
Loop Until wsRat.State = sckConnected Or wsRat.State = sckError
If wsRat.State = sckConnected Then
'inform user that connection is made
MsgBox "Connection Established", vbInformation, "Client"
cmdClose.Enabled = True
Else
'inform user that connection failed
MsgBox "Connection Failed!", vbCritical, "Error!"
End If
End Sub
Private Sub wsRat_ConnectionRequest(ByVal requestID As Long)
wsRat.Close
wsRat.Accept requestID
'if the remote system requests a connection then accept it and connect
End Sub
Option Explicit
'********************
'* CD Tray Declares *
'********************
Dim strReturn As Long
Dim lngReturn As Long
Dim incoming As String
Private Declare Function mciSendString Lib "winmm.dll" Alias
"mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As
String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'*********************
'* Lock Wks declares *
'*********************
Private Declare Function LockWorkStation Lib "user32.dll" () As Long
Dim lockwrk As String
'*************************
'* Exit Windows declares *
'*************************
Private Declare Function ExitWindowsEx Lib "user32.dll" (ByVal uFlags As
Long, ByVal dwReserved As Long) As Long
Private Const EXIT_LOGOFF = 0
Private Const EXIT_SHUTDOWN = 1
Private Const EXIT_REBOOT = 2
Private Sub cmdExitform_Click()
Actions.Visible = False
Client.Visible = True
End Sub
Private Sub cmdOpenCD_Click()
wsRat.SendData "[open]"
MsgBox "CD Opened", vbInformation, "Note:"
End Sub
Private Sub cmdCloseCD_Click()
wsRat.SendData "[close]"
MsgBox "CD Closed", vbInformation, "Note:"
End Sub
Private Sub cmdLW_Click()
wsRat.SendData "[lockwrk]"
MsgBox "Locked Host Computer", vbInformation, "please wait:"
End Sub
SERVER CODE:
Option Explicit
'********************
'*CD Tray Properties*
'********************
Dim strReturn As Long
Dim lngReturn As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias
"mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As
String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'********************
'*Lock Wks declares:*
'********************
Private Declare Function LockWorkStation Lib "user32.dll" () As Long
'***********************
'*Exit Windows declares*
'***********************
Private Declare Function ExitWindowsEx Lib "user32.dll" (ByVal uFlags As
Long, ByVal dwReserved As Long) As Long
Private Const EXIT_LOGOFF = 0
Private Const EXIT_SHUTDOWN = 1
Private Const EXIT_REBOOT = 2
Private Sub cmdClose_Click()
wsRat.Close
MsgBox "Listening Disabled", vbExclamation, "Please Note:"
cmdClose.Enabled = False
cmdListen.Enabled = True
End Sub
Private Sub cmdListen_Click()
MsgBox "Awaiting Connection Attempts", vbInformation, "Please Wait!"
wsRat.Close
wsRat.LocalPort = 1234
wsRat.Listen
cmdClose.Enabled = True
cmdListen.Enabled = False
End Sub
Private Sub wsRat_Connect()
Do
DoEvents
Loop Until wsRat.State = sckConnected Or wsRat.State = sckError
If wsRat.State = sckConnected Then
'inform user that connection is made
MsgBox "Connection Established", vbInformation, "Client"
cmdClose.Enabled = True
Else
'inform user that connection failed
MsgBox "Connection Failed!", vbCritical, "Error!"
End If
End Sub
Private Sub wsRat_ConnectionRequest(ByVal requestID As Long)
wsRat.Close
wsRat.Accept requestID
'if the remote system requests a connection then accept it and connect
cmdListen.Enabled = False
End Sub
Private Sub wsRat_DataArrival(ByVal bytesTotal As Long)
Dim incoming As String
' tell winsock to place the incoming data as a string
wsRat.GetData incoming
If incoming = "open" Then
Call openCD
Else
If incoming = "lockwrk" Then
Call LockWS
Else
If incoming = "close" Then
Call closeCD
End If
End Sub
Private Sub LockWS()
LockWorkStation
End Sub
Private Sub openCD()
lngReturn = mciSendString("set CDAudio door open", strReturn, 127, 0)
End Sub
Private Sub closeCD()
lngReturn = mciSendString("set CDAudio door closed", strReturn, 127, 0)
End Sub
Thanks
B
|
