home *** CD-ROM | disk | FTP | other *** search
/ ftp.alaska-software.com / 2014.06.ftp.alaska-software.com.tar / ftp.alaska-software.com / acsn / XPPTRIS11E.ZIP / XPPERROR.PRG < prev    next >
Text File  |  2007-08-11  |  19KB  |  617 lines
  1. *+▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  2. *+
  3. *+    Source Module => D:\ALASKA\1\XPPERROR.PRG
  4. *+
  5. *+    Functions: Procedure ErrorSys()
  6. *+               Static Function StandardEH()
  7. *+               Static Function ErrorMessage()
  8. *+               Static Procedure ErrorLog()
  9. *+               Function LineSplit()
  10. *+               Procedure DLLLIST()
  11. *+
  12. *+    Reformatted by Click! 2.03a on Aug-11-2007 at  7:56 pm
  13. *+
  14. *+▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  15.  
  16. //////////////////////////////////////////////////////////////////////
  17. //
  18. //  ERRORSYS.PRG
  19. //
  20. //  Copyright:
  21. //      Alaska Software, (c) 1997-2005. All rights reserved.
  22. //
  23. //  Contents:
  24. //      Install default error code block
  25. //
  26. //  Remarks:
  27. //      Function ErrorSys() is always called at program startup
  28. //
  29. //////////////////////////////////////////////////////////////////////
  30.  
  31. #include "Xbp.ch"
  32. #include "Error.ch"
  33. #include "OS.ch"
  34. #include "Dmlb.ch"
  35. #include "DbfDbe.ch"
  36. #include "dll.ch"
  37. #include "Directry.ch"
  38.  
  39. *#define  DEBUG
  40. ***********************************
  41. * Name of error log without extension
  42. ***********************************
  43. #define EHS_ERRORLOG "XPPERROR"
  44.  
  45. /*
  46.  *  language specific string constant which are used in the error handler
  47.  */
  48. #define EHS_CANCEL            "Cancel"
  49. #define EHS_EXIT_WITH_LOG     "Exit with LOG file"
  50. #define EHS_RETRY             "Retry"
  51. #define EHS_IGNORE            "Ignore"
  52. #define EHS_OS_ERROR          ";Operating system error : "
  53. #define EHS_CALLED_FROM       "Called from"
  54. #define EHS_XPP_ERROR_MESSAGE "Xbase++ Error Message"
  55. #define EHS_ERROR             "Error "
  56. #define EHS_WARNING           "Warning "
  57. #define EHS_DESCRIPTION       ";Description : "
  58. #define EHS_FILE              ";File : "
  59. #define EHS_OPERATION         ";Operation : "
  60. #define EHS_LOG_OPEN_FAILED   "Unable to open error log file"
  61. #define EHS_ERROR_LOG_OF      "ERROR LOG of "
  62. #define EHS_DATE              " Date:"
  63. #define EHS_XPP_VERSION       "Xbase++ version     :"
  64. #define EHS_OS_VERSION        "Operating system    :"
  65. #define EHS_LOG_WRITTEN_TO(cFile) "Error log was written to the file "+ cFile
  66.  
  67. MEMVAR ZPATH
  68. MEMVAR ID_USER
  69. MEMVAR ID_VERSION
  70.  
  71. ***********************************
  72. * Install default error code block
  73. ***********************************
  74.  
  75. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  76. *+
  77. *+    Procedure ErrorSys()
  78. *+
  79. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  80. *+
  81. PROCEDURE ErrorSys()
  82.  
  83.    ERRORBLOCK( { | o | StandardEH( o ) } )
  84. RETURN
  85.  
  86. *************************************
  87. * Default error handler function
  88. *************************************
  89.  
  90. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  91. *+
  92. *+    Static Function StandardEH()
  93. *+
  94. *+    Called from ( xpperror.prg )   1 - procedure errorsys()
  95. *+
  96. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  97. *+
  98. STATIC FUNCTION StandardEH( oError )
  99.  
  100. LOCAL i, cMessage, aOptions, nOption, nSeverity
  101. LOCAL row, col
  102. LOCAL oDacSession, oSession
  103.  
  104.    /* Check if error is handled automatically */
  105.    DO CASE
  106.  
  107.          /* Division by zero results in 0 */
  108.       CASE oError:genCode == XPP_ERR_ZERODIV
  109.          RETURN 0
  110.  
  111.          /* Error opening a file on a network */
  112.       CASE oError:genCode == XPP_ERR_OPEN .AND. ;
  113.                  oError:osCode == 32 .AND. ;
  114.                  oError:canDefault
  115.          RETURN ( .F. )
  116.  
  117.          /* No lock is set */
  118.       CASE oError:genCode == XPP_ERR_APPENDLOCK .AND. ;
  119.                  oError:canDefault
  120.          RETURN ( .F. )
  121.  
  122.    ENDCASE
  123.  
  124.    oSession := DbSession()
  125.    IF oSession = NIL .AND. IsFunction( "DacSession", FUNC_CLASS )
  126.       oDacSession := &( "DacSession()" )
  127.       oSession := oDacSession:getDefault()
  128.    ENDIF
  129.    IF oSession != NIL
  130.       IF oSession:getLastError() != 0
  131.          oError:cargo := { oError:cargo, ;
  132.                            oSession:getLastError(), ;
  133.                            oSession:getLastMessage() }
  134.       ENDIF
  135.    ENDIF
  136.  
  137.    /* No default handling defined: create error message */
  138.    cMessage := ErrorMessage( oError )
  139.  
  140.    /* Array for selection */
  141.    *#ifdef DEBUG
  142.    aOptions := { EHS_CANCEL, EHS_EXIT_WITH_LOG }
  143.    *#else
  144.    *   aOptions := { EHS_CANCEL }
  145.    *#endif
  146.  
  147.    IF oError:canRetry
  148.       *      AAdd( aOptions, EHS_RETRY )
  149.    ENDIF
  150.  
  151.    IF oError:canDefault
  152.       *      AAdd( aOptions, EHS_IGNORE )
  153.    ENDIF
  154.  
  155.    IF !EMPTY( oError:osCode )
  156.       cMessage += EHS_OS_ERROR + LTRIM( STR( oError:osCode ) ) + ;
  157.                                         ";" + DosErrorMessage( oError:osCode )
  158.    ENDIF
  159.  
  160.    IF AppType() <> APPTYPE_PM
  161.  
  162.       /* Display Alert() Box possible ? */
  163.       IF SetAppWindow() != NIL
  164.          i := 0
  165.          row := ROW()
  166.          col := COL()
  167.          DO WHILE i == 0
  168.             i := ALERT( cMessage, aOptions )
  169.          ENDDO
  170.          SETPOS( row, col )
  171.  
  172.          /* Perform selected option */
  173.          IF !EMPTY( i )
  174.             DO CASE
  175.                CASE aOptions[ i ] == EHS_IGNORE
  176.                   RETURN .F.
  177.                CASE aOptions[ i ] == EHS_RETRY
  178.                   RETURN .T.
  179.                CASE aOptions[ i ] == EHS_CANCEL
  180.                   BREAK( oError )
  181.                CASE aOptions[ i ] == EHS_EXIT_WITH_LOG
  182.                   ErrorLog( oError, 2 )
  183.             ENDCASE
  184.          ENDIF
  185.       ELSE
  186.          /* There is no console window */
  187.          *#ifdef DEBUG
  188.          ErrorLog( oError, 2 )
  189.          *#endif
  190.       ENDIF
  191.  
  192.       /*
  193.        * Program can not or should not be continued
  194.        * Set error level and terminate program !
  195.        */
  196.  
  197.       ERRORLEVEL( 1 )
  198.       QUIT
  199.    ENDIF
  200.  
  201.    IF oError:canDefault .AND. oError:canRetry
  202.       nOption := XBPMB_ABORTRETRYIGNORE
  203.    ELSEIF oError:canRetry
  204.       nOption := XBPMB_RETRYCANCEL
  205.    ELSEIF oError:canDefault
  206.       nOption := XBPMB_OKCANCEL
  207.    ELSE
  208.       nOption := XBPMB_CANCEL
  209.    ENDIF
  210.  
  211.    /*
  212.     * Get Callstack from error object or gather it together.
  213.     */
  214.    IF IsMethod( oError, "getCallstack" )
  215.       cMessage += oError:getCallstack( ";" )
  216.    ELSE
  217.       i := 1
  218.       DO WHILE !EMPTY( PROCNAME( ++ i ) )
  219.          cMessage += ";"
  220.          cMessage += EHS_CALLED_FROM + " "
  221.          cMessage += TRIM( PROCNAME( i ) )
  222.          cMessage += "(" + LTRIM( STR( PROCLINE( i ) ) ) + ")"
  223.       ENDDO
  224.    ENDIF
  225.  
  226.    i := 0
  227.    /* select icon for ConfirmBox() */
  228.    DO CASE
  229.       CASE oError:severity == XPP_ES_FATAL
  230.          nSeverity := XBPMB_CRITICAL
  231.       CASE oError:severity == XPP_ES_ERROR
  232.          nSeverity := XBPMB_CRITICAL
  233.       CASE oError:severity == XPP_ES_WARNING
  234.          nSeverity := XBPMB_WARNING
  235.       OTHERWISE
  236.          nSeverity := XBPMB_INFORMATION
  237.    ENDCASE
  238.    /* Display ConfirmBox() */
  239.    i := ConfirmBox(, STRTRAN( cMessage, ";", CHR( 13 ) ), ;
  240.                     EHS_XPP_ERROR_MESSAGE, ;
  241.                     nOption, ;
  242.                     nSeverity + XBPMB_APPMODAL + XBPMB_MOVEABLE )
  243.  
  244.    DO CASE
  245.       CASE i == XBPMB_RET_RETRY
  246.          RETURN ( .T. )
  247.       CASE i == XBPMB_RET_IGNORE
  248.          RETURN ( .F. )
  249.       CASE i == XBPMB_RET_CANCEL
  250.          *#ifdef DEBUG
  251.          *         IF ConfirmBox(, EHS_EXIT_WITH_LOG, EHS_XPP_ERROR_MESSAGE, XBPMB_YESNO,;
  252.          *                  XBPMB_WARNING+XBPMB_APPMODAL+XBPMB_MOVEABLE ) != XBPMB_RET_YES
  253.          *              Break( oError )
  254.          *
  255.          *         ENDIF
  256.          *#else
  257.          *         Break( oError )
  258.          *#endif
  259.    ENDCASE
  260.  
  261.    *#ifdef DEBUG
  262.    ErrorLog( oError, 2 )
  263.    *#endif
  264.  
  265.    /* Set error level and terminate program ! */
  266.    ERRORLEVEL( 1 )
  267.    QUIT
  268.  
  269. RETURN .F. /* The compiler expects a return value */
  270.  
  271. ***************************************
  272.  
  273. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  274. *+
  275. *+    Static Function ErrorMessage()
  276. *+
  277. *+    Called from ( xpperror.prg )   1 - static function standardeh()
  278. *+
  279. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  280. *+
  281. STATIC FUNCTION ErrorMessage( oError )
  282.  
  283.    *
  284.    *  Creates a string with the important Informations
  285.    *  from the error object
  286.    ***************************************
  287.  
  288.    /* Check if this is an error or warning message */
  289. LOCAL cMessage := ;
  290.            IIF( oError:severity > XPP_ES_WARNING, ;
  291.            EHS_ERROR, EHS_WARNING )
  292.  
  293.    /* Add name of subsystem or 'unkown subsytem' */
  294.    IF VALTYPE( oError:subSystem ) == "C"
  295.       cMessage += oError:subSystem
  296.    ELSE
  297.       cMessage += "????"
  298.    ENDIF
  299.  
  300.    /* Add error code of subsystem */
  301.    IF VALTYPE( oError:subCode ) == "N"
  302.       cMessage += "/" + LTRIM( STR( oError:subCode ) )
  303.    ELSE
  304.       cMessage += "/????"
  305.    ENDIF
  306.  
  307.    /* Optional: Add error description */
  308.    IF VALTYPE( oError:description ) == "C"
  309.       cMessage += EHS_DESCRIPTION + ;
  310.               oError:description
  311.    ENDIF
  312.  
  313.    /* Optional: Add name of the file which were the error occured */
  314.    IF !EMPTY( oError:fileName )
  315.       cMessage += EHS_FILE + oError:fileName
  316.    ENDIF
  317.  
  318.    /* Optional: Add name of the operation which caused the error */
  319.    IF !EMPTY( oError:operation )
  320.       cMessage += EHS_OPERATION + oError:operation
  321.    ENDIF
  322.  
  323.    /* Add Thread ID of the thread on which the error occured */
  324.    cMessage += ";Thread ID : " + ;
  325.            LTRIM( STR( oError:thread ) )
  326.  
  327.    IF VALTYPE( oError:cargo ) = "A" .AND. LEN( oError:cargo ) == 3
  328.       IF VALTYPE( oError:cargo[ 1 ] ) == "C"
  329.          cMessage += ";" + LineSplit( oError:cargo[ 1 ], 50 )
  330.       ENDIF
  331.       cMessage += ";" + LineSplit( oError:cargo[ 3 ], 50 )
  332.    ENDIF
  333. RETURN cMessage
  334.  
  335. ************************************************
  336.  
  337. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  338. *+
  339. *+    Static Procedure ErrorLog()
  340. *+
  341. *+    Called from ( xpperror.prg )   3 - static function standardeh()
  342. *+
  343. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  344. *+
  345. STATIC PROCEDURE ErrorLog( oError, nStackStart )
  346.  
  347.    *
  348.    *  Creates a string with the important Informations
  349.    *  from the error object
  350.    ************************************************
  351. LOCAL i          := 0, bError := ERRORBLOCK( { | e | BREAK( e ) } )
  352. LOCAL cErrorLog
  353. LOCAL cExtension := "LOG"
  354. LOCAL lPrint, lConsole, cAlternate, lAlternate, lExtra
  355. LOCAL aWsl, nWSL, j
  356. LOCAL aLock, nLock, k
  357.  
  358.    /* Save current printer related settings, turn printer off */
  359.    lPrint := SET( _SET_PRINTER )
  360.    lConsole := SET( _SET_CONSOLE )
  361.    cAlternate := SET( _SET_ALTFILE )
  362.    lAlternate := SET( _SET_ALTERNATE )
  363.    lExtra := SET( _SET_EXTRA, .F. )
  364.  
  365.    SET PRINTER OFF
  366.    SET CONSOLE ON
  367.  
  368.    IF SetAppWindow() == NIL ;
  369.               .OR. .NOT. SetAppWindow() :isDerivedFrom( RootCrt() )
  370.       SET CONSOLE OFF
  371.    ENDIF
  372.  
  373.    /* Trap errors that might occur while opening the ALTERNATE file */
  374.    DO WHILE .T.
  375.       cErrorLog := ZPATH + EHS_ERRORLOG + "." + cExtension
  376.       BEGIN SEQUENCE
  377.          SET ALTERNATE TO ( cErrorLog ) ADDITIVE
  378.          SET ALTERNATE ON
  379.       RECOVER
  380.          /*
  381.          * ALTERNATE file could not be opened:
  382.          * try other filename
  383.          */
  384.          cExtension := PADL( ++ i, 3, "0" )
  385.          IF i > 999
  386.             IF AppType() <> APPTYPE_PM
  387.                TONE( 660, 5 )
  388.                ? EHS_LOG_OPEN_FAILED
  389.                IF !SET( _SET_CONSOLE )
  390.                   OUTERR( CHR( 10 ) + CHR( 13 ) + EHS_LOG_OPEN_FAILED )
  391.                ENDIF
  392.             ELSE
  393.                MsgBox( EHS_LOG_OPEN_FAILED )
  394.             ENDIF
  395.             ERRORLEVEL( 1 )
  396.             QUIT
  397.          ENDIF
  398.          LOOP
  399.       END SEQUENCE
  400.       EXIT
  401.    ENDDO
  402.  
  403.    ERRORBLOCK( bError )
  404.  
  405.    ? REPLICATE( "-", 78 )
  406.    ? EHS_ERROR_LOG_OF + ID_USER + " Ver." + ID_VERSION + ' "' + appName( .T. ) + '"' + EHS_DATE, DATE(), TIME()
  407.    ?
  408.    ? EHS_XPP_VERSION, VERSION() + "." + VERSION( 3 )
  409.    ? EHS_OS_VERSION, OS()
  410.    ? "Memory (RAM_AVAIL)  :", LTRIM( STR( MEMORY( MEM_RAM_AVAIL ) / 1000 ) ) + " of " + LTRIM( STR( MEMORY( MEM_RAM_TOTAL ) / 1000 ) ) + " MB"
  411.    ? "DiskSpace " + CurDrive() + ":        :", LTRIM( STR( DISKSPACE( CurDrive() + ":" ) / 1000000 ) ) + " MB"
  412.    ? "Alias()             :", IF( USED(), ALIAS(), "leer" )
  413.    ? "Recno()             :", IF( USED(), LTRIM( STR( RECNO() ) ), "leer" )
  414.    ? "Found()             :", IF( FOUND(), "YES", "NO" )
  415.    ? "NetError()          :", IF( NETERR(), "YES !!!", "NO" )
  416.    ? "Select()            :", LTRIM( STR( SELECT() ) )
  417.    ? "IndexOrd()          :", LTRIM( STR( ORDNUMBER() ) )
  418.    IF ORDNUMBER() > 0
  419.       ? "Indexfocus()        :", ORDSETFOCUS()
  420.       ? "Indexname()         :", ORDNAME()
  421.       ? "Indexkey()          :", ORDKEY()
  422.    ENDIF
  423.    IF USED()
  424.       ? "DBO_ALIAS           :", DbInfo( DBO_ALIAS )
  425.       ? "DBO_FILENAME        :", DbInfo( DBO_FILENAME )
  426.       ? "DBO_ORDERS          :", LTRIM( STR( DbInfo( DBO_ORDERS ) ) )
  427.       ? "DBO_RELATIONS       :", LTRIM( STR( DbInfo( DBO_RELATIONS ) ) )
  428.       ? "DBO_SHARED          :", IF( DbInfo( DBO_SHARED ), "YES", "NO" )
  429.       ? "DBO_REMOTE          :", IF( DbInfo( DBO_REMOTE ), "YES", "NO" )
  430.       ? "DBO_SERVER          :", IF( DbInfo( DBO_SERVER ), "YES", "NO" )
  431.       ? "DBO_DBENAME         :", DbInfo( DBO_DBENAME )
  432.       ? "BOF()               :", IF( BOF(), "YES", "NO" )
  433.       ? "EOF()               :", IF( EOF(), "YES", "NO" )
  434.    ENDIF
  435.  
  436.    aWSL := WorkSpaceList()
  437.    nWSL := LEN( aWSL )
  438.    ? "WorkSpaceList       :", ""
  439.    FOR j = 1 TO nWSL
  440.       ? aWSL[ j ]
  441.       aLock := ( aWSL[ j ] )->( DBRLOCKLIST() )
  442.       nLock := LEN( aLock )
  443.       IF nLock > 0
  444.          FOR k = 1 TO nLock
  445.             IF k = 1
  446.                ?? " : Record No. " + LTRIM( STR( aLock[ k ] ) )
  447.             ELSE
  448.                ?? "," + LTRIM( STR( aLock[ k ] ) )
  449.             ENDIF
  450.          NEXT
  451.          ?? " locked"
  452.       ELSE
  453.          ?? " : NO Record locked"
  454.       ENDIF
  455.    NEXT
  456.  
  457.    ? REPLICATE( "-", 78 )
  458.    ? ""
  459.  
  460.    DLLLIST()
  461.  
  462.    ? ""
  463.    ? REPLICATE( "-", 78 )
  464.    ? "oError:args         :"
  465.    IF VALTYPE( oError:Args ) == "A"
  466.       AEVAL( oError:Args, ;
  467.              { | x, y | QOUT( SPACE( 9 ), "-> VALTYPE:", y := VALTYPE( x ) ), ;
  468.              IIF( y == "O", QQOUT( " CLASS:", x:className() ), ;
  469.              QQOUT( " VALUE:", Var2Char( x ) ) ) } )
  470.    ELSE
  471.       QOUT( SPACE( 10 ), "-> NIL" )
  472.    ENDIF
  473.  
  474.    ? "oError:canDefault   :", oError:canDefault
  475.    ? "oError:canRetry     :", oError:canRetry
  476.    ? "oError:canSubstitute:", oError:canSubstitute
  477.    ? "oError:cargo        :", oError:cargo
  478.    ? "oError:description  :", oError:description
  479.    ? "oError:filename     :", oError:filename
  480.    ? "oError:genCode      :", oError:genCode
  481.    ? "oError:operation    :", oError:operation
  482.    ? "oError:osCode       :", oError:osCode
  483.    ? "oError:severity     :", oError:severity
  484.    ? "oError:subCode      :", oError:subCode
  485.    ? "oError:subSystem    :", oError:subSystem
  486.    ? "oError:thread       :", oError:thread
  487.    ? "oError:tries        :", oError:tries
  488.  
  489.    ? REPLICATE( "-", 78 )
  490.    ? "CALLSTACK:"
  491.    ? REPLICATE( "-", 78 )
  492.  
  493.    i := nStackStart
  494.  
  495.    IF IsMethod( oError, "getCallstack" )
  496.       ? oError:getCallstack( CHR( 13 ) + CHR( 10 ) )
  497.    ELSE
  498.       DO WHILE !EMPTY( PROCNAME( ++ i ) )
  499.          ? EHS_CALLED_FROM, TRIM( PROCNAME( i ) ) + "(" + ;
  500.                                   LTRIM( STR( PROCLINE( i ) ) ) + ")"
  501.       ENDDO
  502.    ENDIF
  503.    ?
  504.  
  505.    SET ALTERNATE TO
  506.    SET ALTERNATE OFF
  507.  
  508.    IF AppType() <> APPTYPE_PM
  509.       TONE( 660, 5 )
  510.       ? EHS_LOG_WRITTEN_TO( cErrorLog )
  511.       IF !SET( _SET_CONSOLE )
  512.          OUTERR( CHR( 10 ) + CHR( 13 ) + EHS_LOG_WRITTEN_TO( cErrorLog ) )
  513.       ENDIF
  514.    ELSE
  515.       MsgBox( EHS_LOG_WRITTEN_TO( cErrorLog ) )
  516.    ENDIF
  517.  
  518.    /* Restore previous settings */
  519.    SET( _SET_PRINTER, lPrint )
  520.    SET( _SET_CONSOLE, lConsole )
  521.    SET( _SET_ALTFILE, cAlternate )
  522.    SET( _SET_ALTERNATE, lAlternate )
  523.    SET( _SET_EXTRA, lExtra )
  524.  
  525. RETURN
  526.  
  527. /* Split large line for Alert()-box output */
  528.  
  529. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  530. *+
  531. *+    Function LineSplit()
  532. *+
  533. *+    Called from ( xpperror.prg )   2 - static function errormessage()
  534. *+
  535. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  536. *+
  537. FUNCTION LineSplit( cMessage, nMaxCol )
  538.  
  539. LOCAL i
  540. LOCAL cLines := ""
  541. LOCAL nLines
  542.  
  543.    nLines := MLCOUNT( cMessage, nMaxCol,, .T. )
  544.    FOR i := 1 TO nLines
  545.       cLines += RTRIM( MEMOLINE( cMessage, nMaxCol, i,, .T. ) ) + ";"
  546.    NEXT
  547.    IF cLines[ - 1 ] == ";"
  548.       cLines := LEFT( cLines, LEN( cLines ) - 1 )
  549.    ENDIF
  550. RETURN cLines
  551.  
  552. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  553. *+
  554. *+    Procedure DLLLIST()
  555. *+
  556. *+    Called from ( xpperror.prg )   1 - static procedure errorlog()
  557. *+
  558. *+▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  559. *+
  560. PROCEDURE DLLLIST()
  561.  
  562. LOCAL I, J, DllName, hDll, aVersion, fVersion
  563. LOCAL aDLLFiles := DIRECTORY( "*.DLL" )
  564. LOCAL nCount    := LEN( aDLLFiles )
  565. LOCAL n, nSum, cTest
  566. LOCAL DllList   := {}
  567.  
  568.    FOR n := 1 TO nCount
  569.       AADD( DllList, aDLLFiles[ n, F_NAME ] )
  570.    NEXT
  571.  
  572.    FOR I := 1 TO LEN( DllList )
  573.       DllName := DllList[ I ]
  574.       IF DllInfo( DllName, DLL_INFO_LOADED )
  575.          hDll := DllInfo( DllName, DLL_INFO_HANDLE )
  576.          fVersion := LoadResource( 1, hDll, RES_VERSIONFIXED )
  577.          aVersion := LoadResource( 1, hDll, RES_VERSION )
  578.  
  579.          *         ? ""
  580.          *         ? Replicate( "-", 78 )
  581.          *         ? ""
  582.          *         ? DllName
  583.  
  584.          IF LEN( fVersion ) > 0
  585.             *            ? "Product Version: "+ltrim(str(fVersion[RES_PRODVER_MS ]))+ltrim(str(fVersion[RES_PRODVER_LS ]))
  586.             *            ? "   File Version: "+ltrim(str(fVersion[RES_FILEVER_MS ]))+ltrim(str(fVersion[RES_FILEVER_LS ]))
  587.             *            ? "      File Time: "+ltrim(str(fVersion[RES_FILETIME_MS]))+ltrim(str(fVersion[RES_FILETIME_LS]))
  588.          ELSE
  589.          ENDIF
  590.  
  591.          IF LEN( aVersion ) > 0
  592.             FOR J := 1 TO LEN( aVersion )
  593.                cTest := aVersion[ J ] [ RES_VERSION_KEY ]
  594.                DO CASE
  595.                   CASE cTest = "CompanyName"
  596.                   CASE cTest = "InternalName"
  597.                   CASE cTest = "LegalCopyright"
  598.                   CASE cTest = "OriginalFilename"
  599.                   CASE cTest = "ProductName"
  600.                   CASE cTest = "ProductVersion"
  601.                   CASE cTest = "Comment"
  602.                   CASE cTest = "FileVersion"
  603.                   OTHERWISE
  604.                      // FileDescription
  605.                      *                 ? aVersion[J][RES_VERSION_KEY]+": "+aVersion[J][RES_VERSION_VALUE]
  606.                      ? DllName + ": " + aVersion[ J ] [ RES_VERSION_VALUE ]
  607.                ENDCASE
  608.             NEXT
  609.          ELSE
  610.          ENDIF
  611.       ENDIF
  612.    NEXT
  613.  
  614. RETURN
  615.  
  616. *+ EOF: XPPERROR.PRG
  617.