PixyPortManager
A port manager
| The application let you manage ports, connecting or listening to them, in order to test the protocols. This beta is working, but the application is under development. There will be in the future an integrated webserver and many features. Come back soon ! You will find an integrated FTP Server (a draft), and a proxy (with minor bugs), |
File Name : pixyportmanager.hta
Requirement : WSH 5.1, IE 5 with VML, WMI, Winsock registred (Visual Studio Installed for example)
Author : Jean-Luc Antoine
Submitted : 28/08/2001
Updated : 19/04/2002
Category : HTA
Remember : The file extension has to be *.HTA
Preview : Click here !
<html xmlns:v="urn:schemas-microsoft-com:vml"
XMLNS:t="urn:schemas-microsoft-com:time">
<head>
<HTA:APPLICATION
APPLICATIONNAME="PixyPortManager"
BORDER="thick" | "dialog" | "none" | "thin"
BORDERSTYLE="normal" | "complex" | "raised" | "static" | "sunken"
CAPTION="yes" CONTEXTMENU="yes"
ID="oHTA" alert(oHTA.applicationName);
INNERBORDER="yes" MAXIMIZEBUTTON="yes" MINIMIZEBUTTON="yes"
NAVIGABLE="no" SCROLL="no" SCROLLFLAT="no"
SELECTION="yes" SHOWINTASKBAR="yes" SINGLEINSTANCE="no"
SYSMENU="yes" VERSION="0.5"
WINDOWSTATE="normal" | "maximize" | "minimize">
<script language=vbscript>
'Notice : All was developed by JLA using Notepad ! Try it yourself, this is the best editor ;=)
'If you don't have a registered version of Winsock, you can find one here : http://planetsourcecode.com/xq/ASP/txtCodeId.4860/lngWId.1/qx/vb/scripts/ShowCode.htm
Option Explicit
Const HexaSize=1000 'Number of characters to dump
Dim hWndHexa,HexaToDisplay 'Handle of the Hexa editor, buffer for data to display in hexa
Const SckMax=11 'Option Base 0
Const DefaultFTPVDir="c:\temp"
Const DefaultHTTPVDir="e:\quake3\extras\help"
Const DefaultHTTPPage="index.htm"
Dim i 'for temporary loop and counter
Dim ActiveSck 'The sock beeing actually displayed
ActiveSck=0
Dim BenchClient2Proxy,BenchNet2Proxy,BenchNbConnect
BenchClient2Proxy=0:BenchNet2Proxy=0:BenchNbConnect=0
'Defind which kind of connection
Const msckClient=1
Const msckServer=2
'Protocols that this prog can deal with
Const psckEcho=7 'TCP/UDP : send all data received
Const psckDiscard=9 'TCP/UDP : listen, accept connexion, close them if they close, that's all
Const psckFTP=21 'TCP
Const psckWhois=43 'TCP
Const pSckHTTP=80 'TCP
Const psckNNTP=119 'TCP
const psckProxy=-1 'Act as a TCP Proxy Server
const psckFtpData=-2
' Protocols
Const sckTCPProtocol=0
Const sckUDPProtocol=1
' State
Const sckClosed=0
const sckOpen=1
Const sckListening=2
Const sckConnectionPending=3
Const sckResolvingHost=4
Const sckHostResolved=5
Const sckConnecting=6
Const sckConnected=7
Const sckClosing=8
Const sckError=9
' Errors
Const sckInvalidPropertyValue=380
Const sckGetNotSupported=394
Const sckSetNotSupported=383
Const sckOutOfMemory=7
Const sckBadState=40006
Const sckInvalidArg=40014
Const sckSuccess=40017
Const sckUnsupported=40018
Const sckInvalidOp=40020
Const sckOutOfRange=40021
Const sckWrongProtocol=40026
Const sckOpCanceled=10004
Const sckInvalidArgument=10014
Const sckWouldBlock=10035
Const sckInProgress=10036
Const sckAlreadyComplete=10037
Const sckNotSocket=10038
Const sckMsgTooBig=10040
Const sckPortNotSupported=10043
Const sckAddressInUse=10048
Const sckAddressNotAvailable=10049
Const sckNetworkSubsystemFailed=10050
Const sckNetworkUnreachable=10051
Const sckNetReset=10052
Const sckConnectAborted=10053
Const sckConnectionReset=10054
Const sckNoBufferSpace=10055
Const sckAlreadyConnected=10056
Const sckNotConnected=10057
Const sckSocketShutdown=10058
Const sckTimedout=10060
Const sckConnectionRefused=10061
Const sckNotInitialized=10093
Const sckHostNotFound=11001
Const sckHostNotFoundTryAgain=11002
Const sckNonRecoverableError=11003
Const sckNoData=11004
Class MyProperties
'A way to define a structure
Public Proto 'The protocole used during the connexion
'Values : psckEcho, psckDiscard, ....
Public ProxySocket 'Parent/Child chained socket (number)
Public Data 'Data that will be sent to Internet by the client socket
Public Mode 'msckClient or msckServer
Public User 'The remote user connected to the local server
Public Password 'His password
Public Allowed 'False if not logged in
Public ftpType 'I for binary or A for Ascii
Public ftpRoot 'Root of the virtual directory
Public ftpCurDir 'Current directory
Public ftpDataSocket 'Passive DTP
Public ScanForVirus 'If we want to check for incoming virii
Private Sub Class_Initialize
ScanForVirus=True
Proto=psckDiscard
End Sub
End Class
Dim sckProp()
ReDim sckProp(SckMax)
For i=0 to SckMax
Set sckProp(i)=New MyProperties
sckProp(i).ftpRoot=DefaultFTPVDir
sckProp(i).ftpCurDir=DefaultFTPVDir
Next
</script>
<SCRIPT Language="VBScript" FOR="window" Event="onUnLoad">
'Close All persisting connections
For i=0 To SckMax
ExecuteGlobal "If Not oSck" & i & ".State=sckClosed Then oSck" & i & ".Close"
'Do Until eval("oSck" & i & ".State") = sckClosed
' DoEvents
'Loop
Next
</SCRIPT>
<SCRIPT Language="VBScript" FOR="window" Event="onLoad">
document.title="PixyPortManager running on " & oSck0.LocalIP & "-" & oSck0.LocalHostName & " (c) 2001 Jean-Luc Antoine"
DisplayState
</SCRIPT>
<SCRIPT Language="VBScript" FOR="window" Event="onResize">
'' mettre en position absolute puis utiliser style.left
'datareceived.style.width=document.body.clientwidth - datareceived.getBoundingClientRect().left
'' document.title=document.body.clientwidth & "-" & datareceived.style.posleft & "-" & datareceived.clientleft & "-" & datareceived.offsetleft & "-" & datareceived.scrollleft & "-" & datareceived.style.borderleft & "-" & datareceived.style.left & "-" & datareceived.style.pixelleft & "-" & datareceived.getBoundingClientRect().left
''DataReceived.style.setExpression("posLeft","document.body.clientLeft + 10");
</SCRIPT>
<script language="vbscript">
Sub ChangeIP
'Sometimes the IP has to be explicitely determined
'If needed, bind the connexion to another adapter
If eval("oSck" & ActiveSck & ".LocalIP")<>LocalBind.Value Then
MyLog "Changing IP to " & LocalBind.Value
ExecuteGlobal "oSck" & ActiveSck & ".Bind 10,LocalBind.Value"
ExecuteGlobal "oSck" & ActiveSck & ".Close"
End If
'If you never change the selectbox value, this sub is never executed
End Sub
Sub btnConnect
MyLog ActiveSck & " - Connexion request on " & RemoteHost.value
ChangeIP
SckProp(ActiveSck).Proto=CInt(Proto.Value)
SckProp(ActiveSck).Mode=msckClient
ExecuteGlobal "oSck" & ActiveSck & ".Protocol=" & Protocole.Value
Select Case Protocole.Value
Case "" & sckUDPProtocol
ExecuteGlobal "oSck" & ActiveSck & ".LocalPort=" & LocalPort.Value
ExecuteGlobal "oSck" & ActiveSck & ".RemoteHost=""" & RemoteHost.value & """"
ExecuteGlobal "oSck" & ActiveSck & ".RemotePort=" & RemotePort.Value
ExecuteGlobal "oSck" & ActiveSck & ".Bind " & LocalPort.Value
Case Else
ExecuteGlobal "oSck" & ActiveSck & ".LocalPort=0"
ExecuteGlobal "oSck" & ActiveSck & ".Connect RemoteHost.value, RemotePort.Value"
End Select
Dim strTemp
strTemp=DataToSend.Value
Select Case SckProp(ActiveSck).Proto
Case psckWhois 'Whois (whois.networksolutions.com)
strTemp="microsoft.com" & vbCrLf
Case pSckHTTP 'HTTP - Web Browsing
strTemp="GET / HTTP/1.1" & vbCrLf & "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, application/vnd.ms-powerpoint, */*" & vbCrLf
strTemp=strTemp & "Accept-Language: fr" & vbCrLf & "Accept-Encoding: gzip, deflate" & vbCrLF & "User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; Win 9x 4.90; Pixy Client)" & vbCrLf
strTemp=strTemp & "Host: " & RemoteHost.Value & vbCrLF & "Connection: Keep-Alive" & vbCrLf & vbCrLf
Case psckNNTP 'NNTP - News Groups
strTemp="help" & vbCrLf
Case Else
End Select
DataToSend.Value=strTemp
DisplayState
End Sub
Sub btnOption
'Get/update some specific params
Dim Chaine
Chaine=""
Select Case CInt(Proto.Value)
Case psckFTP
Chaine="Virtual root directory :<input type=text name=RootDir Value=""" & SckProp(ActiveSck).ftpRoot & """"
Chaine=Chaine & "onchange=""vbscript:Upd"">"
Chaine=Chaine & "<scr" & "ipt language=""vbscript"">Sub Upd:Window.ReturnValue=window.dialogArguments & ""ftpRoot="" & chr(34) & RootDir.Value & chr(34) & """":End Sub:upd</scr" & "ipt>"
Case psckHTTP
Chaine="<input type=checkbox name=SFV "
If SckProp(ActiveSck).ScanForVirus Then Chaine=Chaine & "CHECKED "
Chaine=Chaine & "onclick=""vbscript:Upd"">Scan For Virus"
Chaine=Chaine & "<scr" & "ipt language=""vbscript"">Sub Upd:Window.ReturnValue=window.dialogArguments & ""ScanForVirus=cbool("" & chr(34) & SFV.checked & chr(34) & "")"":End Sub:Upd</scr" & "ipt>"
Case Else
MsgBox "No option available for this kind of connection."
End Select
If Chaine<>"" Then
Dim strResult
strResult=window.showModalDialog("about:" & Chaine & "<p><center><Input type=button value=Close onclick='vbscript:window.close'></center>","SckProp(" & ActiveSck & ").","dialogHeight:300px; dialogWidth:400px; dialogTop:; dialogLeft:; edge:Raised; center:Yes; help:No; resizable:Yes; status:No;")
'msgbox strResult & vbCrLF & SckProp(ActiveSck).ScanForVirus
ExecuteGlobal strResult
'msgbox strResult & vbCrLF & SckProp(ActiveSck).ScanForVirus
End If
End Sub
Sub btnListen
ChangeIP
SckProp(ActiveSck).Proto=CInt(Proto.Value)
SckProp(ActiveSck).Mode=msckServer
ExecuteGlobal "oSck" & ActiveSck & ".Protocol=" & Protocole.Value
ExecuteGlobal "oSck" & ActiveSck & ".LocalPort=" & LocalPort.Value
Select Case Protocole.Value
Case "" & sckUDPProtocol
ExecuteGlobal "oSck" & ActiveSck & ".RemoteHost=""" & RemoteHost.value & """"
ExecuteGlobal "oSck" & ActiveSck & ".RemotePort=" & RemotePort.Value
ExecuteGlobal "oSck" & ActiveSck & ".Bind " & LocalPort.Value
Case Else
ExecuteGlobal "oSck" & ActiveSck & ".Listen"
End Select
MyLog ActiveSck & " - Begin listening on " & LocalPort.value
DisplayState
End Sub
Sub BtnDisconnect
ExecuteGlobal "oSck" & ActiveSck & ".Close"
MyLog ActiveSck & " - Disconnexion request"
DisplayState
End Sub
Sub SendData
MyLog ActiveSck & " - Sending " & Len(DataToSend.Value) & " bytes"
ExecuteGlobal "oSck" & ActiveSck & ".senddata DataToSend.Value"
End Sub
Sub DisplayHexa(bForce)
'Pops up a modeless window and displays in hexa the data received
'If the window is closed and bForce=False then we do nothing
Dim Contenu,k,n,r,i
Dim HaveToOpen
'### berk ! find another way for these 5 lines ! Use OnUnload for the hexawindow
On error resume next
err.number=0
hWndHexa.document.body.innerhtml="Calculating, please wait"
HaveToOpen=(err.number<>0)
On Error Goto 0
If bForce Or (Not HaveToOpen) Then
Contenu="<font size=2 face=""Verdana, Arial, Helvetica, sans-serif""><pre>Hexa Dump<input type=button style=""font-size:9""onclick='javascript:window.clipboardData.setData(""Text"", document.body.innerText);' Value='Copy To Clipboard'>" & vbCrLf & " 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F" & vbCrLf
For n=1 to Len(HexaToDisplay)
If ((n-1) Mod 16) = 0 Then
s=Right("00000" & Hex(n),6)
r=" "
End If
k=Asc(Mid(HexaToDisplay,n,1))
If k>31 And k<128 Then
Select Case k
Case 60 '<
r=r & "<"
Case 62 '>
r=r & ">"
Case Else
r=r & Chr(k)
End Select
Else
If k>127 Then r=r & "<span title=""" & chr(k) & """>.</span>" Else r=r & "."
End If
s=s & " <span title=" & k & ">" & Right("0" & Hex(k),2) & "</span>"
If ((n Mod 16)=0) or (n=Len(HexaToDisplay)) Then
contenu=contenu & s
for i=1 to ((n Mod 16)>0)*((n Mod 16)*3-48)
contenu=contenu & " "
next
contenu=contenu & r & vbCrLf
End If
Next
If HaveToOpen Then
set hWndHexa=window.showModelessDialog("about:blank","Dialog Arguments Value","dialogHeight: 300px; dialogWidth: 460px; dialogTop: 200px; dialogLeft: 200px; edge: Raised; center: Yes; help: No; resizable: Yes; status: No;")
while hWndHexa.document.ReadyState<>"complete"
wend
End If
hWndHexa.document.body.innerhtml=Contenu & "</pre></font>"
End If
End Sub
Function ReduceLine(Chaine,NbLine)
'Reduce the log to NbLine lines
Dim x,a,i
a = Split(chaine,vbCrLf)
x=UBound(a)-NbLine-1
if x<0 Then x=0
chaine=""
For i = x to UBound(a)
chaine=chaine & vbCrLf & a(i)
Next
ReduceLine=Mid(Chaine,3) 'begins with vbCrLf
End Function
Sub MyLog(Chaine)
TheLog.InnerHTML=ReduceLine(TheLog.InnerHTML & "<br>" & Now & " " & Chaine,70)
End Sub
Sub DisplaySck(Num,State)
ExecuteGlobal "btns" & Num & ".fillcolor=Array(""#483d8b"",""#A0FFA0"",""#00FF00"",""#FF9900"",""#99FF00"",""#A0A0FF"",""#99FF00"",""#BBFFBB"",""#0000FF"",""#FF0000"")(" & State & ")"
End Sub
Sub DisplayState
Dim i
ActiveSck=SckList.Value
LocalBind.Value=Eval("oSck" & ActiveSck & ".LocalIP")
RemoteHost.Value=Eval("oSck" & ActiveSck & ".RemoteHost")
RemoteHostIP.Innertext=Eval("oSck" & ActiveSck & ".RemoteHostIP")
RemotePort.Value=Eval("oSck" & ActiveSck & ".RemotePort")
LocalPort.Value=Eval("oSck" & ActiveSck & ".LocalPort")
Proto.Value=SckProp(ActiveSck).Proto
Protocole.Value=Eval("oSck" & ActiveSck & ".Protocol")
i=eval("oSck" & ActiveSck & ".State")
BtnCon.Disabled=Not(i=SckClosed)
BtnListening.Disabled=Not(i=SckClosed)
BtnDiscon.Disabled=(i=SckClosed)
btnSendData.disabled=(i<>SckConnected) AND (i<>SckOpen)
MyState.Value=Array("Closed","Open","Listening","Connection Pending","Resolving Host","Host Resolved","Connecting","Connected","Closing","Error")(i)
DisplaySck ActiveSck ,i
End Sub
Function GetAvailSck
Dim x
x=SckMax
While (x>-1) And (Eval("oSck" & x & ".State")<>sckClosed)
x=x-1
Wend
GetAvailSck=x
End Function
Function RegExpTest(patrn, strng)
Dim regEx, Match, Matches ' Create variable.
RegExpTest=False
Set regEx=New RegExp ' Create a regular expression.
regEx.Pattern=patrn ' Set pattern.
regEx.IgnoreCase=False ' Set case insensitivity.
regEx.Global=True ' Set global applicability.
Set Matches=regEx.Execute(strng) ' Execute search.
For Each Match in Matches ' Iterate Matches collection.
RegExpTest = True
Next
Set regEx=Nothing
End Function
'''''''''''''''''
' Socket events '
'''''''''''''''''
Sub evtConnect(ByRef oSck,iSck)
'When we connect as a client to a remote host
MyLog iSck & " - Connected to " & oSck.RemoteHost & ":" & oSck.RemotePort & " from local port " & oSck.LocalPort
If SckProp(iSck).Proto=psckProxy Then
'The client socket has to send data
'MyLog iSck & " - Proxy Client socket sending data to " & oSck.RemoteHost
oSck.SendData SckProp(iSck).Data
End If
If iSck<>ActiveSck Then
DisplaySck iSck,oSck.State
Else
DisplayState
End If
End Sub
Sub evtClose(ByRef oSck,iSck)
'If the remote host closes the connexion
If sckProp(iSck).Proto=psckProxy Then
If sckProp(iSck).Mode=msckServer Then 'Close the Client
If eval("oSck" & sckProp(iSck).ProxySocket & ".state")<>sckClosed Then
MyLog "Closing proxy client socket " & sckProp(iSck).ProxySocket
ExecuteGlobal "oSck" & sckProp(iSck).ProxySocket & ".close"
End If
End If
End If
oSck.Close
MyLog iSck & " - Disconnected"
If iSck<>ActiveSck Then
DisplaySck iSck,oSck.State
Else
DisplayState
End If
End Sub
Sub evtDataArrival(ByRef oSck,iSck,bytesTotal)
' bytesTotal:long
dim chaine,i,strTemp,V
Chaine=""
oSck.GetData chaine ',,bytesTotal
If Beep.Checked Then oBeep.getToolkit.beep
Select Case SckProp(iSck).Proto
Case psckHTTP
If SckProp(iSck).ScanForVirus Then
'Search for Nimda
If right(Chaine,44)=" HTTP/1.0" & vbCrLF & "Host: www" & vbCrLF & "Connnection: close" & vbCrLf & vbCrLf Then
strTemp=Left(Chaine,Len(Chaine)-44)
If Left(strTemp,5)="GET /" Then
strTemp=Mid(strTemp,6)
Dim IP
IP=oSck.RemoteHostIP
v=RegExpTest("(c|d|MSADC|scripts(/..%(252f|255c|%35c|c1%9c|c0%2f|c1%1c|c0%af|%35%63|25%35%63)..)?)/(Admin.dll|(winnt/system32/cmd|root).exe\?/c\+dir)",strTemp)
If Not v Then
v=RegExpTest("(_vti_bin|_mem_bin|msadc)(/..%255c../..%255c../..%255c.*)+(/..%c1%1c../..%c1%1c../..%c1%1c..)?/(Admin.dll|winnt/system32/cmd.exe\?/c\+(dir|tftp%20-i%20" & IP & "%20GET%20Admin.dll%20(c|d|e):\Admin.dll))",strTemp)
End If
If Not v Then 'Test tftp
v=RegExpTest("((MSADC|scripts)/root|(c|d|scripts/..%(252f|255c|c1%9c|c0%af|c0%2f|%35c|%35%63|c1%1c|25%35%63)..)/winnt/system32/cmd).exe\?/c\+tftp%20-i%20" & IP & "%+20GET%20Admin.dll%20((c|d|e):\)?Admin.dll",strTemp)
End If
If v Then
MyLog iSck & " - Nimda received ! ignoring..."
Chaine=""
oSck.Close
End If
End If
End If
End If
Case Else
'Other protocols
End Select
If Chaine<>"" Then
MyLog iSck & " - " & oSck.RemoteHostIP & ":" & oSck.RemotePort & " Data Arrival - " & bytesTotal & " bytes on port " & oSck.LocalPort
HexaToDisplay=Right(HexaToDisplay & Chaine,HexaSize)
DisplayHexa False
If RealTimeLog.Checked Then DataReceived.InnerText=ReduceLine(DataReceived.InnerText & Chaine,70)
If SckProp(iSck).Mode=msckServer Then
Select Case SckProp(iSck).Proto
Case psckEcho
oSck.SendData Chaine
Case psckDiscard
Case psckFTP 'http://www.faqs.org/rfcs/rfc959.html
'http://www.w3.org/Protocols/rfc959/4_FileTransfer.html
'delete vbCrLf
If Right(Chaine,2)=vbCrLf Then Chaine=Left(Chaine,Len(Chaine)-2)
i=Instr(Chaine," ")
If i>1 Then 'Commands with parameters
Select Case UCase(Left(Chaine,i-1))
Case "USER" 'USER 123vbcrlf ou USER (none)vbcrlf
SckProp(iSck).User=Mid(Chaine,i+1)
MyLog iSck & " User " & SckProp(iSck).User & " trying to enter"
If UCase(SckProp(iSck).User)="ANONYMOUS" Then
oSck.SendData "331 Anonymous access allowed, send identity (e-mail name) as password." & vbCrLf
Else
oSck.SendData "331 Password required for " & SckProp(iSck).User & "." & vbCrLf
End If
SckProp(iSck).Allowed=False
Case "PASS" 'PASS vbcrlf ou PASS 1234vbCRLF
SckProp(iSck).Password=Mid(Chaine,i+1)
V=False
Select Case SckProp(iSck).User
Case "anonymous"
V=True
Case "test"
If SckProp(iSck).Password="ok" Then V=True
End Select
If V Then 'If Login/password is ok
MyLog iSck & " User " & SckProp(iSck).User & " logged in."
oSck.SendData "230-This is " & oSck0.LocalHostName &_
" Please see the dirmap.txt" & vbCrLf &_
"230-file for more information." & vbCrLf &_
"230 Anonymous user logged in." & vbCrLf
SckProp(iSck).Allowed=True
Else
MyLog iSck & " User " & SckProp(iSck).User & " : access denied."
oSck.SendData "530 User " & SckProp(iSck).User & " cannot log in." & vbCrLf
End If
Case "PORT" 'PORT 127,0,0,1,4,99 IP1,IP2,IP3,IP4,RND*126+1,RND*255+1
'MSB and LSB, octets de poids fort et faible
'issued from a "send"
strTemp=Replace(Mid(Chaine,i+1),",",".")
i=InstrRev(strTemp,".",InstrRev(strTemp,".")-1)
V=Mid(strTemp,i+1)
strTemp=Left(strtemp,i-1)
i=Instr(V,".")
i=CInt(Left(V,i-1))*256+CInt(Mid(V,i+1))
SckProp(iSck).ftpDataSocket=GetAvailSck
SckProp(SckProp(iSck).ftpDataSocket).ftpDataSocket=iSck
SckProp(SckProp(iSck).ftpDataSocket).Proto=psckFtpData
ExecuteGlobal "oSck" & SckProp(iSck).ftpDataSocket & ".LocalPort=0"
ExecuteGlobal "oSck" & SckProp(iSck).ftpDataSocket & ".Connect """ & Left(strtemp,i-1) & """," & i
oSck.SendData "200 PORT command successful." & vbCrLF
'Case "STOR" 'issued from a "send"
'Case "XRMD" 'issued from a "rmdir"
'Case "RNFR" '"rename" source, dest
Case "CWD" 'CWD /
strTemp=Replace(Mid(Chaine,i+1),"/","\")
If Left(strTemp,1)="\" Then 'from root
SckProp(iSck).ftpCurDir=SckProp(iSck).ftpRoot
If Right(SckProp(iSck).ftpCurDir,1)="\" Then SckProp(iSck).ftpCurDir=Left(SckProp(iSck).ftpCurDir,Len(SckProp(iSck).ftpCurDir)-1)
SckProp(iSck).ftpCurDir=SckProp(iSck).ftpCurDir & strTemp
Else 'relative
If Right(SckProp(iSck).ftpCurDir,1)<>"\" Then SckProp(iSck).ftpCurDir=SckProp(iSck).ftpCurDir & "\"
SckProp(iSck).ftpCurDir=SckProp(iSck).ftpCurDir & strTemp
End If
'### s'assurer que le chemin r�duit (hors ..) correspond au root
MyLog "New current directory : " & SckProp(iSck).ftpCurDir
oSck.SendData "250 CWD command successful." & vbCrLf
Case "SITE" 'site help
If UCase(Mid(Chaine,i+1))="HELP" Then
oSck.SendData "214-The following SITE commands are recognized(* ==>'s unimplemented)." & vbCrLf &_
" CKM" & vbCrLf & " DIRSTYLE" & vbCrLf & " HELP" & vbCrLf & " STATS" & vbCrLf &_
"214 HELP command successful." & vbCrLf
Else
oSck.SendData "500 '" & Mid(Chaine,i+1) & "': command not understood" & vbCrLf
End If
Case "TYPE" 'TYPE A for ascii - TYPE I for binary
SckProp(iSck).ftpType=Mid(Chaine,6)
oSck.SendData "200 Type set to " & SckProp(iSck).ftpType & "." & vbCrLf
'Case "OPTS" 'opts utf8 on
Case "HELP"
strTemp="ACCT (specify account)|ALLO (allocate storage vacuously)|" &_
"APPE <sp> file-name|CDUP change to parent directory|" &_
"CWD [ <sp> directory-name ]|DELE <sp> file-name|HELP [ <sp> <string>]|" &_
"LIST [ <sp> path-name]|MDTM (sp) file-name|MKD <sp> path-name|" &_
"MODE (specify transfer mode)|NLST [ <sp> path-name ]|NOOP|" &_
"PASS <sp> password|PASV (set server in passive mode)|" &_
"PORT <sp> b0,b1,b2,b3,b4,b5|PWD (return current directory)|" &_
"QUIT (terminate service)|REIN (reinitialize server state)|" &_
"REST <sp> marker|RETR <sp> file-name|RMD <sp> path-name|" &_
"RNFR <sp> file-name|RNTO <sp> file-name|SITE (site-specific commands)|" &_
"SIZE (sp) file-name|SMNT <sp> pathname|STAT (get server status)|" &_
"STOR <sp> file-name|STOU (store unique file)|STRU (specify file structure)|" &_
"SYST (get operating system type)|TYPE <sp> [ A | E | I | L ]|" &_
"USER <sp> username|XCUP change to parent directory|" &_
"XCWD [ <sp> directory-name ]|XMKD <sp> path-name|" &_
"XPWD (return current directory)|XRMD <sp> path-name|"
i=Instr(strTemp,UCase(Mid(Chaine,6)))
If i>0 Then
oSck.SendData "214 Syntax: " & Mid(strTemp,i,Instr(Mid(strTemp,i),"|")-1) & vbCrLf
Else
oSck.SendData "501 Unknown command " & Mid(Chaine,6) & "." & vbCrLf
End If
'Case "ABOR"
Case Else
oSck.SendData "500 '" & Chaine & "': command not understood" & vbCrLf
End Select
Else
Select Case UCase(Chaine)
Case "LIST" 'Dir
oSck.SendData "150 Opening ASCII mode data connection for /bin/ls." & vbCrLf
SckProp(iSck).Data="dr-xr-xr-x 1 owner group 0 Feb 13 20:02 bussys" & vbCrLf &_
"-r-xr-xr-x 1 owner group 0 Nov 27 2000 dirmap.htm" & vbCrLf &_
"dr-xr-xr-x 1 owner group 0 Feb 25 2000 kbhelp" & vbCrLf
oSck.SendData "226 Transfer complete." & vbCrLf
ExecuteGlobal "oSck" & SckProp(iSck).ftpDataSocket & ".SendData SckProp(" & iSck & ").Data"
'421 Timeout (180 seconds): closing control connection.
'421 Terminating connection.
Case "HELP" '"remotehelp"
oSck.SendData "214-The following commands are recognized(* ==>'s unimplemented)." & vbCrLF &_
" ABOR" & vbCrLf & " ACCT" & vbCrLf & " ALLO" & vbCrLf &_
" APPE" & vbCrLf & " CDUP" & vbCrLf & " CWD" & vbCrLf &_
" DELE" & vbCrLf & " HELP" & vbCrLf & " LIST" & vbCrLF &_
" MDTM" & vbCrLF & " MKD" & vbCrLF & " MODE" & vbCrLf &_
" NLST" & vbCrLf & " NOOP" & vbCrLf & " PASS" & vbCrLF &_
" PASV" & vbCrLF & " PORT" & vbCrLF & " PWD" & vbCrLF &_
" QUIT" & vbCrLf & " REIN" & vbCrLF & " REST" & vbCrLF &_
" RETR" & vbCrLF & " RMD" & vbCrLF & " RNFR" & vbCrLF &_
" RNTO" & vbCrLf & " SITE" & vbCrLF & " SIZE" & vbCrLF &_
" SMNT" & vbCrLf & " STAT" & vbCrLF & " STOR" & vbCrLf &_
" STOU" & vbCrLF & " STRU" & vbCrLf & " SYST" & vbCrLF &_
" TYPE" & vbCrLf & " USER" & vbCrLf & " XCUP" & vbCrLF &_
" XCWD" & vbCrLf & " XMKD" & vbCrLF & " XPWD" & vbCrLf &_
" XRMD" & vbCrLf & "214 HELP command successful." & vbCrLf
Case "NOOP","CWD"
oSck.SendData "200 " & UCase(Chaine) & " command successful." & vbCrLf
Case "PASV"
SckProp(iSck).ftpDataSocket=GetAvailSck
SckProp(SckProp(iSck).ftpDataSocket).ftpDataSocket=iSck
SckProp(SckProp(iSck).ftpDataSocket).Proto=psckFtpData
ExecuteGlobal "oSck" & SckProp(iSck).ftpDataSocket & ".LocalPort=0"
ExecuteGlobal "oSck" & SckProp(iSck).ftpDataSocket & ".Listen"
i=Eval("oSck" & SckProp(iSck).ftpDataSocket & ".LocalPort")
oSck.SendData "227 Entering Passive Mode (" & Replace(oSck.LocalIP,".",",") & "," & i\256 & "," & i Mod 256 & ")." & vbCrLf
Case "PWD","XPWD"
If SckProp(iSck).Allowed=True Then
oSck.SendData "257 ""/"" is current directory." & vbCrLF
Else
oSck.SendData "530 Please login with USER and PASS." & vbCrLf
End If
Case "QUIT"
oSck.SendData "221 Thank You for using Microsoft Products!" & vbCrLf
'### sur fin du send complete faire oSck.Close
Case "SYST"
If SckProp(iSck).Allowed=True Then
oSck.SendData "215 Windows_NT version 5.0" & vbCrLf
Else
oSck.SendData "530 Please login with USER and PASS." & vbCrLf
End If
Case Else
oSck.SendData "500 '" & Chaine & "': command not understood" & vbCrLf
End Select
End If
Case psckHTTP
'#### G�rer le serveur Web
oSck.SendData "HTTP/1.1 200 OK" & vbCrLF & "Date: Mon, 13 Aug 2001 15:42:54 GMT" & vbCrLf & "Server: Apache/1.3.19 (Unix)" & vbCrLf & _
"Last-Modified: Thu, 22 Mar 2001 20:55:40 GMT" & vbCrLf & "ETag: ""13819d-62-3aba66cb""" & vbCrLf & "Accept-Ranges: bytes" & vbCrLf & _
"Content-Length: 101" & vbCrLf & "Connection: close" & vbCrLf & "Content-Type: text/html" & vbCrLf & vbCrLf & "<html>" & _
" <br>Click <a href=""http://www.interclasse.com"">here</a> to visit InterClasse</html>"
Case psckProxy 'Proxy Server
'Get Host info
i=Instr(Chaine,"Host: ")+6
strTemp=Mid(Chaine,i)
strTemp=Left(strTemp,Instr(strTemp,vbCrLf)-1)
'#### Replace GET with no host info
'#### Remove proxy info from data received
'########
' Here is a way to hack incoming/outgoing data
'########
'V=Instr(Chaine,"&score=")
'If V>0 Then
' If Mid(Chaine,V+10,8)="&Pseudo=" Then
' Chaine=Left(Chaine,V+6) & "430" & Mid(Chaine,V+10)
' End If
' If Mid(Chaine,V+10,6)="&Temps" Then
' Chaine=Left(Chaine,V+6) & "430" & Mid(Chaine,V+10)
' End If
'End If
'########
'########
'The parent Socket has to Send Data
i=GetAvailSck
SckProp(i).Mode=msckClient
SckProp(i).Proto=psckProxy
SckProp(i).ProxySocket=iSck
SckProp(i).Data=Chaine
SckProp(iSck).ProxySocket=i
ExecuteGlobal "oSck" & i & ".LocalPort=0"
ExecuteGlobal "oSck" & i & ".Connect """ & strTemp & """,80"
If Bench.Checked Then
BenchClient2Proxy=BenchClient2Proxy+bytesTotal
Client2Proxy.InnerText=BenchClient2Proxy
End If
Case Else
MyLog "protocol " & SckProp(iSck).Proto & " unknown"
End Select
Else 'Client
Select Case SckProp(iSck).Proto
Case psckProxy
If Bench.Checked Then
BenchNet2Proxy=BenchNet2Proxy+bytesTotal
Net2Proxy.InnerText=BenchNet2Proxy
End If
'MyLog iSck & " - sending data with parent proxy socket " & SckProp(iSck).ProxySocket
SckPRop(iSck).Data=Chaine
ExecuteGlobal "oSck" & SckProp(iSck).ProxySocket & ".SendData SckProp(" & iSck & ").Data"
End Select
End If
End If
If iSck<>ActiveSck Then
DisplaySck iSck,oSck.State
Else
DisplayState
End If
End Sub
Sub evtSendComplete(ByRef oSck,iSck)
'When the Socket has finished sending data to the remote host
Dim Info
Info=""
Select Case SckProp(iSck).Proto
Case psckHTTP
'### sauf si keep alive
If SckProp(iSck).Mode=msckServer Then oSck.close
Case psckProxy
'### sauf si keep alive
If SckProp(iSck).Mode=msckServer Then
'Close the server if the client is closed
If eval("oSck" & SckProp(iSck).ProxySocket & ".state")=sckClosed Then oSck.close
Info = " - to local request"
Else
Info = " - " & Len(SckProp(iSck).Data) & " bytes to remote"
End If
'don't close the client, it is waiting on data
Case psckFtpData
oSck.Close
Case Else
'By default don't close (psckEcho, psckDiscard...)
End Select
MyLog iSck & " - Send complete" & Info
If iSck<>ActiveSck Then
DisplaySck iSck,oSck.State
Else
DisplayState
End If
End Sub
Sub evtConnectionRequest(ByRef oSck,iSck,Byval requestID)
'RequestID:long
'when the socket acts as a server and a remote host connects to it
Dim x
If Bench.Checked Then
BenchNbConnect=BenchNbConnect+1
NbRequest.InnerText=BenchNbConnect
End If
x=GetAvailSck
If SckProp(iSck).Proto=psckFtpData Then
oSck.Close 'We have found the connection, kill the listener
oSck.Accept requestID
ElseIf x>-1 Then
'Accept only if we have an available socket to continue listening
MyLog x & " - " & oSck.RemoteHostIP & ":" & oSck.RemotePort & " - Connection request n�" & requestID & " on port " & oSck.LocalPort
'Accept from another socket because this one should listen
ExecuteGlobal "oSck" & x & ".LocalPort =" & oSck.LocalPort '=0 ?
SckProp(x).Proto=SckProp(iSck).Proto
SckProp(x).Mode=msckServer
sckProp(x).ScanForVirus=sckProp(iSck).ScanForVirus
ExecuteGlobal "oSck" & x & ".Accept " & requestID
Select Case SckProp(iSck).Proto
Case psckFTP
SckProp(x).User=""
SckProp(x).Password=""
SckProp(x).Allowed=False
SckProp(x).ftpType="A"
SckProp(x).ftpRoot=SckProp(iSck).ftpRoot
SckProp(x).ftpCurDir=SckProp(x).ftpRoot
ExecuteGlobal "oSck" & x & ".SendData ""220 CPMSFTFTPA05 Microsoft FTP Service (Version 5.0)."" & vbCrLf"
End Select
DisplaySck x,Eval("oSck" & x & ".State")
Else
MyLog iSck & " - " & oSck.RemoteHostIP & " - No more socket for connection request n�" & requestID
End If
If iSck<>ActiveSck Then
DisplaySck iSck,oSck.State
Else
DisplayState
End If
End Sub
Sub evtSendProgress(ByRef oSck,iSck,Byval bytesSent, bytesRemaining)
'bytesSent:long, bytesRemaining:long
MyLog iSck & " - Sending data to " & oSck.RemoteHostIP & ", " & bytesRemaining & " bytes remaining"
End Sub
Sub evtError(ByRef oSck,iSck, ByVal Number, Description, ByVal Scode, ByVal Source, ByVal HelpFile, ByVal HelpContext, ByRef CancelDisplay)
'Number:Integer, Description:String, Scode:Long, Source:String, HelpFile:String, HelpContext:Long, CancelDisplay:Boolean
oSck.Close
MyLog iSck & " - Error " & Number & " - " & Description
CancelDisplay = True
If iSck<>ActiveSck Then
DisplaySck iSck,oSck.State
Else
DisplayState
End If
End Sub
</script>
<STYLE TYPE="text/css">
<!--
v\:* {behavior:url(#default#VML);}
t\:* { behavior:url(#default#time2)}
BODY {
font-family: "Verdana, Arial, Helvetica, sans-serif";
background-color=#003159;
color:#0000FF;
font-size: 8pt;
}
TD { font-size: 8pt;}
BUTTON {
font-size: 7pt;
cursor:hand;
}
TEXTAREA
{
font-family: "Verdana, Arial, Helvetica, sans-serif";
font-size: 7pt;
}
.shadow {filter:Shadow(color=998888,direction=120);height:40}
.fading {font-size:20px;background-color:#003159;color:white;width:300;
filter:Alpha(style=1,finishX=140)}
-->
</STYLE>
</head>
<body leftmargin=0 topmargin=0 rightmargin=0>
<v:rect id=bg style="Position:absolute;LEFT:0pt;TOP:0pt;WIDTH:100%;HEIGHT:100%;Z-INDEX:-1" fillcolor=#003159>
<v:fill type=gradient color2=#a8f4f7 angle=45 method="linear sigma"></v:fill>
</v:rect>
<table width=100% border=0><tr>
<script language="vbscript">
'Create the pool of usable connections (MSWinsock.Winsock) and connect the events
For i=0 To SckMax
document.write "<object id=""oSck" & i & """ classid=""clsid:248DD896-BB45-11CF-9ABC-0080C7E7B78D""></object>"
document.write "<" & "script for=""oSck" & i & """ event=""Connect"" language=""vbscript"">evtConnect Me," & i & "</" & "script>"
document.write "<" & "script for=""oSck" & i & """ event=""Close"" language=""vbscript"">evtClose Me," & i & "</" & "script>"
document.write "<" & "script for=""oSck" & i & """ event=""DataArrival(ByVal bytesTotal)"" language=""vbscript"">evtDataArrival Me," & i & ",bytesTotal</" & "script>"
document.write "<" & "script for=""oSck" & i & """ event=""Error(ByVal Number,Description,ByVal Scode,ByVal Source,ByVal HelpFile,ByVal HelpContext,ByRef CancelDisplay)"" language=""vbscript"">evtError Me," & i & ",Number,Description,Scode,Source,HelpFile,HelpContext,CancelDisplay</" & "script>"
document.write "<" & "script for=""oSck" & i & """ event=""ConnectionRequest(Byval requestID)"" language=""vbscript"">evtConnectionRequest Me," & i & ",requestID</" & "script>"
document.write "<" & "script for=""oSck" & i & """ event=""SendProgress(ByVal bytesRemaining)"" language=""vbscript"">evtSendProgress Me," & i & ",bytesRemaining</" & "script>"
document.write "<" & "script for=""oSck" & i & """ event=""SendComplete"" language=""vbscript"">evtSendComplete Me," & i & "</" & "script>"
'The buttons
document.write "<td><v:roundrect border=0 style=height:24pt;width:100%; arcsize=0.25 fillcolor=#483d8b id=btns" & i & " onclick=""vbscript:SckList.Value=" & i & ":DisplayState"">"
document.write "<v:textbox><center><font color=white size=-1><b>" & i & "</b></center></font></v:textbox>"
document.write "<v:fill type=gradient method=sigma angle=90 color2=#7b68ee id=fbtns" & i & "></v:fill></v:roundrect></td>"
'The animation
document.write "<t:par begin=btns" & i & ".onmouseover>"
document.write "<t:animateColor attributeName=fillcolor values=#483d8b;#7b68ee begin=0.4 dur=0.4 autoreverse=true targetElement=btns" & i & "></t:animateColor>"
document.write "<t:animate attributeName=angle from=90 to=450 begin=0 dur=0.4 autoreverse=true targetElement=fbtns" & i & "></t:animate></t:par>"
Next
</script>
</tr></table>
<div class=shadow>
<SELECT NAME="SckList" onchange="vbscript:DisplayState" style="font-family:tahoma,san-serif;font-size:12px;color:#003159;background-color:#D6E7EF;">
<script language="vbscript">
'Display the list of available sockets
For i=0 To SckMax
document.write"<OPTION value=" & i & ">Socket " & i & "</option>"
Next
</script>
</SELECT>
<button class=shadow name=myState onclick="vbscript:DisplayState" Title="Display the state of the current socket - click to refresh" style='color:white;background-color:#5492a8;width:70;height:20'>Calculating...</button>
<span class=fading contenteditable=true><b> PixyPortManager</b></span>
</div>
<table width=100% height=90%>
<tr><td width=30%>
<Table width=250 height=90%>
<TR><TD align=right>Network adaptater :</TD><td><Select name=LocalBind Title="Choose your network adaptater">
<script language=vbscript>
Dim IpConfigSet,strIP
strIP=""
'Without WMI, use only 1 adapter
On Error Resume Next
Err.Number=0
set IPConfigSet = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
If Err.Number<>0 Then strIP="<option>" & oSck0.LocalIP
On Error Goto 0
If strIP="" Then
For Each IPConfig IN IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i=LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
If IPConfig.IPAddress(i)<>"" Then strIP=strIP & "<option value=""" & IPConfig.IPAddress(i) & """>" & IPConfig.IPAddress(i)
Next
End If
Next
End If
document.Write strIP
LocalBind.Value=oSck0.LocalIP
</script>
</Select></tr>
<TR><TD align=right>Remote Host :</TD><td><input name=RemoteHost type=text Title="ex : localhost or 127.0.0.1"></td></tr>
<TR><td align=right>Remote Port :</td>
<td><input name=RemotePort type=text size=5 Title="21:ftp,80:http"><Input name=BtnCon type=button value="Connect" onclick="vbscript:btnconnect"></td>
</TR>
<TR><TD align=right><span Title="C for Client and S for Server">Type :</span></TD><td><SELECT NAME="Proto"><OPTION Value=-1>Proxy S<OPTION Value=7>Echo S<OPTION value=9 SELECTED>Discard S<OPTION value=21>FTP S<OPTION value=43>WhoIs C<OPTION value=80>HTTP C/S</SELECT>
<Input name=BtnOption type=button value="Options" onclick="vbscript:btnOption"></td></tr>
<TR><TD align=right>Local Port :</TD><td><input name=LocalPort type=text size=5><Input name=BtnListening type=button value="Listen" onclick="vbscript:btnListen"></td></tr>
<TR><TD align=right>Protocole :</TD><td><SELECT NAME="Protocole"><OPTION value=0 SELECTED>TCP</option><OPTION value=1>UDP</option></SELECT><span ID=RemoteHostIP></span></td></tr>
<TR><td align=right></td><td><Input name=BtnDiscon type=button value="Disconnect" onclick="vbscript:btnDisconnect"></td></TR>
<TR height=100%><TD align=right>Data to send :<p><Input Name=btnSendData type=button value="Send" onclick="vbscript:SendData"></TD>
<td width=100%>
<TEXTAREA Name="DataToSend" WRAP="OFF" Title="Type your data to send" style="width:100%;height:100%"></TEXTAREA>
<br><a href="mailto:antoinejl at hotmail.com" title="Report me bugs"><u style="text-underline-position:above;">JLA</u></a>
</td></tr>
</Table>
</td><td width=100%>
<span Title="Click here to display the received datas in hexa" onclick="DisplayHexa True">Data received :</span><input type=button style="font-size:8pt" onclick='vbscript:datareceived.innerhtml="":HexaToDisplay="":DisplayHexa False' Value='CLEAR'><input Type=CheckBox Name=Beep><span onclick="Beep.Checked=Not Beep.Checked">Beep </span><OBJECT ID="oBeep" CLASSID="java:java.awt.Button" STYLE="display:none;"></OBJECT>
<input Type=CheckBox Name=RealTimeLog Checked>Real Time Log
<input Type=CheckBox Name=Bench Checked OnClick="vbScript:If Me.Checked Then BenchClient2Proxy=0:BenchNet2Proxy=0:BenchNbConnect=0" Title="Benchmark the proxy">Activate Bench - <span ID=Client2Proxy Title="Data received from the client"></span>|<span ID=Net2Proxy Title="Data received from Internet"></span>|<span ID=NbRequest Title="Number of Connexion requests"></span>
<DIV ID="DataReceived" contenteditable=true
style="overflow-x:auto;overflow-y:scroll;border:'outset powderblue';width=expression(document.body.clientwidth - DataReceived.getBoundingClientRect().left);height:40%;FILTER: progid:DXImageTransform.Microsoft.Alpha(style=0,opacity=50);background-color=#003159;color=white;"
ONMOUSEOVER="Me.style.backgroundColor='black'"
ONMOUSEOUT="Me.style.backgroundColor='#003159'"></DIV>
<br><span onclick=oSck0.aboutbox>Log :</span><input type=button style="font-size:8pt" onclick='vbscript:TheLog.innerhtml=""' Value='CLEAR'>
<DIV ID="TheLog" WRAP="off" contenteditable=true
style="overflow-x:hidden;overflow-y:scroll;border:'outset powderblue';background-color:transparent;width=expression(document.body.clientwidth - TheLog.getBoundingClientRect().left);height:40%;color:#80C0FF; FILTER: progid:DXImageTransform.Microsoft.Wave(freq=1,LightStrength=10,Phase=10,Strength=5);"
ONMOUSEOVER="Me.style.backgroundColor='black'"
ONMOUSEOUT="Me.style.backgroundColor='transparent'"></DIV>
</td></tr>
</table>
</body>
</html>
| .:: Tools |
|
Server Info Remote Info Compress |
| .:: Articles-fr |
|
Batchs BootSector Droit Accessoire GFA On Now Ecran plasma Syst�me d'exploitation Son Unit�s Scripting Multilingue Site Web Bruit et son Architecture Google |