欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

vbs mdb打包解包代码打包

程序员文章站 2022-08-27 15:28:09
pack.vbs 用来打包文件夹, 根目录为文件所在目录. 复制代码 代码如下: dim n, ws, fsox, thepath set ws = createobjec...

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