使用java script或vbscript脚本进行原始socket通信

只在xp 环境下试过，x86系统应该问题不大，x64可能不支持，使用前先执行SocketReg.exe对组件进行注册，然后就可以在网页脚本中使用套接字了，这个组件是99年国外一公司开发的，本意是用来实现http ，ftp，smtp pop3协议，所以内容传输多以ansi编码，而不是二进制数据流。使用例子如下 ip="127.0.0.1" port="2025" StopAll= "" StartAll= "" CALL ExecCmd("SocketReg.exe","") set Socket = CreateObject("Socket.TCP") Socket.Host = ip & ":" & port Socket.Timeout = 1 If Err.Number <> 0 Then Err.Clear Socket.open If Err.Number > 0 Then Err.Clear else Socket.SendText Chr(3) & Chr(0) & Chr(0) & Chr(0) strTemp = dbHex(len(StopAll),32) Socket.SendText strTemp for i=1 to 4-len(strTemp ) Socket.SendText Chr(0) next Socket.SendText StopAll Socket.Wait ' Wscript.echo Socket.buffer Socket.Close end if Function ExecCmd(CommandLine,param) 'dim sh 'Set sh = CreateObject("Shell.Application") dim ws,cmd,ret Set ws = CreateObject("WScript.Shell") cmd = CommandLine & chr(32) & param 'msgbox(cmd) 'call sh.ShellExecute(CommandLine,param , , "open",1) ret =ws.run(cmd,0,true) End Function function binarytostring(binary) dim i, s for i = 1 to lenb(binary) s = s & chr(ascb(midb(binary, i, 1))) next binarytostring= s end function function rsbinarytostring(xbinary) dim binary if vartype(xbinary)=8 then binary = multibytetobinary(xbinary) else binary = xbinary end if dim rs, lbinary const adlongvarchar = 201 set rs = createobject("adodb.recordset") lbinary = lenb(binary) if lbinary>0 then rs.fields.append "mbinary", adlongvarchar, lbinary rs.open rs.addnew rs("mbinary").appendchunk binary rs.update rsbinarytostring = rs("mbinary") else rsbinarytostring = "" end if end function function multibytetobinary(multibyte) dim rs, lmultibyte, binary const adlongvarbinary = 205 set rs = createobject("adodb.recordset") lmultibyte = lenb(multibyte) if lmultibyte>0 then rs.fields.append "mbinary", adlongvarbinary, lmultibyte rs.open rs.addnew rs("mbinary").appendchunk multibyte & chrb(0) rs.update binary = rs("mbinary").getchunk(lmultibyte) end if multibytetobinary = binary end function Const dbHexMap="123456789ABCDEFGHIJKLMNOPQRSTUV" Function dbHex(ByVal n, H) If IsNumeric(n) And n>0 Then Dim l, i, j(), k l=Int(Log(n)/Log(H)+1) ReDim j(l-1) For i=l-1 To 0 step -1 k=(H^i) If n>=k Then j(l-i-1)= Mid(dbHexMap,n\(H^i),1) Else j(l-i-1)= 0 End If n=n Mod k Next dbHex=Join(j,"") Else dbHex=0 End If End Function Function deHex( str, H) Dim i, j, l l=Len(str) j=0 For i=1 To l j=j+ H^(l-i)*InStr(dbHexMap,Mid(str,i,1)) Next deHex=j End Function function stream_binarytostring(binary, charset) const adtypetext = 2 const adtypebinary = 1 dim binarystream set binarystream = createobject("adodb.stream") binarystream.type = adtypebinary binarystream.open binarystream.write binary binarystream.position = 0 binarystream.type = adtypetext if len(charset) > 0 then binarystream.charset = charset else binarystream.charset = "us-ascii" end if stream_binarytostring = binarystream.readtext end function