欢迎来到入门教程网!

vb

当前位置:主页 > 软件编程 > vb >

vbs mdb打包解包代码打包

来源:本站原创|时间:2020-01-10|栏目:vb|点击:

pack.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)
On 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

unpack.vbs 用来解包文件包(Packet.mdb), 解开到当前目录.
复制代码 代码如下:

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
i = i + Instr(Mid(thePath, i + 1), "\")
Else
i = 0
End If
Loop
End Sub

打包下载地址 //www.jb51.net/downtools/A%20SPAdmin%20V1.02.rar

上一篇:将WMI中的DateTime类型转换成VBS时间的函数代码

栏    目:vb

下一篇:VBS伪造HTTP-REFERER的实现方法

本文标题:vbs mdb打包解包代码打包

本文地址:https://www.xiuzhanwang.com/a1/vb/7447.html

网页制作CMS教程网络编程软件编程脚本语言数据库服务器

如果侵犯了您的权利,请与我们联系,我们将在24小时内进行处理、任何非本站因素导致的法律后果,本站均不负任何责任。

联系QQ:835971066 | 邮箱:835971066#qq.com(#换成@)

Copyright © 2002-2020 脚本教程网 版权所有