genhtml.prg

完美的图书馆管理系统 以能够成功运行 密码请看表kl自己添加 或 运行

IF PEMSTATUS(_oHTML,"Body",5)
	_oHTML.Body.AddItem(_oHTML.oRecord.BodyStart)
ENDIF
_oHTML.nWorkArea=oSaveEnvironment.nLastSelect
IF lnShow=5
	llSuccessful=.T.
ELSE
	llSuccessful=_oHTML.Generate()
ENDIF
SELECT 0
IF NOT llSuccessful
	IF VARTYPE(_oHTML)=="O"
		_oHTML.Release
	ENDIF
	_oHTML=.NULL.
	RETURN .NULL.
ENDIF
_oHTML.RunCode(_oHTML.oRecord.PostScript)
IF PEMSTATUS(_oHTML,"Head",5)
	IF NOT EMPTY(_oHTML.oRecord.Style)
		_oHTML.Head.CSS=_oHTML.Head.AddTag("style")
		_oHTML.Head.CSS.AddItem(_oHTML.oRecord.Style)
	ENDIF
	_oHTML.Head.AddItem(_oHTML.oRecord.HeadEnd)
ENDIF
IF PEMSTATUS(_oHTML,"Body",5) AND NOT ISNULL(_oHTML.Body)
	_oHTML.Body.AddItem(_oHTML.oRecord.BodyEnd)
ENDIF
DO CASE
	CASE lnShow=1
		llSuccessful=_oHTML.ViewSource()
	CASE lnShow=2
		llSuccessful=_oHTML.Show()
	CASE lnShow#5
		llSuccessful=_oHTML.SaveFile()
ENDCASE
IF VARTYPE(_oHTML)#"O"
	_oHTML=.NULL.
	RETURN .NULL.
ENDIF
IF NOT llSuccessful
	_MsgBox(M_UNABLE_TO_CREATE_FILE_LOC+[ "]+_oHTML.cOutFile+[".])
ENDIF
IF NOT ll_oHTMLPublic
	_oHTML.Release
	_oHTML=.NULL.
	RETURN .NULL.
ENDIF
RETURN _oHTML



FUNCTION _EvalLinks(tcLinks,toObject,tcType)
LOCAL lcLinks1,lcLinks2,lcLink,lnLinkTotal,lnCount,lnAtPos,lnLastRecNo

lcLinks1=_TransformLinks(tcLinks)
IF EMPTY(lcLinks1)
	RETURN ""
ENDIF
lnLastRecNo=IIF(EOF() OR RECNO()>RECCOUNT(),0,RECNO())
lcLinks2=""
lnLinkTotal=(OCCURS(";",lcLinks1)+1)
FOR lnCount = 1 TO lnLinkTotal
	IF lnCount<lnLinkTotal
		lnAtPos=AT(";",lcLinks1)
		lcLink=ALLTRIM(LEFT(lcLinks1,lnAtPos-1))
		lcLinks1=ALLTRIM(SUBSTR(lcLinks1,lnAtPos+1))
	ELSE
		lcLink=ALLTRIM(lcLinks1)
		lcLinks1=""
	ENDIF
	IF EMPTY(lcLink)
		LOOP
	ENDIF
	LOCATE FOR LOWER(ALLTRIM(ID))==LOWER(ALLTRIM(lcLink))
	IF NOT EOF() AND (EMPTY(tcType) OR ALLTRIM(UPPER(tcType))==ALLTRIM(UPPER(Type)))
		SCATTER MEMO NAME oNewObject
		_InheritProperties(toObject,oNewObject)
		lcLink=_EvalLinks(Links,toObject,tcType)
		IF EMPTY(lcLink)
			LOOP
		ENDIF
	ENDIF
	lcLinks2=lcLinks2+lcLink+";"
ENDFOR
IF lnLastRecNo>0
	GO lnLastRecNo
ENDIF
RETURN lcLinks2
ENDFUNC



FUNCTION _TransformLinks(tcLinks)
LOCAL lcLinks

IF EMPTY(tcLinks)
	RETURN ""
ENDIF
lcLinks=STRTRAN(STRTRAN(STRTRAN(STRTRAN(ALLTRIM(tcLinks),CR_LF,";"), ;
		LF,";"),CR,";"),",",";")
IF LEFT(lcLinks,1)==";"
	lcLinks=ALLTRIM(SUBSTR(lcLinks,2))
ENDIF
IF RIGHT(lcLinks,1)==";"
	lcLinks=ALLTRIM(LEFT(lcLinks,LEN(lcLinks)-1))
ENDIF
RETURN lcLinks
ENDFUNC



FUNCTION _InheritProperties(toObject,toNewObject)

IF EMPTY(toObject.Type) AND NOT EMPTY(toNewObject.Type)
	toObject.Type=toNewObject.Type
ENDIF
IF EMPTY(toObject.Text) AND NOT EMPTY(toNewObject.Text)
	toObject.Text=toNewObject.Text
ENDIF
IF EMPTY(toObject.Desc) AND NOT EMPTY(toNewObject.Desc)
	toObject.Desc=toNewObject.Desc
ENDIF
IF EMPTY(toObject.ClassName) AND NOT EMPTY(toNewObject.ClassName)
	toObject.ClassName=toNewObject.ClassName
ENDIF
IF EMPTY(toObject.ClassLib) AND NOT EMPTY(toNewObject.ClassLib)
	toObject.ClassLib=toNewObject.ClassLib
ENDIF
IF EMPTY(toObject.Module) AND NOT EMPTY(toNewObject.Module)
	toObject.Module=toNewObject.Module
ENDIF
IF EMPTY(toObject.Picture) AND NOT EMPTY(toNewObject.Picture)
	toObject.Picture=toNewObject.Picture
ENDIF
toObject.Properties=_InheritProperty(toObject.Properties,toNewObject.Properties)
toObject.HTML=_InheritProperty(toObject.HTML,toNewObject.HTML)
toObject.Style=_InheritProperty(toObject.Style,toNewObject.Style)
toObject.Script=_InheritProperty(toObject.Script,toNewObject.Script)
toObject.PreScript=_InheritProperty(toObject.PreScript,toNewObject.PreScript)
toObject.GenScript=_InheritProperty(toObject.GenScript,toNewObject.GenScript)
toObject.PostScript=_InheritProperty(toObject.PostScript,toNewObject.PostScript)
toObject.HeadStart=_InheritProperty(toObject.HeadStart,toNewObject.HeadStart)
toObject.BodyStart=_InheritProperty(toObject.BodyStart,toNewObject.BodyStart)
toObject.BodyEnd=_InheritProperty(toObject.BodyEnd,toNewObject.BodyEnd)
toObject.HeadEnd=_InheritProperty(toObject.HeadEnd,toNewObject.HeadEnd)
IF NOT EMPTY(toNewObject.BodyEnd)
	IF EMPTY(toObject.BodyEnd)
		toObject.BodyEnd=toNewObject.BodyEnd
	ELSE
		toObject.BodyEnd=toObject.BodyEnd+CR_LF+toNewObject.BodyEnd
	ENDIF
ENDIF
IF EMPTY(toObject.Comment) AND NOT EMPTY(toNewObject.Comment)
	toObject.Comment=toNewObject.Comment
ENDIF
IF EMPTY(toObject.User) AND NOT EMPTY(toNewObject.User)
	toObject.User=toNewObject.User
ENDIF
ENDFUNC



FUNCTION _InheritProperty(tcValue,tcNewValue)

IF EMPTY(tcNewValue)
	RETURN tcValue
ENDIF
IF EMPTY(tcValue)
	RETURN tcNewValue
ENDIF
IF RIGHT(tcNewValue,2)==CR_LF
	RETURN tcNewValue+tcValue
ENDIF
RETURN tcNewValue+CR_LF+tcValue
ENDFUNC



FUNCTION _CheckGenHTMLTableStructure(tcFileName,tcAlias,tcHTMLVCX)
LOCAL lcFileName,lcPath,lcAlias2,lcLastOnError,oRecord,lcID,lcVersion
LOCAL lcFileName2DBF,lcFileName2FPT,oHTMLCreateTable

lcFileName=LOWER(tcFileName)
lcPath=IIF(EMPTY(lcFileName),"",JUSTPATH(lcFileName)+"\")
IF RECCOUNT()=0
	USE
	oHTMLCreateTable=NEWOBJECT("_HTMLCreateTable",tcHTMLVCX,"")
	oHTMLCreateTable.CreateTable(lcFileName)
	lcLastOnError=ON("ERROR")
	ON ERROR =.F.
	USE (lcFileName) AGAIN SHARED ALIAS (tcAlias)
	IF EMPTY(lcLastOnError)
		ON ERROR
	ELSE
		ON ERROR &lcLastOnError
	ENDIF
	IF NOT USED()
		_MsgBox(M_UNABLE_TO_CREATE_FILE_LOC+[ "]+lcFileName+[".])
		RETURN .F.
	ENDIF
	RETURN
ENDIF
LOCATE FOR LOWER(ALLTRIM(ID))="vfpdefault"
lcVersion=IIF(TYPE(tcAlias+".Version")=="M",ALLTRIM(Version),"")
oHTMLCreateTable=NEWOBJECT("_HTMLCreateTable",tcHTMLVCX,"")
IF VARTYPE(oHTMLCreateTable)#"O" OR (FCOUNT()>=25 AND FIELD(25)=="SAVE" AND ;
		lcVersion>=oHTMLCreateTable.cTableVersion)
	RETURN
ENDIF
lcLastOnError=ON("ERROR")
ON ERROR =.F.
USE (lcFileName) EXCLUSIVE ALIAS (tcAlias)
IF EMPTY(lcLastOnError)
	ON ERROR
ELSE
	ON ERROR &lcLastOnError
ENDIF
IF NOT USED()
	_MsgBox(M_FILE_LOC+[ "]+lcFileName+[" ]+M_COULD_NOT_OPENED_EXCL_LOC)
	RETURN .F.
ENDIF
lcFileName2DBF=LOWER(FORCEPATH(FORCEEXT(lcFileName,"")+"__2",lcPath))
lcFileName2FPT=lcFileName2DBF+".fpt"
lcFileName2DBF=lcFileName2DBF+".dbf"
ERASE (lcFileName2DBF)
ERASE (lcFileName2FPT)
IF TYPE(tcAlias+".Save")=="L"
	COPY TO (lcFileName2DBF) FOR Save AND NOT LOWER(ALLTRIM(ID))="vfpdefault"
ENDIF
USE
ERASE (lcFileName)
oHTMLCreateTable.CreateTable(lcFileName)
lcLastOnError=ON("ERROR")
ON ERROR =.F.
USE (lcFileName) AGAIN SHARED ALIAS (tcAlias)
IF EMPTY(lcLastOnError)
	ON ERROR
ELSE
	ON ERROR &lcLastOnError
ENDIF
IF NOT USED()
	ERASE (lcFileName2DBF)
	ERASE (lcFileName2FPT)
	_MsgBox(M_UNABLE_TO_CREATE_FILE_LOC+[ "]+lcFileName+[".])
	RETURN .F.
ENDIF
IF NOT FILE(lcFileName2DBF)
	RETURN
ENDIF
lcAlias2=LOWER(SYS(2015))
SELECT 0
lcLastOnError=ON("ERROR")
ON ERROR =.F.
USE (lcFileName2DBF) EXCLUSIVE ALIAS (lcAlias2)
SCAN ALL
	lcID=LOWER(ALLTRIM(ID))
	SCATTER MEMO NAME oRecord
	SELECT (tcAlias)
	IF EMPTY(lcID)
		APPEND BLANK
	ELSE
		LOCATE FOR LOWER(ALLTRIM(ID))==lcID
		IF EOF()
			APPEND BLANK
		ENDIF
	ENDIF
	GATHER MEMO NAME oRecord
	SELECT (tcAlias)	
ENDSCAN
IF EMPTY(lcLastOnError)
	ON ERROR
ELSE
	ON ERROR &lcLastOnError
ENDIF
USE
ERASE (lcFileName2DBF)
ERASE (lcFileName2FPT)
SELECT (tcAlias)
LOCATE
ENDFUNC



FUNCTION _MsgBox(tcMessage,tnType)
LOCAL lnType,lnResult,lnLastSelect

lnType=IIF(VARTYPE(tnType)=="N",tnType,16)
lnLastSelect=SELECT()
SELECT 0
WAIT CLEAR
lnResult=MESSAGEBOX(tcMessage,lnType,M_GENHTML_LOC)
WAIT CLEAR
SELECT (lnLastSelect)
RETURN lnResult
ENDFUNC



DEFINE CLASS _SaveEnvironment AS Custom


	cGenHTMLAlias=""
	nGenHTMLRecNo=0
	cGenHTMLTable=""
	nLastSelect=0
	nLastRecNo=0
	nLastSetMemoWidth=0
	cLastSetMessageBar=""
	cLastSetSafety=""
	cLastSetTalk=""
	cWindow=""
	lWindow=.F.


	FUNCTION Init
	this.cLastSetTalk=SET("TALK")
	SET TALK OFF
	this.cLastSetSafety=SET("SAFETY")
	SET SAFETY OFF
	this.nLastSetMemoWidth=SET("MEMOWIDTH")
	SET MEMOWIDTH TO 1024
	this.cLastSetMessageBar=SET("MESSAGE",1)
	SET MESSAGE TO ""
	this.nLastSelect=SELECT()
	this.nLastRecNo=IIF(EOF() OR RECNO()>RECCOUNT(),0,RECNO())
	ENDFUNC
	

	FUNCTION Destroy
	IF NOT EMPTY(this.cWindow) AND WEXIST(this.cWindow)
		IF this.lWindow
			SHOW WINDOW (M_PROPERTIES_LOC)
		ENDIF
		RELEASE WINDOW (this.cWindow)
	ENDIF
	SET MEMOWIDTH TO (this.nLastSetMemoWidth)
	IF USED(this.cGenHTMLAlias)
		USE IN (this.cGenHTMLAlias)
	ENDIF
	SELECT (this.nLastSelect)
	IF USED() AND this.nLastRecNo>0
		GO this.nLastRecNo
	ENDIF
	IF EMPTY(this.cLastSetMessageBar)
		SET MESSAGE TO
	ELSE
		SET MESSAGE TO (this.cLastSetMessageBar)
	ENDIF
	IF this.cLastSetSafety=="ON"
		SET SAFETY ON
	ELSE
		SET SAFETY OFF
	ENDIF
	IF this.cLastSetTalk=="ON"
		SET TALK ON
	ELSE
		SET TALK OFF
	ENDIF
	ENDFUNC


ENDDEFINE



*-- end GenHTML.PRG