I need a little help here...
I'm trying to get exhume to run a basic TCP server so it can forward functions to my other autoit script until exhuem is made autoit compatible (which I hear will take 1-2 weeks at minimum), so im trying this as a temporary fix.
The problem is that I get winsock errors. It seems as if its not registered to the system. Ive tried manually regging (regsvr32) it,and ive tried regging it via vbscript, but it still continues to not recognize winsock! Perhaps the winsock fiels I've donwloaded just aren't the correct one to use somehow? ...
Here is the code, please give it a once-over
Code: Select all
'
' SERVER WINSOCK VBSCRIPT
'
' NOTES: (FEBRUARY 20, 2007)
'
' Delays are required where they are located,
' or it sends data too quick, and errors.
'
' Listens on Port 80 by default.
' Port is user setting.
'
' Creates a Log file.
' c:\WSServer.log
'
' if winsock not registered it will try to register
' if winsock ocx is in path it will register
' if cannot register it will error and quit
'
' server listens for connection from client
' server Receives connection from client
' server checks data received from client
' server sends reply to client if data valid
' server closes whether valid or invalid
' server listens for more connections
'
' this only receives basic text, no long essays or files.
' for that, it would require some minor but required changes.
'
Option Explicit
Dim winsock
'****** CHANGE THESE SETTINGS *********
Const LocalPort = 80
Const DataToReceive = "Test"
'***************************************
Const sckClosed = 0 '// Default. Closed
Const sckOpen = 1 '// Open
Const sckListening = 2 '// Listening
Const sckConnectionPending = 3 '// Connection pending
Const sckResolvingHost = 4 '// Resolving host
Const sckHostResolved = 5 '// Host resolved
Const sckConnecting = 6 '// Connecting
Const sckConnected = 7 '// Connected
Const sckClosing = 8 '// Peer is closing the connection
Const sckError = 9 '// Error
MsgBox "Start Server"
WriteData Now & " - Server Started"
'********* CREATE & CONNECT **********
'// CREATE WINSOCK
On Error Resume Next
Set winsock = Wscript.CreateObject("MSWINSOCK.Winsock", "winsock_")
If Err.Number <> 0 Then
'// REGISTER WINSOCK IF ERROR
WriteData Now & " - Registering Winsock" '// log action
Set winsock = Nothing
If RegWinsock = False Then
'// REGISTER ERROR SO EXIT
MsgBox "Winsock Object Error!" & vbCrLf & "Script will exit now."
WriteData Now & " - Winsock Object Error."
WScript.Quit
Else
Set winsock = Wscript.CreateObject("MSWINSOCK.Winsock", "winsock_")
End If
End If
On Error Goto 0
'// LISTEN NOW
winsock.LocalPort = LocalPort
ServerListen
'********* WAIT FOR EVENTS ***********
'// MAIN DELAY - INFINITE LOOP
'// SOCKET ERROR RAISES WINSOCK ERROR SUB
while winsock.State <> sckError
WScript.Sleep 200
Wend
'// JUST INCASE
ServerClose()
'********** WINSOCK EVENTS ***********
'// WINSOCK CONNECT REQUEST // CONNECTED
Sub winsock_ConnectionRequest(requestID)
If winsock.State <> sckClosed Then
winsock.Close
End If
winsock.Accept requestID
WriteData Now & " - Server Requested ID: " & requestID
WScript.Sleep 1000 '// REQUIRED OR ERRORS
End Sub
'// WINSOCK DATA ARRIVE // GET DATA AND SEND REPLY
Sub winsock_dataArrival(bytesTotal)
Dim strData: strData = ""
WriteData Now & " - Server Data Arrives"
winsock.GetData strData, vbString
WriteData Now & " - Server Received: " & strData
Select Case CStr(strData)
Case DataToReceive
winsock.SendData DataToReceive
WriteData Now & " - Server Sent Reply: " & DataToReceive
Case Else
WriteData Now & " - Invalid Data Received"
End Select
WScript.Sleep 2000 '// REQUIRED OR ERRORS
ServerListen()
End Sub
'// WINSOCK ERROR // ERROR SO EXIT
Sub winsock_Error(Number, Description, SCode, Source, HelpFile, HelpContext, CancelDisplay)
MsgBox "Server Error " & Number & vbCrLf & Description
WriteData Now & " - Server Error: " & Number & ". " & Description
ServerClose()
End Sub
'******** COMMON PROCEDURES **********
'// LISTEN FOR REQUEST
Sub ServerListen()
If winsock.State <> sckClosed Then
WriteData Now & " - Server Closed (Listen)"
winsock.Close
End If
WriteData Now & " - Server Listen"
winsock.Listen
End SUb
'// EXIT SCRIPT
Sub ServerClose()
If winsock.state <> sckClosed Then winsock.Close
Set winsock = Nothing
WriteData Now & " - Server Closed."
Wscript.Quit
End SUb
'// CREATE LOG ENTRY
Function WriteData(Data)
Dim fso, file
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile("C:\WSServer.log", 8, True)
file.write Data & vbCrLf
file.Close
Set file = Nothing
Set fso = Nothing
End Function
'******** REGISTER WINSOCK **********
Function RegWinsock()
Dim RegCmd, RegOcx, TmpOcx
If CheckObject("MSWINSOCK.Winsock", "winsock_") Then
RegWinsock = True
Exit Function
End If
RegOcx = SystemDirectory & "\MSWINSCK.OCX"
TmpOcx = ScriptPath & "\MSWINSCK.OCX"
RegCmd = "regsvr32.exe /s " & RegOcx
If Not FileExists(TmpOcx) Then Exit Function
If FileCopy(TmpOcx, RegOcx) = False Then Exit Function
If FileExists(RegOcx) = False Then Exit Function
If ShellCmd(RegCmd) = False Then Exit Function
If CheckObject("MSWINSOCK.Winsock", "winsock_") Then
RegWinsock = True
End If
End Function
'// SHELL COMMAND PROMPT
Function ShellCmd(ByVal pCmd)
Dim ShellWsck, Rtrn
On Error Goto 0: On Error Resume Next
Set ShellWsck = CreateObject("WScript.Shell")
Rtrn = ShellWsck.Run(pCmd, 0, True)
If Rtrn = 0 Then
If Err = 0 Then ShellCmd = True
End If
Set ShellWsck = Nothing
On Error Goto 0
End Function
'// GET THIS SCRIPT PATH
Function ScriptPath()
On Error Goto 0: On Error Resume Next
ScriptPath = CreateObject("Scripting.FileSystemObject")._
GetParentFolderName(Wscript.ScriptFullName)
On Error Goto 0
End Function
'// GET WINDOWS SYSTEM DIRECTORY
Function SystemDirectory()
Dim objFso
On Error Goto 0: On Error Resume Next
Set objFso = CreateObject("Scripting.FileSystemObject")
SystemDirectory = objFso.GetSpecialFolder(1)
Set objFso = nothing
On Error Goto 0
End Function
'// COPY A FILE
Function FileCopy(ByVal pFile1, ByVal pFile2)
Dim objFso
On Error Goto 0: On Error Resume Next
Set objFso = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(pFile2) Then
If Err = 0 Then FileCopy = True
Exit Function
End If
If objFSO.FileExists(pFile1) Then
objFso.CopyFile pFile1, pFile2
If Err = 0 Then FileCopy = True
End If
Set objFso = nothing
On Error Goto 0
End Function
'// FILE EXISTS
Function FileExists(ByVal pFile)
Dim objFSO
On Error Goto 0: On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(pFile) = True Then
If Err = 0 Then FileExists = True
End If
Set objFSO = Nothing
On Error Goto 0
End Function
'// CHECK IF OBJECT IS REGISTERED
Function CheckObject(ByVal pObj, ByVal pAram)
Dim objTemp
On Error Goto 0: On Error Resume Next
If Len(pAram) <> 0 Then
Set objTemp = WScript.CreateObject(pObj, pAram)
Else
Set objTemp = CreateObject(pObj)
End If
If Err = 0 Then CheckObject = True
Set objTemp = Nothing
On Error Goto 0
End Function
Can anyone help me? Do I need to install some kind of software development package to get winsock registered to my system properly?
Who is online