用記事本打開modmain.bas文件，copy以下內容到其中：
attribute vb_name = "modmain"
' ==============================================
' 信息打包與展開 (啟動模塊)
'
' 功能 :利用系統所存在的資源自作壓縮與解壓縮程序
'
' 作 者 :謝家峰
' 整理日期 :2004-08-08
' email :[email protected]
'
' ==============================================
'
option explicit
public windowspath as string
public windowssyspath as string
sub main()
dim boottrappath as string
dim setupfilepath as string
dim regexefilepath as string
dim reginfo() as string
dim regstr() as string
dim regfilename as string
dim str as string
dim resultat as long
dim resultat2 as long
dim res as double
dim startinfo as startupinfo
dim procinfo as process_information
dim secu as security_attributes
dim i as integer
if app.previnstance then msgbox "系統已啟動!", , app.exename: end
'獲得系統安裝目錄
windowspath = getwindowsdir
windowssyspath = getwindowssysdir
load frmmain
frmmain.show
end sub
用記事本打開modapi.bas文件，copy以下內容到其中：
attribute vb_name = "modapi"
' ==============================================
' 信息打包與展開 (所調用的api及通用函數模塊)
'
' 功能 :利用系統所存在的資源自作壓縮與解壓縮程序
'
' 作 者 :謝家峰
' 整理日期 :2004-08-08
' email :[email protected]
'
' ==============================================
'
option explicit
public declare function getprivateprofilestring lib "kernel32" alias "getprivateprofilestringa" (byval lpapplicationname as string, byval lpkeyname as any, byval lpdefault as string, byval lpreturnedstring as string, byval nsize as long, byval lpfilename as string) as long
public declare function writeprivateprofilestring lib "kernel32" alias "writeprivateprofilestringa" (byval lpapplicationname as string, byval lpkeyname as any, byval lpstring as any, byval lpfilename as string) as long
public declare function createprocess lib "kernel32" alias "createprocessa" (byval lpapplicationname as string, byval lpcommandline as string, lpprocessattributes as security_attributes, lpthreadattributes as security_attributes, byval binherithandles as long, byval dwcreationflags as long, lpenvironment as any, byval lpcurrentdriectory as string, lpstartupinfo as startupinfo, lpprocessinformation as process_information) as long
public declare function waitforsingleobject lib "kernel32" (byval hhandle as long, byval dwmilliseconds as long) as long
public declare function closehandle lib "kernel32" (byval hobject as long) as long
public declare function getshortpathname lib "kernel32" alias "getshortpathnamea" (byval lpszlongpath as string, byval lpszshortpath as string, byval cchbuffer as long) as long
public declare function getwindowsdirectory lib "kernel32" alias "getwindowsdirectorya" (byval lpbuffer as string, byval nsize as long) as long
public declare function getsystemdirectory lib "kernel32" alias "getsystemdirectorya" (byval lpbuffer as string, byval nsize as long) as long
public const gstrsep_dir$ = "/"
public const gstrsep_urldir$ = "/"
public const gintmax_size% = 255
public const infinite = &hffff
public type startupinfo
cb as long
lpreserved as string
lpdesktop as string
lptitle as string
dwx as long
dwy as long
dwxsize as long
dwysize as long
dwxcountchars as long
dwycountchars as long
dwfillattribute as long
dwflags as long
wshowwindow as integer
cbreserved2 as integer
lpreserved2 as long
hstdinput as long
hstdoutput as long
hstderror as long
end type
public type process_information
hprocess as long
hthread as long
dwprocessid as long
dwthreadid as long
end type
public type security_attributes
nlength as long
lpsecuritydescriptor as long
binherithandle as long
end type
function stripterminator(byval strstring as string) as string
dim intzeropos as integer
intzeropos = instr(strstring, chr$(0))
if intzeropos > 0 then
stripterminator = left$(strstring, intzeropos - 1)
else
stripterminator = strstring
end if
end function
' -----------------------------------------------------------
' 給目錄添加分割線
'
' -----------------------------------------------------------
'
sub adddirsep(strpathname as string)
if right(trim(strpathname), len(gstrsep_urldir)) <> gstrsep_urldir and _
right(trim(strpathname), len(gstrsep_dir)) <> gstrsep_dir then
strpathname = rtrim$(strpathname) & gstrsep_dir
end if
end sub
' -----------------------------------------------------------
' 調用api函數獲得windows的系統目錄
'
' -----------------------------------------------------------
'
function getwindowssysdir() as string
dim strbuf as string
strbuf = space$(gintmax_size)
if getsystemdirectory(strbuf, gintmax_size) > 0 then
strbuf = stripterminator(strbuf)
adddirsep strbuf
getwindowssysdir = strbuf
else
getwindowssysdir = vbnullstring
end if
end function
' -----------------------------------------------------------
' 調用api函數獲取windows目錄
'
' -----------------------------------------------------------
'
function getwindowsdir() as string
dim strbuf as string
strbuf = space$(gintmax_size)
if getwindowsdirectory(strbuf, gintmax_size) > 0 then
strbuf = stripterminator$(strbuf)
adddirsep strbuf
getwindowsdir = strbuf
else
getwindowsdir = vbnullstring
end if
end function
' --------------------------------------
' 測試目錄是否存在
'
' --------------------------------------
'
public function direxists(path as string) as boolean
on error resume next
'對于網絡地址采用*.*形式
if instr(path, "//") then
direxists = (dir$(path & "/*.*") <> "")
else
direxists = (dir$(path & "/nul") <> "")
end if
end function
' --------------------------------------
' 建立文件夾(含多層結構)
'
' --------------------------------------
'
public sub createfloder(floder as string)
dim i as integer
dim path as string
dim floderstr() as string
on error resume next
floderstr = split(floder, "/")
path = floderstr(0)
for i = 1 to ubound(floderstr) - 1
path = path & "/" & floderstr(i)
if not direxists(path) then
mkdir path
end if
next
end sub
' --------------------------------------
' 獲得長文件名的短文件名
'
' --------------------------------------
'
function getshortfilename(filename as string) as string
dim str as string
str = string(lenb(filename), chr(0))
if getshortpathname(filename, str, lenb(filename)) <> 0 then
str = left(str, instr(str, vbnullchar) - 1)
if str = "" then
getshortfilename = filename
else
getshortfilename = str
end if
else
getshortfilename = filename
end if
end function
' --------------------------------------
' 獲得文件名
'
' --------------------------------------
'
public function getfilename(filenamepath as string) as string
dim auxvar() as string
auxvar() = split(filenamepath, "/", , vbtextcompare)
getfilename = auxvar(ubound(auxvar))
end function
' --------------------------------------
' 獲得文件的擴展名
'
' --------------------------------------
'
public function getext(filename as string) as string
dim auxvar() as string
on error resume next
auxvar() = split(filename, "/", , vbtextcompare)
auxvar() = split(auxvar(ubound(auxvar)), ".", , vbtextcompare)
getext = auxvar(ubound(auxvar))
end function
' --------------------------------------
' 測試文件是否存在(不能測試隱含文件和系統文件)
'
' --------------------------------------
'
public function fileexists(filename as string) as boolean
on error resume next
fileexists = (dir$(filename) <> "")
end function
' --------------------------------------
' 查找文件
'
' --------------------------------------
'
function getfiles(filespec as string, optional attributes as vbfileattribute) as string()
dim result() as string
dim filename as string, count as long, path2 as string
const alloc_chunk = 50
redim result(0 to alloc_chunk) as string
filename = dir$(filespec, attributes)
do while len(filename)
count = count + 1
if count > ubound(result) then
redim preserve result(0 to count + alloc_chunk) as string
end if
result(count) = filename
filename = dir$
loop
redim preserve result(0 to count) as string
getfiles = result
end function
' --------------------------------------
' 轉換字符串
'
' --------------------------------------
'
public function stringfrombuffer(buffer as string) as string
dim npos as long
npos = instr(buffer, vbnullchar)
if npos > 0 then
stringfrombuffer = left$(buffer, npos - 1)
else
stringfrombuffer = buffer
end if
end function
' --------------------------------------
' 寫內容到文本文件中
'
' --------------------------------------
'
sub writetextfilecontents(text as string, filename as string, optional appendmode as boolean)
dim fnum as integer, isopen as boolean
on error goto error_handler
fnum = freefile()
if appendmode then
open filename for append as #fnum
else
open filename for output as #fnum
end if
isopen = true
print #fnum, text
error_handler:
if isopen then close #fnum
if err then err.raise err.number, , err.description
end sub
' --------------------------------------
' 讀信息到ini文件中
'
' --------------------------------------
'
public function readinifile(byval strinifile as string, byval strsection as string, byval strkey as string) as string
dim strbuffer as string * 255
if getprivateprofilestring(strsection, strkey, vbnullstring, strbuffer, 255, strinifile) then
readinifile = stringfrombuffer(strbuffer)
end if
end function
' --------------------------------------
' 添加信息到listview控件中
'
' --------------------------------------
'
sub lstvinfo_add(lstvcontrol as listview, infonum as integer, selectedflag as boolean, paramarray infostr())
dim i as integer
with lstvcontrol
.listitems.add , , trim(infostr(0))
if selectedflag then
.listitems(.listitems.count).selected = true
else
.listitems(.listitems.count).selected = false
end if
for i = 2 to infonum
.listitems(.listitems.count).listsubitems.add , , trim(infostr(i - 1))
next
.listitems(.listitems.count).ensurevisible
end with
end sub
自此，代碼copy完成，這時你再打開工程，編譯運行。
1. 信息打包：在frmmain窗體中點擊“打包”，直至打開frmaddinfo窗體，在其中點擊“添加信息”進行信息添加項，同時，你也可以修改目標信息的路徑及文件（說明修改完成后，別忘了點擊“修改信息”信息按鈕噢），你也可以給你的壓縮包修改一個名字。最后點擊“信息打包”按鈕，進行打包；
2. 信息包展開：打包完成，你可以通過frmmain窗體中的展開程序進行壓縮包展開，該展開形式對于存在的文件將覆蓋，你可以修給代碼，使之符合你自己的要求；
3. 你可以將你的壓縮和該程序一同發給你的客戶，這樣，客戶通過展開按鈕便可以給你的程序進行信息更新了；
4. 你也可以將這些代碼變通形式內嵌在你的程序中，通過文件關聯，直接打開你的包文件，這樣會更有趣；
5. 若你是dephi或c++程序員，我相信你看了代碼后，用你的方式做起來會更簡單。
j 若仍不明白，或需求源代碼，請來信告訴我，請來信告訴我，我會盡量滿足你的要求！
