* REPORTOUTPUT WRAPPER PRG #INCLUDE REPORTOUTPUT.H LPARAMETERS m.tvType, m.tvReference, m.tvUnload EXTERNAL TABLE OUTPUTAPP_INTERNALDBF LOCAL m.oTemp, m.iType, m.iIndex, m.cType, m.cConfigTable, ; m.lSuccess, m.lSetTalkBackOn, m.lSafety, m.cFilter, m.cClass, m.cLib, m.cModule, ; m.oConfig, m.oError, m.lStringVar, m.lObjectMember, m.iParams, ; m.iUnload, m.iSelect, m.iSession, m.lSetTalkBackOnDefaultSession, m.vReturn, ; m.oSH IF (SET("TALK") = "ON") SET TALK OFF m.lSetTalkBackOn = .T. ENDIF m.iParams = PARAMETERS() m.iSession = SET("DATASESSION") m.oSH = CREATEOBJECT("SH") m.oSH.Execute(VFP_DEFAULT_DATASESSION) m.iSelect = SELECT() IF (SET("TALK") = "ON") SET TALK OFF m.lSetTalkBackOnDefaultSession = .T. ENDIF * if it is not integer, convert * if it is lower than -1, * this is a value private to REPORTOUTPUT.APP, * potentially not even a ListenerType * if it is not numeric, just set up the * reference collection DO CASE CASE VARTYPE(m.tvType) # "N" m.vReturn = ReportOutputConfig(OUTPUTAPP_CONFIGTOKEN_SETTABLE, .F., .F., m.oSH) DO ReportOutputCleanup WITH ; m.iSelect, m.lSetTalkBackOnDefaultSession, ; m.iSession, m.lSetTalkBackOn, m.oSH RETURN m.vReturn CASE ABS(m.tvType) # m.tvType AND m.tvType < LISTENER_TYPE_DEF m.vReturn = ReportOutputConfig(m.tvType, @m.tvReference, m.tvUnload, m.oSH) DO ReportOutputCleanup WITH ; m.iSelect, m.lSetTalkBackOnDefaultSession, ; m.iSession, m.lSetTalkBackOn, m.oSH RETURN m.vReturn OTHERWISE m.iType = INT(m.tvType) ENDCASE IF m.iParams = 3 m.iUnload = VAL(TRANSFORM(m.tvUnload)) IF VARTYPE(m.tvUnload) = "L" AND m.tvUnload m.vReturn = UnloadListener(m.iType) DO ReportOutputCleanup WITH ; m.iSelect, m.lSetTalkBackOnDefaultSession, ; m.iSession, m.lSetTalkBackOn, m.oSH RETURN m.vReturn ELSE IF m.iUnload > 0 IF m.iUnload = OUTPUTAPP_LOADTYPE_UNLOAD m.vReturn = UnloadListener(m.iType) DO ReportOutputCleanup WITH ; m.iSelect, m.lSetTalkBackOnDefaultSession, ; m.iSession, m.lSetTalkBackOn, m.oSH RETURN m.vReturn ELSE DO UnloadListener WITH m.iType ENDIF ENDIF ENDIF ENDIF DO ReportOutputDeclareReference WITH ; m.iParams, m.tvReference, m.lObjectMember, m.lStringVar IF m.iType = LISTENER_TYPE_DEF * always provide the reference fresh, * do not use the collection m.oTemp = CREATEOBJECT("ReportListener") ELSE * check for public reference var (collection) * if it is not available create m.cType = TRANSFORM(m.iType) m.iIndex = -1 DO CheckPublicListenerCollection WITH m.cType, m.iIndex IF m.iIndex > -1 m.oTemp = OUTPUTAPP_REFVAR.ITEM[m.iIndex] ELSE * if they've passed in an existing object and * it's not in the collection yet, add * (SP1 change) IF TestListenerReference(m.tvReference) OUTPUTAPP_REFVAR.ADD(m.tvReference,m.cType) * synch this up, JIC: DO CheckPublicListenerCollection WITH m.cType, m.iIndex IF m.iIndex > -1 m.oTemp = m.tvReference ENDIF ENDIF ENDIF IF NOT TestListenerReference(m.oTemp) * if it is not available, * look for config file, choosing between built-in and * on-disk m.oError = NULL STORE "" TO m.cClass, m.cLib, m.cModule * try to open, error handle for * unavailability DO GetConfigObject WITH m.oConfig TRY SELECT 0 m.iIndex = -1 DO CheckPublicListenerCollection WITH ; TRANSFORM(OUTPUTAPP_CONFIGTOKEN_SETTABLE), m.iIndex IF m.iIndex > -1 m.cConfigTable = OUTPUTAPP_REFVAR.ITEM[m.iIndex] ELSE m.cConfigTable = m.oConfig.GetConfigTable() * the collection will have been created by * CheckPublicListenerCollection OUTPUTAPP_REFVAR.ADD(m.cConfigTable,TRANSFORM(OUTPUTAPP_CONFIGTOKEN_SETTABLE)) ENDIF USE (m.cConfigTable ) ALIAS OutputConfig SHARED IF m.oConfig.VerifyConfigTable("OutputConfig") * look for filter records first: * OBJTYPE 110 identifies a configuration record * OBJCODE 1 Configuration item type. 1= registry filter * OBJNAME not used * OBJVALUE not used * OBJINFO Filter expression SELECT OutputConfig SET ORDER TO 0 LOCATE && GO TOP LOCATE FOR ObjType = OUTPUTAPP_OBJTYPE_CONFIG AND ; ObjCode = OUTPUTAPP_OBJCODE_FILTER AND ; NOT (EMPTY(ObjInfo) OR DELETED()) IF FOUND() m.cFilter = " AND (" + ALLTR(ObjInfo) + ")" ELSE m.cFilter = "" ENDIF * check for type record for the passed type and * not deleted and in the filter * OBJTYPE 100 identifies a Listener registry record * OBJCODE Listener Type values -1, 0, 1, and 2 supported by default * OBJNAME Class to instantiate may be ReportListener (base class) * OBJVALUE Class library or procedure file may be blank * OBJINFO Module/Application containing library may be blank LOCATE && GO TOP LOCATE FOR ObjType = OUTPUTAPP_OBJTYPE_LISTENER AND ; (ObjCode = m.iType) ; &cFilter. AND (NOT DELETED()) IF FOUND() * get values m.cClass = ALLTRIM(ObjName) m.cLib = ALLTRIM(ObjValue) m.cModule = ALLTR(ObjInfo) ELSE DO GetSupportedListenerInfo WITH ; m.iType, m.cClass, m.cLib, m.cModule ENDIF ELSE IF ISNULL(m.oError) && should be m.oError = CREATEOBJECT("Exception") m.oError.Message = OUTPUTAPP_CONFIGTABLEWRONG_LOC ENDIF IF OUTPUTAPP_DEFAULTCONFIG_AFTER_CONFIGTABLEFAILURE DO GetSupportedListenerInfo WITH ; m.iType, m.cClass, m.cLib, m.cModule ENDIF ENDIF IF USED("OutputConfig") USE IN OutputConfig ENDIF IF NOT EMPTY(m.cClass) IF NOT INLIST(UPPER(JUSTEXT(m.cModule)),"APP","EXE", "DLL") * frxoutput can be built into the current app or exe m.cModule = "" ENDIF m.oTemp = NEWOBJECT(m.cClass, m.cLib, m.cModule) ENDIF CATCH TO m.oError EXIT FINALLY * m.oSH.Execute(m.iSession) * SET DATASESSION TO (m.iSession) ENDTRY IF NOT ISNULL(m.oError) DO ReportOutputCleanup WITH ; m.iSelect, m.lSetTalkBackOnDefaultSession, ; m.iSession, m.lSetTalkBackOn, m.oSH HandleError(m.oError) ELSE IF TestListenerReference(m.oTemp) AND ; PEMSTATUS(m.oTemp,"ListenerType",5) * see notes below, we don't * prevent the assignment if not * a listener but we do not want it * in the collection nonetheless #IF OUTPUTAPP_ASSIGN_TYPE IF UPPER(m.oTemp.BaseClass) == UPPER(m.oTemp.Class) m.oTemp.ListenerType = m.iType ENDIF #ENDIF OUTPUTAPP_REFVAR.ADD(m.oTemp,m.cType) ENDIF ENDIF STORE NULL TO m.oConfig, m.oError ENDIF ENDIF m.lSuccess = TestListenerReference(m.oTemp) * we don't test for listener baseclass -- * they could hide the property -- * also we get a more consistent * error message letting the product * handle things if the object does * not descend from ReportListener * however, we have to assign type as needed, * and that will require a test. IF m.lSuccess #IF OUTPUTAPP_ASSIGN_OUTPUTTYPE TRY m.oTemp.OutputType =m.iType CATCH WHEN .T. * in case they * hid or protected it, * or have an assign method that errored ENDTRY #ENDIF DO CASE CASE m.iParams = 1 * nothing to assign, just store in the collection CASE m.lStringVar OR m.lObjectMember IF m.lStringVar AND TYPE(m.tvReference) = "U" PUBLIC &tvReference. ENDIF STORE m.oTemp TO (m.tvReference) #IF OUTPUTAPP_ASSIGN_TYPE IF PEMSTATUS(&tvReference.,"ListenerType",5) AND ; UPPER(m.oTemp.BaseClass) == UPPER(m.oTemp.Class) &tvReference..ListenerType = m.iType ENDIF #ENDIF OTHERWISE m.tvReference = m.oTemp #IF OUTPUTAPP_ASSIGN_TYPE IF PEMSTATUS(m.tvReference,"ListenerType",5) AND ; UPPER(m.oTemp.BaseClass) == UPPER(m.oTemp.Class) m.tvReference.ListenerType = m.iType ENDIF #ENDIF ENDCASE ELSE DO CASE CASE m.iParams = 1 * nothing to assign CASE m.lStringVar OR m.lObjectMember STORE NULL TO (m.tvReference) OTHERWISE m.tvReference = NULL ENDCASE ENDIF DO ReportOutputCleanup WITH ; m.iSelect, m.lSetTalkBackOnDefaultSession, ; m.iSession, m.lSetTalkBackOn,m.oSH RETURN m.lSuccess && not used by the product but might be used by somebody PROC ReportOutputCleanup( ; m.tiSelect, m.tlResetTalkDefaultSession, m.tiSession,m.tlResetTalk,m.toSH ) m.toSH.Execute(VFP_DEFAULT_DATASESSION) && JIC SELECT (m.tiSelect) IF m.tlResetTalkDefaultSession SET TALK ON ENDIF toSH.Execute(m.tiSession) IF m.tlResetTalk SET TALK ON ENDIF m.toSH = NULL ENDPROC PROC TestListenerReference(m.toRef) RETURN (VARTYPE(m.toRef) = "O") && AND ; && (UPPER(toRef.BASECLASS) == "REPORTLISTENER") PROC GetSupportedListenerInfo(m.tiType, m.tcClass, m.tcLib, m.tcModule) DO CASE CASE OUTPUTAPP_XBASELISTENERS_FOR_BASETYPES AND ; m.tiType = LISTENER_TYPE_PRN m.tcClass = OUTPUTAPP_CLASS_PRINTLISTENER m.tcLib = OUTPUTAPP_BASELISTENER_CLASSLIB CASE OUTPUTAPP_XBASELISTENERS_FOR_BASETYPES AND ; m.tiType= LISTENER_TYPE_PRV m.tcClass = OUTPUTAPP_CLASS_PREVIEWLISTENER m.tcLib = OUTPUTAPP_BASELISTENER_CLASSLIB CASE INLIST(m.tiType,LISTENER_TYPE_PRN,; LISTENER_TYPE_PRV, ; LISTENER_TYPE_PAGED, ; LISTENER_TYPE_ALLPGS) m.tcClass = "ReportListener" CASE m.tiType = LISTENER_TYPE_HTML m.tcClass = OUTPUTAPP_CLASS_HTMLLISTENER m.tcLib = OUTPUTAPP_BASELISTENER_CLASSLIB CASE m.tiType = LISTENER_TYPE_XML m.tcClass = OUTPUTAPP_CLASS_XMLLISTENER m.tcLib = OUTPUTAPP_BASELISTENER_CLASSLIB CASE m.tiType = LISTENER_TYPE_DEBUG m.tcClass = OUTPUTAPP_CLASS_DEBUGLISTENER m.tcLib = OUTPUTAPP_BASELISTENER_CLASSLIB OTHERWISE * ERROR here? * No, let product handle it consistently. ENDCASE ENDPROC PROC ReportOutputConfig(m.tnType, m.tvReference, m.tvUnload, m.toSH) * NB: early quit in case somebody * calls the thing improperly, * even from the command line with a SET PROC IF VARTYPE(m.tnType) # "N" RETURN .F. ENDIF * can support other things besides writing the * table here LOCAL m.iSession, oSession, m.oError, m.oConfig, m.cDBF, m.lSuccess, m.cType, m.iIndex m.oError = NULL m.oConfig = NULL m.iSession = SET("DATASESSION") m.lSuccess = .F. TRY DO CASE CASE m.tnType = OUTPUTAPP_CONFIGTOKEN_SETTABLE AND ; VARTYPE(m.tvReference) = "C" AND ; FILE(FULLPATH(FORCEEXT(TRANSFORM(m.tvReference),"DBF"))) * use FILE() because it can be in the app m.cDBF = FULLPATH(FORCEEXT(TRANSFORM(m.tvReference),"DBF")) m.iIndex = -1 m.cType = TRANSFORM(OUTPUTAPP_CONFIGTOKEN_SETTABLE) DO CheckPublicListenerCollection WITH m.cType, m.iIndex IF m.iIndex # -1 OUTPUTAPP_REFVAR.REMOVE[m.iIndex] ENDIF OUTPUTAPP_REFVAR.ADD(m.cDBF,m.cType) m.lSuccess = .T. CASE m.tnType = OUTPUTAPP_CONFIGTOKEN_WRITETABLE oSession = CREATEOBJECT("session") m.lSafety = SET("SAFETY") = "ON" m.toSH.Execute(oSession.DataSessionID) IF m.lSafety SET SAFETY ON ENDIF DO GetConfigObject WITH m.oConfig, .T. * use XML class, not config superclass, * to write both sets of records, base config outline * and base listener's nodenames m.cDBF = FORCEEXT(FORCEPATH(OUTPUTAPP_EXTERNALDBF, JUSTPATH(SYS(16,0))),"DBF") m.oConfig.CreateConfigTable(m.cDBF) IF NOT EMPTY(SYS(2000,m.cDBF)) m.iIndex = -1 m.cType = TRANSFORM(OUTPUTAPP_CONFIGTOKEN_SETTABLE) DO CheckPublicListenerCollection WITH m.cType, m.iIndex IF m.iIndex # -1 OUTPUTAPP_REFVAR.REMOVE[m.iIndex] ENDIF OUTPUTAPP_REFVAR.ADD(m.cDBF,m.cType) USE (m.cDBF) LOCATE FOR ObjType = OUTPUTAPP_OBJTYPE_LISTENER AND ; ObjCode = LISTENER_TYPE_DEBUG AND ; UPPER(ALLTRIM(ObjName)) == 'DEBUGLISTENER' AND ; ObjValue = OUTPUTAPP_BASELISTENER_CLASSLIB AND ; DELETED() IF EOF() INSERT INTO (ALIAS()) VALUES ; (OUTPUTAPP_OBJTYPE_LISTENER ,LISTENER_TYPE_DEBUG,'DebugListener',OUTPUTAPP_BASELISTENER_CLASSLIB,SYS(16,0)) DELETE NEXT 1 ENDIF *!* SELECT ObjType, ObjCode, ObjName, ObjValue , ; *!* LEFT(ObjInfo,30) AS Info FROM (m.cDBF) ; *!* INTO CURSOR STRTRAN(OUTPUTAPP_CONFIGTABLEBROWSE_LOC," ","") *!* SELECT (STRTRAN(OUTPUTAPP_CONFIGTABLEBROWSE_LOC," ","")) *!* BROWSE TITLE OUTPUTAPP_CONFIGTABLEBROWSE_LOC FIELDS ; *!* ObjType, ObjCode, ObjName, ObjValue , Info = LEFT(ObjInfo,30), ObjInfo BROWSE TITLE OUTPUTAPP_CONFIGTABLEBROWSE_LOC USE m.lSuccess = .T. ELSE m.lSuccess = .F. ENDIF OTHERWISE m.iIndex = -1 m.cType = TRANSFORM(OUTPUTAPP_CONFIGTOKEN_SETTABLE) DO CheckPublicListenerCollection WITH m.cType, m.iIndex IF m.iIndex = -1 * don't disturb it if it's there DO GetConfigObject WITH m.oConfig m.cDBF = m.oConfig.GetConfigTable() OUTPUTAPP_REFVAR.ADD(m.cDBF,m.cType) m.tvReference = m.cDBF ELSE m.tvReference= OUTPUTAPP_REFVAR.ITEM[m.iIndex] ENDIF m.lSuccess = .T. ENDCASE CATCH WHEN WTITLE() = OUTPUTAPP_CONFIGTABLEBROWSE_LOC * MESSAGEBOX("here") * error 57 on the browse -- no table open ad nauseum CATCH TO m.oError m.lSuccess = .F. FINALLY m.toSH.Execute(m.iSession) ENDTRY IF NOT ISNULL(m.oError) HandleError(m.oError) ENDIF RETURN m.lSuccess ENDPROC PROCEDURE GetConfigObject(m.toCfg, m.tXML) LOCAL m.lcModule m.lcModule = _REPORTOUTPUT IF NOT INLIST(UPPER(JUSTEXT(m.lcModule)),"EXE","APP","DLL") m.lcModule = SYS(16,0) ENDIF IF NOT INLIST(UPPER(JUSTEXT(m.lcModule)), "EXE","APP","DLL") m.lcModule = "" ENDIF IF m.tXML m.toCfg = NEWOBJECT(OUTPUTAPP_CLASS_XMLLISTENER,OUTPUTAPP_BASELISTENER_CLASSLIB, m.lcModule) ELSE m.toCfg = NEWOBJECT(OUTPUTAPP_CLASS_UTILITYLISTENER,OUTPUTAPP_BASELISTENER_CLASSLIB, m.lcModule) ENDIF IF VARTYPE(toCfg) = "O" m.toCfg.QuietMode = .T. m.toCfg.AppName = OUTPUTAPP_APPNAME_LOC ENDIF ENDPROC PROCEDURE ReportOutputDeclareReference( ; m.tiParams, m.tvReference, m.tlObjectMember, m.tlStringVar) LOCAL m.iDotPos IF m.tiParams > 1 AND ; TYPE("m.tvReference") = "C" m.iDotPos = RAT(".",m.tvReference) IF m.iDotPos > 1 AND ; m.iDotPos < LEN(m.tvReference) IF TYPE(m.tvReference) = "U" IF TYPE(LEFT(m.tvReference,m.iDotPos-1)) = "O" AddProperty(EVAL(LEFT(m.tvReference,m.iDotPos-1)),SUBSTR(m.tvReference,m.iDotPos+1)) m.tlObjectMember = .T. ENDIF ELSE m.tlObjectMember = .T. ENDIF ELSE m.tlStringVar = .T. ENDIF ENDIF ENDPROC PROCEDURE UnloadListener(m.tiType) LOCAL m.lUnload, m.cType IF VARTYPE(OUTPUTAPP_REFVAR) # "O" OR ; NOT (UPPER(OUTPUTAPP_REFVAR.CLASS) == ; UPPER(OUTPUTAPP_REFVARCLASS)) * nothing to do ELSE m.cType = TRANSFORM(m.tiType) * look for reference to a listener of the appropriate type FOR m.iIndex = 1 TO OUTPUTAPP_REFVAR.COUNT IF OUTPUTAPP_REFVAR.GETKEY(m.iIndex) == m.cType OUTPUTAPP_REFVAR.Remove(m.iIndex) m.lUnload = .T. EXIT ENDIF NEXT ENDIF RETURN m.lUnload ENDPROC PROCEDURE HandleError(m.toE) DO CASE CASE NOT ISNULL(m.toE) IF EMPTY(toE.ErrorNo) ERROR toE.Message ELSE ERROR toE.ErrorNo, toE.Details ENDIF CASE NOT EMPTY(MESSAGE()) ERROR MESSAGE() OTHERWISE ERROR OUTPUTAPP_UNKNOWN_ERROR_LOC ENDCASE ENDPROC PROCEDURE CheckPublicListenerCollection(m.tcType, m.tiIndex) LOCAL m.iIndex IF VARTYPE(OUTPUTAPP_REFVAR) # "O" OR ; NOT (UPPER(OUTPUTAPP_REFVAR.CLASS) == ; UPPER(OUTPUTAPP_REFVARCLASS)) * could be a collection subclass * in which case look for * AINSTANCE(aTemp, ) PUBLIC OUTPUTAPP_REFVAR STORE CREATEOBJECT(OUTPUTAPP_REFVARCLASS) TO ([OUTPUTAPP_REFVAR]) ENDIF IF NOT EMPTY(m.tcType) FOR m.iIndex = 1 TO OUTPUTAPP_REFVAR.COUNT IF OUTPUTAPP_REFVAR.GETKEY(m.iIndex) == m.tcType m.tiIndex = m.iIndex EXIT ENDIF NEXT ENDIF ENDPROC DEFINE CLASS SH AS Custom PROCEDURE Execute(m.tiSession) SET DATASESSION TO (m.tiSession) ENDPROC ENDDEFINE