vbs mdb打包解包代码打包

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