zipcurdata.prg

foxpro连接sqlserver的例子

*-- 压缩当前的数据为一个文件，用来传递
if	messagebox("你好，这个程序是将当前的全部数据;
(位于当前目录和DAT目录的*.dbf形式)压缩成一个ZIP文件，;
并将这个文件传递给其他人，整个执行过程是自动完成的，;
你只要注意看提示的信息，并按相应的按纽即可。",1+48,"欢迎词 ^_^") = 2
	retu
endif

close data all
*-- 删除临时目录中的临时文件
*!*	lnMaxFile = adir(dbflist,"tempback\*.*")
*!*	showprocessbar("正在删除临时备份目录中的文件，请耐心等候...",lnMaxfile)
*!*	for n=1 to lnMaxfile
*!*		showbar(n,"正在删除文件 tempback\" + dbflist(n,1) + " ...")
*!*		curfile = dbflist(n,1)
*!*		dele file "tempback\&curfile"
*!*	endfor
*!*	if	Dire("dat")
*!*		lnMaxFile = adir(dbflist,"tempback\dat\*.*")
*!*		showprocessbar("正在删除临时备份目录中的文件，请耐心等候...",lnMaxfile)
*!*		for n=1 to lnMaxfile
*!*			showbar(n,"正在删除文件 tempback\dat\" + dbflist(n,1) + " ...")
*!*			curfile = dbflist(n,1)
*!*			dele file "tempback\dat\&curfile"
*!*		endfor
*!*	endif

*-- 复制当前目录下的数据库文件
lnMaxFile = adir(dbflist,"*.dbf")
showprocessbar("正在进行复制需要压缩的数据，请耐心等候...",lnMaxfile)
for n=1 to lnMaxfile
	showbar(n,"正在复制数据文件 " + dbflist(n,1) + " 到临时(TempBack)目录...")
	curfile = dbflist(n,1)
	copy file "&curfile" to "tempback\&curfile"
endfor
*-- 复制 DAT 目录下的数据
if	!directory("tempback\dat")
	md tempback\dat
endif
lnMaxFile = adir(dbflist,"dat\*.dbf")
showprocessbar("正在进行复制需要压缩的数据，请耐心等候...",lnMaxfile)
for n=1 to lnMaxfile
	showbar(n,"正在复制数据文件 DAT\" + dbflist(n,1) + " 到临时(TempBack)目录...")
	curfile = dbflist(n,1)
	copy file "dat\&curfile" to "tempback\dat\&curfile"
endfor
*-- 复制非数据库文件，但必须的文件
if	file("system.ini")
	copy file system.ini to tempback\system.ini
endif

*-- 私有变量申明
priv lcMMDD,loZipRpt,lcZipFilePath,lcZipFileName
priv laFiles,lcDataSource,lnTotalFile,llUpdatePath

lcMMDD	= substr(dtos(date()),3,6)
lcDataSource = "TempBack\*.*" + chr(13) + "TempBack\Dat\*.*" + chr(13) + "TempBack\system.ini"

*-- 判断所指定的文件是否存在。
lnTotalFile = adir(laFiles,"TempBack\*.*") + ;
	adir(laFiles,"TempBack\dat\*.*") 
	
if	lnTotalFile = 0
	messagebox("没有指定的文件，处理被终止！",16,"哦，抱歉~~")
	retu
endif

*-- 至少含有1个文件，提示继续压缩
if	messagebox("将压缩当前的数据(共有 "+ allt(str(lnTotalFile))+"个文件) ，是否继续？",4+32,"别看错了") = 7
	retu
endif

*-- 首先选择文件存放的预先设置的路径：
lcZipFilePath = ReadReg (,"ZipFilePath")
if	right(lcZipFilePath,1) # "\" and !empty(lcZipFilePath)
	lcZipFilePath = lcZipFilePath + "\"
endif

*-- 如果预先设置的路径不存在，将提示用户再次指定。
llUpdatePath = .F.
if	!directory("&lcZipFilePath.") 
	messagebox("预先设置的压缩文件存放路径<&lcZipFilePath.>不存在，请重新指定一个路径！",48,"警告")
	llUpdatePath = .T.
else
	*-- 虽然目录存在，但还是需要提示用户是否需要更改这个目录
	if	messagebox("数据将自动压缩到目录“&lcZipFilePath.”中，是否确定？"+chr(13)+;
					"如果选“否”的话，将提示你重新选择一个目录！",4+32,"询问") = 7
		llUpdatePath = .T.
	endif
endif

if	llUpdatePath
	*-- 指定新的路径
	lcZipFilePath = GetDir("c:\","请选择压缩文件所存放的目录：")
	*-- 将指定的新路径存入文件
	if	!empty(lcZipFilePath)
		WriteReg (,"ZipFilePath","&lcZipFilePath.")
	endif
endif

*-- 最终得到需要的路径: lcZipFilePath
if	empty(lcZipFilePath)
	messagebox("你没有选定正确的目录！",48,"处理终止")
	retu
endif

*-- 压缩存放的文件
lcZipFileName = gcAreaCode + lcMMDD + ".zip"

*-- 判断路径
if	file("&lcZipFilePath.&lcZipFileName.")
	*-- 如果存在原文件，则需要删除后才能重建
	if	messagebox("该文件<&lcZipFilePath.&lcZipFileName.>已经存在，是否覆盖？",4+48,"警告") = 7
		if	messagebox("那么你需要直接更新它嘛？",4+32,"询问") = 7
			retu
		else
			*-- 原文件已经存在，接下去是更新该文件
		endif
	else
		*-- 删除原来的文件，以便重新创建
		delwfl("&lcZipFilePath.&lcZipFileName.")
	endif
else
	*-- 最后提示是否压缩
	if	messagebox("当前的数据将会压缩到该文件："+chr(13)+chr(13)+"&lcZipFilePath.&lcZipFileName.",1+32,"询问") = 2
		retu
	endif
endif

*-- 开始压缩
loZipRpt = CreateObject("ZipDataFiles",;
			lcDataSource ,;
			"&lcZipFilePath.&lcZipFileName.")
loZipRpt.show

*-- 提示是否打开压缩文件的文件夹
if	messagebox("是否打开压缩文件所存放的文件夹？",4+32,"提示") = 6
	openurl("&lcZipFilePath.")
endif

retu