zipfile.prg

MSComm控件资料,Visual Basic 6.0(以下简称VB) 是一种功能强大、简单易学的程序设计语言。它不但保留了原先Basic语言的全部功能

*  Program...........: ZIPFILE.PRG
*  Author............: Ken R. Levy
*  Project...........: ZipFile
*  Created...........: 08/09/1995
*  Copyright.........: (c) Flash Creative Management, Inc., 1995
*) Description.......: ZipFile utility used to create ZIP file from project.


LPARAMETERS tcProjectFile,tcZIPFile,tlSaveList
LOCAL lcProjectFile,lcAlias,lcFileName,lcZIPFile,lcZIPList
LOCAL lcCommandLine,lcFileExt,lnCount,lnLastSelect,lcLastConsole

*-- If no parameters passed, execute ZIPFile dialog.
lcFileName=FULLPATH('zipfile.scx',SYS(16))
IF PARAMETERS()=0 AND FILE(lcFileName)
	DO FORM (lcFileName) WITH (tcProjectFile),(tcZIPFile),(tlSaveList)
	RETURN
ENDIF

IF EMPTY(tcProjectFile) OR TYPE('tcProjectFile')#'C'
	lcProjectFile=''
ELSE
	lcProjectFile=ALLTRIM(tcProjectFile)
	IF NOT '.'$lcProjectFile
		lcProjectFile=lcProjectFile+'.pjx'
	ENDIF
ENDIF
IF EMPTY(lcProjectFile) OR NOT FILE(lcProjectFile)
	lcProjectFile=GETFILE('pjx')
ELSE
ENDIF
IF EMPTY(lcProjectFile)
	RETURN .F.
ENDIF
lcProjectFile=LOWER(FULLPATH(lcProjectFile))
lnAtPos=AT('.',lcProjectFile)
IF EMPTY(tcZIPFile)
	lcZIPFile=LEFT(lcProjectFile,lnAtPos-1)+'.ZIP'
ELSE
	lcZIPFile=LOWER(ALLTRIM(tcZIPFile))
	IF NOT '.'$lcZIPFile
		lcZIPFile=lcZIPFile+'.zip'
	ENDIF
	IF NOT ':'$lcZIPFile AND NOT '\'$lcZIPFile
		lcZIPFile=LOWER(FULLPATH(lcZIPFile,lcProjectFile))
	ENDIF
ENDIF
lcZIPList=LEFT(lcProjectFile,lnAtPos-1)+'.lst'
lnLastSelect=SELECT()
lcAlias='pjxdata'
IF USED(lcAlias)
	USE IN (lcAlias)
ENDIF
USE (lcProjectFile) AGAIN ALIAS (lcAlias) SHARED NOUPDATE
IF NOT USED(lcAlias)
	WAIT WINDOW "Project '"+lcProjectFile+"' could not be opened"
	RETURN .F.
ENDIF
SET FILTER TO NOT DELETED()
lcLastConsole=SET('CONSOLE')
SET CONSOLE OFF
SET TEXTMERGE OFF
SET TEXTMERGE TO
ERASE (lcZIPList)
SET TEXTMERGE ON
SET TEXTMERGE TO (lcZIPList)
lnCount=0
SCAN ALL FOR NOT EMPTY(Name)
	lcFileName=LOWER(FULLPATH(ALLTRIM(STRTRAN(MLINE(Name,1),CHR(0),'')), ;
			lcProjectFile))
	IF NOT FILE(lcFileName)
		WAIT WINDOW "File '"+lcFileName+"' not found"
		LOOP
	ENDIF
	lnCount=lnCount+1
	TEXT
<<lcFileName>>
	ENDTEXT
	lcFileExt=RIGHT(lcFileName,4)
	IF NOT INLIST(lcFileExt,'.scx','.vcx','.mnx','.frx','.lbx','.pjx','.dbc')
		LOOP
	ENDIF
	IF lcFileExt=='.dbc'
		lcFileName=LEFT(lcFileName,LEN(lcFileName)-2)+'cx'
		TEXT
<<lcFileName>>
		ENDTEXT
	ENDIF
	lcFileName=LEFT(lcFileName,LEN(lcFileName)-1)+'t'
	TEXT
<<lcFileName>>
	ENDTEXT
ENDSCAN
IF lnCount>0
	TEXT
<<>>
	ENDTEXT
ENDIF
SET TEXTMERGE OFF
SET TEXTMERGE TO
IF USED(lcAlias)
	USE IN (lcAlias)
ENDIF
SELECT (lnLastSelect)
SET CONSOLE &lcLastConsole
IF lnCount=0
	WAIT WINDOW "No files found in project '"+lcProjectFile+"'"
	RETURN .F.
ENDIF
ERASE (lcZIPFile)
lcCommandLine='PKZIP -p -P -r '+lcZIPFile+' @'+lcZIPList
RUN /7 &lcCommandLine
IF NOT tlSaveList
	ERASE (lcZIPList)
ENDIF
RETURN