ziphistdata.prg

foxpro连接sqlserver的例子

*-- 压缩上个月的数据为一个文件，用来传递给总公司
if	messagebox("你好，这个程序是将上个月的历史数据;
(位于目录histfile中的以XXXXyymm.his的形式存放)压缩;
成一个ZIP文件，并将这个文件传递给东莞总公司，整个执;
行过程是自动完成的，你只要注意看提示的信息，并按相;
应的按纽即可。",1+48,"欢迎词 ^_^") = 2
	retu
endif

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

*-- 获得需要压缩的数据文件，他们位于 histfile 下的 ????YYMM.his
lcYYMM	= substr(dtos(MonthX(pdclsdate,0,.t.)),3,4)

*-- 所有前面4个为表名，后4个为年月份。
lcDataSource = "????&lcYYMM..his"

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

*-- 至少含有1个文件，提示继续压缩
if	messagebox("将压缩上个月(" + allt(str(val(right(lcYYMM,2))))+ "月份)"+;
	"的月结数据(共有 "+ 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 + '_'+ lcYYMM + ".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",;
			sys(5) + curdir() + "histfile\&lcDataSource.",;
			"&lcZipFilePath.&lcZipFileName.")
loZipRpt.show

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

retu