WebShell打包网站成MDB格式化后解压时用得到~

打包压缩代码.vbs

Dim n, ws, fsoX, thePath      
Set ws = CreateObject("WScript.Shell")  
Set fsoX = CreateObject("Scripting.FileSystemObject")  
thePath = ws.Exec("cmd /c cd").StdOut.ReadAll() & ""  
i = InStr(thePath, Chr(13))  
thePath = Left(thePath, i - 1)  
n = len(thePath)  
n Error Resume Next  
addToMdb(thePath)  
Wscript.Echo "当前目录已经打包完毕,根目录为当前目录"   
Sub addToMdb(thePath)  
    Dim rs, conn, stream, connStr  
    Set rs = CreateObject("ADODB.RecordSet")  
    Set stream = CreateObject("ADODB.Stream")  
    Set conn = CreateObject("ADODB.Connection")  
    Set adoCatalog = CreateObject("ADOX.Catalog")  
    connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=Packet.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  
    fsoTreeForMdb thePath, rs, stream  
    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 i, item, theFolder, folders, files  
    sysFileList = "$" & WScript.ScriptName & "$Packet.mdb$Packet.ldb$"  
    Set theFolder = fsoX.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(LCase(sysFileList), "$" & LCase(item.Name) & "$") <= 0 Then  
            rs.AddNew  
            rs("thePath") = Mid(item.Path, n + 2)  
            stream.LoadFromFile(item.Path)  
            rs("fileContent") = stream.Read()  
            rs.Update  
        End If  
    Next  
    Set files = Nothing 
    Set folders = Nothing 
    Set theFolder = Nothing 
End Function 

Dim rs, ws, fso, conn, stream, connStr, theFolder  
Set rs = CreateObject("ADODB.RecordSet")  
Set stream = CreateObject("ADODB.Stream")  
Set conn = CreateObject("ADODB.Connection")  
Set fso = CreateObject("Scripting.FileSystemObject")  
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Packet.mdb;" 
 
conn.Open connStr  
rs.Open "FileData", conn, 1, 1  
stream.Open  
stream.Type = 1 
 
On Error Resume Next  
 
Do Until rs.Eof  
    theFolder = Left(rs("thePath"), InStrRev(rs("thePath"), ""))  
    If fso.FolderExists(theFolder) = False Then  
        createFolder(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 
 
Wscript.Echo "所有文件释放完毕!"  
 
Sub createFolder(thePath)  
    Dim i  
    i = Instr(thePath, "")  
    Do While i > 0  
        If fso.FolderExists(Left(thePath, i)) = False Then  
            fso.CreateFolder(Left(thePath, i - 1))  
        End If  
        If InStr(Mid(thePath, i + 1), "") Then  
            ii = i + Instr(Mid(thePath, i + 1), "")  
         Else  
            i = 0 
        End If  
    Loop  
End Sub