home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
dblib201.zip
/
ERRLOG.PRG
< prev
next >
Wrap
Text File
|
1993-02-23
|
16KB
|
421 lines
PROCEDURE ErrorLog
*-------------------------------------------------------------------------------
*-- Programmer : Peter Ripaldi (CIS: 70711,3420) (1-508-683-4987)
*-- Date : 08/23/1992
*-- Notes : Program to produce an error log on disk that is about
*-- : 12k long. The idea is to provide as much information as
*-- : possible about the system at the time of the error. On
*-- : error you can print the screen to printer and/or disk
*-- : if you uncomment the section(s). The error log on
*-- : disk is called ERROR.LOG, each error session will
*-- : add to the bottom of the previous error.
*-- : Any suggestion to add, or if it helps
*-- : let me know. Happy Erroring ?
*-- Written for: dBASE IV 1.5 08/23/92
*-- Rev. Hist. : 04/09/92 1.0 - none- format from E_LOG.PRG
*-- : Ideas from E_LOG.PRG author unknown
*-- : ERR_TRAP.PRG author BILLG (BORBBS)
*-- : SPY_CAM author dbf magazine
*-- : 08/23/92 1.5 Added functions for ver 1.5
*-- : Save to screen before error msg on screen
*-- : Append print screen to end of ERROR.LOG file
*-- : Send network msg, idea from Bob(IVYBURT)
*-- : 11/13/1992 -- modified seriously by Ken Mayer, allowing
*-- programmer calls to PRINTSCR and SCREEN, as
*-- well as network, by passing parms to the routine.
*-- Cleaned up the programming a lot. Removed
*-- the need for as many memvars.
*-- *****************************
*-- *** REQUIRES PRINTSCR.BIN ***
*-- *** and SCREEN.BIN ***
*-- *****************************
*-- Calls......: SURROUND() Function below
*-- CENTER Procedure below
*-- Called by..: Any
*-- Usage......: on error do ErrorLog with error(),lineno(),program(),;
*-- alias(),memory()[,<lPrntScrn>[,<lScrn2Disk>[,<cNetId>]]]
*-- Example....: on error do errorlog with error(),lineno(),program(),alias(),;
*-- memory(),.t.,.t.,"MAYER"
*-- Returns....: None
*-- Parameters.: error() = dBASE Function
*-- lineno() = dBASE Function
*-- program() = dBASE Function
*-- alias() = dBASE Function
*-- memory() = dBASE Function
*-- lPrntScrn = logical -- print the screen?
*-- lScrn2Disk = logical -- print the screen to disk?
*-- cNetId = Network ID for user on a NOVELL NETWORK
*-- to send a Network message to letting them
*-- know about this error.
*-------------------------------------------------------------------------------
*-- Try to bring in as much of system before loading anything else
PARAMETER nError,nLineNo,cProgram,cAlias,nMemory,lPrntScrn,lScrn2Disk,cNetId
*-- talk off so answers to IIF() dont go in ERROR.LOG file
cTalk = set("TALK")
set talk off
*-- deal with optional parameters
nParms = pCount() && how many parameters were passed?
if nParms < 8 && no Net Id
cNetId = ""
endif
if nParms < 7 && no lScrn2Disk parm
lScrn2Disk = .f.
endif
if nParms < 6 && no Print Screen parm
lPrntScrn = .f.
endif
*-- Get copy of screen so we can restore it after were done
save screen to sError
activate screen
*-- set up disk file ERROR.LOG
set alternate to
*-- Let user know SOMETHING'S happening
x=surround(12,25,"rg+/r","An Error Has Occured -- Writing Log")
*-- If already there add to it, incase of more errors next time runs prg
if file("ERROR.LOG")
set alternate to error.log additive
else
*-- If not there make one
set alternate to error.log
endif && file("ERROR.LOG")
*-- Turn on ERROR.LOG file
set alternate on
*-- Turn screen off
set console off
*-- set date to 19xx format
set century on
*-- Begin error logging information to disk
*
* Set up heading
? "=========================================================================="
? "===== Begin Errors Found ====="
? "====="
?? SPACE(10)+CDOW(DATE())+SPACE(10)+MDY(DATE())+SPACE(10)+(TIME())
?? " ====="
? "=========================================================================="
?
? " Error / Program Information"
? "------------------------------"
? " Error # : " + LTRIM(STR(nError)) +" "+ MESSAGE()
? " In Program : " + cProgram
? " On Line # : " + LTRIM(STR(nLineNo))
? " Catalog Name : " + LTRIM(CATALOG())
?
?
? " System Information"
? "------------------------------"
? " Memory : " + LTRIM(STR(nMemory))
? " Diskspace : " + LTRIM(STR(DISKSPACE()))
? " Path : " + GETENV("path")
? " Prompt : " + GETENV("prompt")
? " ComSpec : " + GETENV("comspec")
? " Operating Sys : " + LTRIM(OS())
? " Dbase Version : " + LTRIM(VERSION(0))
? " Dbase Path : " + LTRIM(HOME())
? " Compile Error : " + LTRIM(STR(CERROR()))
? " Color system : " + iif(iscolor(),"Yes","No")
?
?
? " Database File Information "
? "------------------------------"
? " DBF File : " + DBF()
? " Alias Name : " + cAlias
? " Work area : " + LTRIM(STR(SELECT()))
? " Order : " + ORDER()
? " Record # : " + LTRIM(STR(RECNO()))
? " Field count : " + LTRIM(STR(FLDCOUNT()))
? " Tag name : " + LTRIM(TAG())
? " Tag count : " + LTRIM(STR(TAGCOUNT()))
? " Tag number : " + LTRIM(STR(TAGNO()))
? " MDX file : " + LTRIM(MDX())
? " NDX file : " + LTRIM(NDX())
? " Descending index: " + iif(descending(),"Yes","No")
?
? " For condition of mdx tag : " + LTRIM(FOR())
? " Expression of mdx/ndx tag : " + LTRIM(KEY())
? " Unique Index : " + iif(unique(),"Yes","No")
? " Deleted : " + iif(deleted(),"Yes","No")
? " Record Count : " + LTRIM(STR(RECCOUNT()))
?
*-- record size may not be right add 35 for header if wanted
? " Record Size : " + LTRIM(STR(RECSIZE()))
? " Last Update : " + DTOC(LUPDATE())
? " Last Seek Found : " + iif(found(),"Yes","No")
? " End Of File : " + iif(eof(),"Yes","No")
? " Begin Of File : " + iif(bof(),"Yes","No")
?
?
? " Program Information "
? "------------------------------"
? " Number of parameters called : " + LTRIM(STR(PCOUNT()))
?
?
? " File / User / Network Information"
? "------------------------------"
? " On Network : " + iif(network(),"Yes","No")
? " DBF in state of change : " + iif(ismarked(),"Yes","No")
? " User Access Level : " + LTRIM(STR(ACCESS()))
? " Log in User Name : " + USER()
? " Name of current User : " + ID()
? " Changed by others : " + iif(change(),"Yes","No")
? " Completed Transaction : " + iif(completed(),"Yes","No")
? " Rollback Successful : " + iif(rollback(),"Yes","No")
? " Record Lock : " + iif(rlock(),"Yes","No")
? " File Lock : " + iif(flock(),"Yes","No")
?
?
? " List of Users "
? "--------------------------------"
list users
?
?
? " Screen Information "
? "------------------------------"
? " Window : " + WINDOW()
? " Pad : " + PAD()
? " Popup : " + POPUP()
? " Bar # : " + LTRIM(STR(BAR()))
? " Prompt : " + PROMPT()
? " Menu : " + MENU()
? " Cursor Row : " + LTRIM(STR(ROW()))
? " Cursor Column : " + LTRIM(STR(COL()))
?
?
? " Key Stroke Information "
? "------------------------------"
? " Varread : " + VARREAD()
? " Inkey : " + LTRIM(STR(INKEY()))
? " Lastkey : " + LTRIM(STR(LASTKEY()))
? " Readkey : " + LTRIM(STR(READKEY()))
?
? " Printer Information "
? "------------------------------"
? " Print Status : " + iif(printstatus(),"Yes","No")
? " Print Column : " + LTRIM(STR(PCOL()))
? " Print Row : " + LTRIM(STR(PROW()))
?
?
* List Status, Memory, History .....
? " Status Listing "
? "----------------------------------------------"
?
?
list status
? " Memory Listing "
? "----------------------------------------------"
?
?
list memory
?
?
? " History Listing "
? "------------------------------------------------"
list history
?
?
* End of errors for this time
? "=========================================================================="
? "===== End of Errors Found ====="
? "====="
?? space(10)+cdow(date())+space(10)+mdy(date())+space(10)+(time())
?? " ====="
? "=========================================================================="
* spaces to seperate error log for next time error happens
?
?
?
?
*-- All done with saving file close up error file
set alternate off
set alternate to
set console on
set century off
*-----------------------------------------------------------------------
*-- optional stuff here
*-----------------------------------------------------------------------
restore screen from sError && remove message to user ...
if lPrntScrn
*-- Print Screen First, uses printscr.bin
load printscr
call printscr
release module printscr
endif
*-----------------------------------------------------------------------
*-- Print screen to disk?
*-----------------------------------------------------------------------
* Print screen to disk file called Erscreen.txt, uses screen.bin
* The "a" option will append to text file
if lScrn2Disk
load screen
call screen with "a", "Erscreen.txt"
release module screen
eject && form feed to clear out printer ...
*- Add screen to end of ERROR.LOG file
set alternate to error.log additive
*-- Turn screen off
set console off
*-- turn on ERROR.LOG file for heading
set alternate on
? "Screen Dump of above error"
? "-----------------------------------------------"
?
*-- All done with heading close up ERROR.LOG file
set alternate off
set alternate to
*-- Now add screen to end of ERROR.LOG file
load screen
call screen with "a", "ERROR.LOG"
release module screen
*-- all done
set console on
endif && lScrn2File
*------------------------------------------------------------------------
*-- After all that, let's let the user know what happened
*------------------------------------------------------------------------
* For real fun use one of KenMayer's "Death March" Songs (MISC.PRG)
* Alert user for heart attack, Give a tone
set bell to 500,5
?? chr(7)
set bell to 400,4
?? chr(7)
*set bell to 500,5
*?? chr(7)
*set bell to 400,5
*?? chr(7)
*set bell to 500,5
*?? chr(7)
set bell to
*-- Give user message, on error window
define window wError from 0,0 to 24,79 double
activate window wError
*-- sample message inspired by movie China Syndrome
do center with 6,80,"rg+/r","** E R R O R L O G **"
do center with 10,80,"","An unscheduled event has happened."
do center with 12,80,"","The information has been stored to disk. "
do center with 14,80,"","Notify Programmer Immediately!"
do center with 16,80,"","You are being returned to the dot prompt, or"
do center with 18,80,"","(if using RUNTIME) being dropped to DOS."
do center with 20,80,"","Press a key to continue ..."
*-- Wait until user sees message
x=inkey(0)
*------------------------------------------------------------------
*-- Network message to programmer?
*------------------------------------------------------------------
if .not. isblank(cNetId)
* From Bob (IVYBURT)
* If you're on a network, option to send a message to network manager
* to notify of mentally deranged program.
if network()=.t.
!SEND &cNetId " Help -- Program Crashed!"
endif && network()
endif && .not. isblank(cNetId)
*------------------------------------------------------------------
*-- done with window, shut-down
*------------------------------------------------------------------
deactivate window wError
release window wError
clear all
release all
clear
Cancel && rather than returning user to where they were
*-------------------------------------------------------------------------------
*-- Extra Functions called from above ...
*-------------------------------------------------------------------------------
PROCEDURE Center
*-------------------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 05/24/1991
*-- Notes.......: Centers text on the screen with @says
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: This and all other procedures/functions listed in this
*-- file attributed to Miriam Liskin came from "Liskin's
*-- Programming dBASE IV Book". Very good, worth the money.
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: do center with <nLine>,<nWidth>,"<cColor>","<cText>"
*-- Example.....: do center with 5,65,"RG+/GB","WARNING! This will blow up!"
*-- Note that the color field may be blank: ""
*-- Returns.....: None
*-- Parameters..: nLine = Line or Row for @/Say
*-- nWidth = Width of screen
*-- cColor = Colors to be used ("Forg/Back") (may be nul "", in
*-- order to use the default colors of window/screen)
*-- cText = Message to center on screen
*-------------------------------------------------------------------------------
parameters nLine,nWidth,cColor,cText
private nCol
nCol = (nWidth - len(cText)) /2
@nLine,nCol say cText color &cColor.
RETURN
*-- EoP: Center
FUNCTION Surround
*-------------------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 05/24/1991
*-- Notes.......: Displays a message surrounded by a box anywhere on
*-- the screen
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 04/19/1991 - Modified by Ken Mayer (KENMAYER) to a function
*-- from original procedure
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: surround(<nLine>,<nColumn>,"<cColor>","<cText>")
*-- Example.....: cDummy = surround(5,12,"RG+/GB",;
*-- "Processing ... Do not Touch!")
*-- Returns.....: Nul/""
*-- Parameters..: nLine = Line to display "surrounded" message at
*-- nColumn = Column for same (X,Y coordinates for @SAY)
*-- cColor = Color variable/colors
*-- cText = Text to be displayed inside box
*-------------------------------------------------------------------------------
parameters nLine,nColumn,cColor,cText
cText = " " + trim(cText) + " " && add spaces around text
@nLine-1,nColumn-1 to nLine+1,nColumn+len(cText) double;
color &cColor. && draw box
@nLine,nColumn say cText color &cColor. && disp. text
RETURN ""
*-- EoF: Surround()
*-------------------------------------------------------------------------------
*-- End of Program: ERRLOG.PRG
*-------------------------------------------------------------------------------