#INCLUDE "FIVEWIN.CH"
#INCLUDE "ORD.CH"
#include "error.ch"
external _fwGenError // Link FiveWin generic Error Objects Generator
#define NTRIM(n) ( LTrim(Str(n)) )
#ifdef __CLIPPER__
#define DLG_TITLE "FiveWin: The CA-Clipper for Windows Library"
#else
#ifdef __HARBOUR__
#define DLG_TITLE "FiveWin for Harbour"
#command QUIT => ( PostQuitMessage( 0 ), __Quit() )
#else
#define DLG_TITLE "FiveWin for Xbase++"
#endif
#endif
/*
Funcion: OpenDbf()
Sintaxis: OpenDbf(<cNomdbf>,[<nSecs>],[<lModo>],[<lSlect>],[<lEspera>],[<aIndices>|<cIndice>],[<cDriver>]))
Descripcion: Funcion para abrir una base de datos compartida o exclusiva
en entornos de redes
Parametros:
<cNomdbf> Nombre de la base de datos a abrir
[<nSecs>] Segundos que tiene que esperar si no puede abrir el DBF
[<lModo>] Modo de apertura .T. = compartida .F. = Exclusiva
[<lSlect>] Modo de acceso .T. = Solo lectura .F. = lectura/escritura
[<lEspera>] .T. = Solo saldra hasta poder abrir el Archivo
[<aIndices>] Arreglo que contendra los indices
<cIndice> Nombre de indice
[<cDriver>] drive a utilizar por la base de datos
Regresa: Un alias nuevo para la base de datos recien abierta si esta se
pudo abrir adecuadamente, una cadena vacia si no se pudo abrir
o bien se cancelo la operacion de apertura
Autor: Rene M. Flores
Modifico:Víctor Manuel Tomás Díaz.
Se agrego el Parametro lEspera y el parametro a Indices para abrir los indices
de manera automatica ademas de revisar si existen.
Se puede abrir cualquier drive cdx ntx
Se agrega BEGIN SEQUENCE para captar el error en caso de que el archivo no sea un Dbf.
Fecha: 25-Junio 1999
*/
FUNCTION OpenDbf(cNomdbf,nSecs,lModo,lSlect,lEspera,aIndices,cDriver)
LOCAL oGenError
LOCAL bNewError, bOldError
LOCAL lOk := .T. // Control de error
LOCAL cVret := "" // Valor de retorno
LOCAL lError := lExit := .T. // Control de apertura
LOCAL cTempAlias,nTimer // Temporales
LOCAL oBotAcept,oBotCancel,oBmp,oFont // Temporales
DEFAULT nSecs := 5 // Tiempo de espera
DEFAULT lModo := .T. // Compartido
DEFAULT lSlect := .F. // Lectura y escritura
DEFAULT lEspera := .F. // Respeta el tiempo de espera
DEFAULT aIndices := "" // Indices
DEFAULT cDriver := DbsetDriver()
IF !FILE( cNomdbf )
MsgStop("NO EXISTE EL ARCHIVO "+cNomdbf,"ERROR EN EL SISTEMA")
RETURN (cVret)
ENDIF
CursorWait()
nTimer := SECONDS() + nSecs
cTempAlias := SUBSTR(cFileNoExt(cFileName(cNomDbf)),1,4)
cAlias := NewAlias(cTempAlias)
DO WHILE lError .AND. lExit
bNewError := {|oError| ErrorHandler(oError,.T.) } // Prepara el objeto error
bOldError := Errorblock(bNewError) // Error actual
BEGIN SEQUENCE
DBUSEAREA(.T.,cDriver,cNomdbf,cAlias,lModo,lSlect) // Abre el Archivo
RECOVER USING oGenError // Si hubo error lo toma
IF Select( cAlias ) > 0 // Cierra el area abierta
( cAlias )->(DbCloseArea())
ENDIF
lOk := .F. // Se genero un error
IF oGenError != NIL
* oGenError := ChkError(oGenError, cFile)
MsgStop("ERROR EN EL ARCHIVO"+CRLF+Upper(cFileNoExt(cFileName(cNomDbf)))+CRLF+"IMPOSIBLE CONTINUAR","ERROR FATAL")
ENDIF
END SEQUENCE
Errorblock(bOldError)
IF !lOk // Hubo error al abrir la base de datos
RETURN(cVret := "") // Regresa vacio
ENDIf
lError := NETERR()
IF !lError
cVret := cAlias
IF !Empty(aIndices)
IF !AbrirIdx(aIndices) // Error al Abrir los indices
( cAlias )->(DbCloseArea()) // Cierra el area abierta
cVret := "" // Regresa vacio
ENDIF
ENDIF
ELSE
cVret := ""
ENDIF
IF SECONDS() >= nTimer .AND. lError
IF !lEspera
MsgBeep()
IF MsgRetryCancel("NO ESTA DISPONIBLE EL ARCHIVO: "+upper(cFileName(cNomDbf)),"AVISO DEL SISTEMA")
lError := .T. ; lExit := .T. ; nTimer := SECONDS() + nSecs
ELSE
lError := .T. ; lExit := .F.
ENDIF
Else
Msginfo("NO ESTA DISPONIBLE EL ARCHIVO: "+upper(cFileName(cNomDbf)),"AVISO DEL SISTEMA")
lError := .T.; lExit := .T. ; nTimer := SECONDS() + nSecs
ENDIF
ENDIF
ENDDO
RETURN (cVret)
/*
Funcion: NewAlias()
Sintaxis: NewAlias(<cNomdbf>)
Descripcion: Asigna un nuevo alias para las bases de datos a abrir, esta
funcion permite abrir varias veces la misma base de datos
es ideal para ambientes MDI
Parametros:
<cNomdbf> Nombre de la base de datos a abrir
Regresa: Una cadena de caracteres con el nombre del alias nuevo *
Autor: Rene M. Flores
Fecha: 30 Agosto 1996
*/
FUNCTION NewAlias(cNomDbf)
STATIC nNum := 0
LOCAL cAlias := ""
nNum++
cAlias := cNomDbf + LTRIM(STR(nNum))
RETURN (cAlias)
/*
Funcion: Add_reg()
Sintaxis: Add_reg( <cNomdbf>,[<nSecs>],[<lEspera>] )
Descripcion: Agrega un campo en blanco a la base de datos
Parametros:
<cNomdbf> Nombre de la base de datos a abrir
[<nSecs>] Segundos que tiene que esperar si no puede bloquear el registro
[<lEspera>] Solo saldra hasta poder agregar un el registro
Regresa: Un valor verdadero si se pudo bloquear el registro o un falso en
caso de que no se logro el bloque o cancelacion de la operacion
Autor: Rene M. Flores
Fecha: 30 Agosto 1996
Modifico:Víctor Manuel Tomás Díaz.
Se agrego el Parametro lEspera para efectos de la programación
en Codman, S.A. de C.V. 2 Marzo 1999
Fecha: 25 Junio 19999
*/
FUNCTION Add_Reg(cAlias,nSecs,lEspera)
LOCAL lVret := .F.
LOCAL lError := .T.
LOCAL nTimer//,oDlg
DEFAULT nSecs := 5
DEFAULT lEspera := .T.
nTimer := SECONDS() + nSecs
DO WHILE lError
(cAlias)->(DBAPPEND())
lError := NETERR()
IF lError
IF SECONDS() >= nTimer
IF !lEspera
* DEFINE DIALOG oDlg RESOURCE "DLG_NET_ERR" TITLE "AGREGAR REGISTRO"
*
* REDEFINE BUTTON oBotAcept ID 1 OF oDlg;
* ACTION (nTimer := SECONDS() + nSecs,oDlg:End()) UPDATE
* REDEFINE BUTTON oBotCancel ID 2 OF oDlg;
* ACTION (oDlg:End()) UPDATE
* ACTIVATE DIALOG oDlg CENTERED
IF MsgRetryCancel("NO ESTA DISPONIBLE EL ARCHIVO: "+upper(cFileName(cNomDbf)),"AVISO DEL SISTEMA")
nTimer := SECONDS() + nSecs // Se incrementan los segundos
ELSE
lError := .F.
ENDIF
ELSE
nTimer := SECONDS() + nSecs // Se incrementan los segundos
ENDIF
ENDIF
ELSE
IF Reg_Lock(cAlias,nSecs)
lVret := .T.
ENDIF
ENDIF
ENDDO
RETURN (lVret)
/*
Funcion: Reg_lock()
Sintaxis: Reg_lock( <cNomdbf>,[<nSecs>],[<lEspera>] )
Descripcion: Realiza el bloqueo de un registro
Parametros:
<cNomdbf> Nombre de la base de datos a abrir
[<nSecs>] Segundos que tiene que esperar si no puede bloquear el registro
[<lEspera>] Solo saldra hasta poder agregar un el registro
Regresa: Un valor verdadero si se pudo bloquear el registro o un falso en
caso de que no se logro el bloque o cancelacion de la operacion
Autor: Rene M. Flores
Fecha: 30 Agosto 1996
Modifico:Víctor Manuel Tomás Díaz.
Se agrego el Parametro lEspera para efectos de la programación
en Codman, S.A. de C.V. 2 Marzo 1999
Fecha: 25 Junio 19999
*/
FUNCTION Reg_Lock(cAlias,nSecs,lEspera)
LOCAL lVret := .F.
LOCAL lError := .F.
LOCAL nTimer , oSay ,oFont
DEFAULT nSecs := 5
DEFAULT lEspera := .T.
nTimer := SECONDS() + nSecs
DO WHILE !lError
lError := (cAlias)->(RLOCK())
IF lError
lVret := .T.
ELSE
IF !lEspera
IF SECONDS() >= nTimer
* DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0,-10 // definimos fuente tipo Windows 95
*
* DEFINE DIALOG oDlg RESOURCE "DLG_NET_ERR";
* TITLE "AVISO AL USUARIO" FONT oFont
*
* REDEFINE BUTTON oBotAcept ID 1 OF oDlg;
* ACTION (nTimer := SECONDS() + nSecs, oDlg:End()) UPDATE
* REDEFINE BUTTON oBotCancel ID 2 OF oDlg;
* ACTION (lError := .T. , oDlg:End()) UPDATE
* REDEFINE SAY oSay ;
* PROMPT "NO ESTA DISPONIBLE EL REGISTRO" ID 500 OF oDlg UPDATE
* ACTIVATE DIALOG oDlg CENTERED
IF MsgRetryCancel("NO ESTA DISPONIBLE EL REGISTRO" ,"AVISO DEL SISTEMA")
nTimer := SECONDS() + nSecs
ELSE
lError := .T.
ENDIF
ENDIF
ELSE
MSGINFO("NO ESTA DISPONIBLE EL REGISTRO","AVISO DEL SISTEMA")
nTimer := SECONDS() + nSecs
ENDIF
ENDIF
ENDDO
RETURN (lVret)
/**
Funcion: File_Lock()
Sintaxis: File_Lock(<oOwner>,<cAlias>)
Parametros:
<cNomdbf> Nombre de la base de datos a bloquear
[<nSecs>] Segundos que tiene que esperar si no puede abrir el DBF
Regresa: Verdadero si se pudo bloquear la bases de datos
Falso si no pudo abrir adecuadamente o bien se cancelo la operacion de bloqueo
Autor: Rene M. Flores
Fecha: 30 Agosto 1996
*/
FUNCTION File_Lock(cAlias,nSecs)
LOCAL lVret := .F.
LOCAL lError := .F.
LOCAL nTimer,oDlg
LOCAL oBotAcept,oBotCancel
DEFAULT nSecs := 5
nTimer := SECONDS() + nSecs
DO WHILE !lError
(cAlias)->(FLOCK())
lError := (cAlias)->(NETERR())
IF lError
lVret := .T.
ELSE
IF SECONDS() >= nTimer
* DEFINE DIALOG oDlg RESOURCE "DLG_NET_ERR" ;
* TITLE "BLOQUEO DE LA BASE DE DATOS"
* REDEFINE BUTTON oBotAcept ID 1 OF oDlg;
* ACTION (lError := .T.,nTimer := SECONDS() + nSecs,oDlg:End()) UPDATE
* REDEFINE BUTTON oBotCancel ID 2 OF oDlg ;
* ACTION (lError := .T.,oDlg:End()) UPDATE
* ACTIVATE DIALOG oDlg CENTERED
IF MsgRetryCancel("NO ESTA DISPONIBLE EL ARCHIVO" ,"AVISO DEL SISTEMA")
nTimer := SECONDS() + nSecs
ELSE
lError := .T.
ENDIF
ENDIF
ENDIF
ENDDO
RETURN (lVret)
/*
Funcion: DelReg()
Sintaxis: DelReg( <cNomdbf> )
Descripcion: Marca un registro como borrado
Parametros:
<cNomdbf> Nombre de la base de datos a abrir
Regresa: Un valor verdadero si se logro marcar el registro como borrado
caso contrario regresa falso
Autor: Rene M. Flores
Fecha: 30 Agosto 1996
*/
FUNCTION DelReg(cAlias)
LOCAL lVret := .F.
IF Reg_Lock(cAlias)
lVret := .T.
(cAlias)->(DBDELETE())
(cAlias)->(DBUNLOCK())
ENDIF
RETURN (lVret)
/*
Funcion: UnDelReg()
Sintaxis: UnDelReg( <cNomdbf> )
Descripcion: Desmarca un registro como borrado
Parametros:
<cNomdbf> Nombre de la base de datos a abrir
Regresa: Un valor verdadero si se logro desmarcar el registro como borrado
caso contrario regresa falso
Autor: Rene M. Flores
Fecha: 30 Agosto 1996
*/
FUNCTION UnDelReg(cAlias)
LOCAL lVret := .F.
IF Reg_Lock(cAlias)
lVret := .T.
(cAlias)->(DBRECALL())
(cAlias)->(DBUNLOCK())
ENDIF
RETURN (lVret)
STATIC FUNCTION MsgError(e)
LOCAL cMessage
cMessage := if( empty( e:osCode ), ;
if( e:severity > ES_WARNING, "ERROR ", "ATENCION " ),;
"(DOS Error " + NTRIM(e:osCode) + ") " )
cMessage += if( ValType( e:subsystem ) == "C",;
e:subsystem() ,;
"???" )
cMessage += if( ValType( e:subCode ) == "N",;
"/" + NTRIM( e:subCode ) ,;
"/???" )
IF ( ValType(e:description) == "C" )
cMessage += " " + e:description
END
cMessage += if( !Empty( e:filename ),;
": " + e:filename ,;
if( !Empty( e:operation ),;
": " + e:operation ,;
"" ) )
MsgInfo(cMessage, "DESCRIPCION DE ERROR")
RETURN NIL
PROC ErrorSys()
ErrorBlock( { | e | ErrorDialog( e ) } )
RETURN
proc ErrorLink()
return
/*
STATIC FUNCTION ErrorDialog( e )
LOCAL lRet
*LOCAL i, j, cMessage, aStack := {}
LOCAL cErrorLog
LOCAL xRet
LOCAL aVersions
*LOCAL aTasks
*IF ( e:genCode == EG_NOFUNC )
* IF e:Args == NIL
* ELSE
* Aeval(e:Args, {|v,e| aParam[e] := v })
* ENDIF
* IF Valtype(xRet) != "N" .OR. xRet != -1
* RETU xRet
* ENDIF
*ENDIF
// Control de errores tipicos que no provocan runtime-error
IF ( e:genCode == EG_ZERODIV )
RETU (0)
ENDIF
IF ( e:genCode == EG_OPEN .and. e:osCode == 32 .and. e:canDefault )
NetErr(.t.)
RETU .f.
ENDIF
IF ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
NetErr(.t.)
RETU .f.
ENDIF
RETURN lRet
*/
static function ErrorDialog( e ) // -> logical or quits App.
local oDlg, oLbx, oFont
local lRet // if lRet == nil -> default action: QUIT
local n, j, cMessage, aStack := {}
local oSay, hLogo
local nButtons := 1
local cErrorLog := ""
local aVersions := GetVersion()
local aTasks
local aRDDs, nTarget, uValue
local oOldError
local cRelation
local lIsWinNT := IsWinNT()
// by default, division by zero yields zero
if ( e:genCode == EG_ZERODIV )
return 0
end
// for network open error, set NETERR() and subsystem default
if ( e:genCode == EG_OPEN .and. ;
( e:osCode == 32 .or. e:osCode == 5 ) .and. ;
e:canDefault )
NetErr( .t. )
return .f. // Warning: Exiting!
end
// for lock error during APPEND BLANK, set NETERR() and subsystem default
if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
NetErr( .t. )
return .f. // OJO SALIDA
endif
if Left( ProcName( 7 ), 10 ) == "ERRORDIALO"
SET RESOURCES TO
ErrorLevel( 1 )
QUIT
endif
ErrorBlock( {|e| MsgStop( ErrorMessage(e) + " from Errorsys, line:" + ;
Str( ProcLine( 1 ), 4 ) ), __quit() } )
cErrorLog += "Application" + CRLF
cErrorLog += "===========" + CRLF
cErrorLog += " Path and name: " + GetModuleFileName( GetInstance() )
#ifdef __CLIPPER__
cErrorLog += " (16 bits)" + CRLF
#else
cErrorLog += " (32 bits)" + CRLF
#endif
cErrorLog += " Size: " + Transform( FSize( GetModuleFileName( ;
GetInstance() ) ), "9,999,999 bytes" ) + CRLF
#ifdef __CLIPPER__
cErrorLog += " Max files handles permited: ( SetHandleCount() ) " + ;
Str( SetHandleCount(), 3 ) + CRLF
#endif
cErrorLog += " Time from start: " + TimeFromStart() + CRLF
cErrorLog += " Error occurred at: " + ;
DToC( Date() ) + ", " + Time() + CRLF
// Error object analysis
cMessage = " Error description: " + ErrorMessage( e ) + CRLF
cErrorLog += cMessage
if ValType( e:Args ) == "A"
cErrorLog += " Args:" + CRLF
for n = 1 to Len( e:Args )
cErrorLog += " [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
" " + cValToChar( e:Args[ n ] ) + CRLF
next
endif
cErrorLog += CRLF + "Stack Calls" + CRLF
cErrorLog += "===========" + CRLF
n := 2 // we don't disscard any info again !
while ( n < 74 )
if ! Empty(ProcName( n ) )
AAdd( aStack, " Called from: " + ProcFile( n ) + " => " + Trim( ProcName( n ) ) + ;
"(" + NTRIM( ProcLine( n ) ) + ")" )
cErrorLog += ATail( aStack ) + CRLF
endif
n++
end
cErrorLog += CRLF + "System" + CRLF
cErrorLog += "======" + CRLF
#ifdef __CLIPPER__
cErrorLog += " CPU type: " + GetCPU() + CRLF
#else
cErrorLog += " CPU type: " + GetCPU() + " " + ;
AllTrim( Str( GetCPUSpeed() ) ) + " Mhz" + CRLF
#endif
cErrorLog += " Hardware memory: " + ;
cValToChar( Int( nExtMem() / ( 1024 * 1024 ) ) + 1 ) + ;
" megs" + CRLF + CRLF
cErrorLog += " Free System resources: " + AllTrim( Str( GetFreeSystemResources( 0 ) ) ) + " %" + CRLF + ;
" GDI resources: " + AllTrim( Str( GetFreeSystemResources( 1 ) ) ) + " %" + CRLF + ;
" User resources: " + AllTrim( Str( GetFreeSystemResources( 2 ) ) ) + " %" + CRLF + CRLF
cErrorLog += " Compiler version: " + Version() + CRLF
#ifdef __CLIPPER__
cErrorLog += " Windows and MsDos versions: " + ;
AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
AllTrim( Str( aVersions[ 2 ] ) ) + ", " + ;
AllTrim( Str( aVersions[ 3 ] ) ) + "." + ;
AllTrim( Str( aVersions[ 4 ] ) ) + CRLF + CRLF
#else
cErrorLog += " Windows version: " + ;
AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
AllTrim( Str( aVersions[ 2 ] ) ) + ", Build " + ;
AllTrim( Str( aVersions[ 3 ] ) ) + ;
" " + aVersions[ 5 ] + CRLF + CRLF
#endif
aTasks = GetTasks()
cErrorLog += " Windows total applications running: " + ;
AllTrim( Str( Len( aTasks ) ) ) + CRLF
for n = 1 to Len( aTasks )
cErrorLog += " " + Str( n, 3 ) + " " + aTasks[ n ] + CRLF
next
// Warning!!! Keep here this code !!! Or we will be consuming GDI as
// we don't generate the error but we were generating the bitmap
hLogo = FWBitMap()
if e:canRetry
nButtons++
endif
if e:canDefault
nButtons++
endif
cErrorLog += CRLF + "Variables in use" + CRLF + "================" + CRLF
cErrorLog += " Procedure Type Value" + CRLF
cErrorLog += " ==========================" + CRLF
n := 2 // we don't disscard any info again !
while ( n < 74 )
if ! Empty( ProcName( n ) )
cErrorLog += " " + Trim( ProcName( n ) ) + CRLF
for j = 1 to ParamCount( n )
cErrorLog += " Param " + Str( j, 3 ) + ": " + ;
ValType( GetParam( n, j ) ) + ;
" " + cGetInfo( GetParam( n, j ) ) + CRLF
next
for j = 1 to LocalCount( n )
cErrorLog += " Local " + Str( j, 3 ) + ": " + ;
ValType( GetLocal( n, j ) ) + ;
" " + cGetInfo( GetLocal( n, j ) ) + CRLF
next
endif
n++
end
cErrorLog += CRLF + "Linked RDDs" + CRLF + "===========" + CRLF
aRDDs = RddList( 1 )
for n = 1 to Len( aRDDs )
cErrorLog += " " + aRDDs[ n ] + CRLF
next
cErrorLog += CRLF + "DataBases in use" + CRLF + "================" + CRLF
for n = 1 to 255
if ! Empty( Alias( n ) )
cErrorLog += CRLF + Str( n, 3 ) + ": " + If( Select() == n,"=> ", " " ) + ;
PadR( Alias( n ), 15 ) + Space( 20 ) + "RddName: " + ;
( Alias( n ) )->( RddName() ) + CRLF
cErrorLog += " ==============================" + CRLF
cErrorLog += " RecNo RecCount BOF EOF" + CRLF
cErrorLog += " " + Transform( ( Alias( n ) )->( RecNo() ), "9999999" ) + ;
" " + Transform( ( Alias( n ) )->( RecCount() ), "9999999" ) + ;
" " + cValToChar( ( Alias( n ) )->( BoF() ) ) + ;
" " + cValToChar( ( Alias( n ) )->( EoF() ) ) + CRLF + CRLF
if ( Alias( n ) )->( RddName() ) != "ARRAYRDD"
cErrorLog += " Indexes in use " + Space( 23 ) + "TagName" + CRLF
for j = 1 to 15
if ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
cErrorLog += Space( 8 ) + ;
If( ( Alias( n ) )->( IndexOrd() ) == j, "=> ", " " ) + ;
PadR( ( Alias( n ) )->( IndexKey( j ) ), 35 ) + ;
( Alias( n ) )->( OrdName( j ) ) + ;
CRLF
endif
next
cErrorLog += CRLF + " Relations in use" + CRLF
for j = 1 to 8
if ! Empty( ( nTarget := ( Alias( n ) )->( DbRSelect( j ) ) ) )
cErrorLog += Space( 8 ) + Str( j ) + ": " + ;
"TO " + ( Alias( n ) )->( DbRelation( j ) ) + ;
" INTO " + Alias( nTarget ) + CRLF
// uValue = ( Alias( n ) )->( DbRelation( j ) )
// cErrorLog += cValToChar( &( uValue ) ) + CRLF
endif
next
endif
endif
next
n = 1
cErrorLog += CRLF + "Classes in use:" + CRLF
cErrorLog += "===============" + CRLF
#ifndef __XHARBOUR__
while ! Empty( __ClassName( n ) )
cErrorLog += " " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
end
#else
while n <= __ClsCntClasses()
cErrorLog += " " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
end
#endif
cErrorLog += CRLF + "Memory Analysis" + CRLF
cErrorLog += "===============" + CRLF
#ifdef __CLIPPER__
cErrorLog += " Static memory:" + CRLF
cErrorLog += " data segment: 64k" + CRLF
#endif
#ifdef __CLIPPER__
cErrorLog += " Initial size: " + ;
LTrim( Str( nInitDSSize() ) ) + ;
" bytes (SYMP=" + LTrim( Str( nSymPSize() ) ) + ;
", Stack=" + LTrim( Str( nStackSize() ) ) + ;
", Heap=" + LTrim( Str( nHeapSize() ) ) + ")" + CRLF
cErrorLog += " PRG Stack: " + ;
LTrim( Str( 65535 - ( nStatics() * 14 ) - nInitDSSize() ) ) + ;
" bytes" + CRLF
#endif
#ifdef __CLIPPER__
cErrorLog += " " + LTrim( Str( nStatics() ) ) + " Static variables: " + ;
LTrim( Str( nStatics() * 14 ) ) + " bytes" + CRLF + CRLF
#else
cErrorLog += " " + LTrim( Str( nStatics() ) ) + " Static variables" + ;
CRLF + CRLF
#endif
cErrorLog += " Dynamic memory consume:" + CRLF
cErrorLog += " Actual Value: " + Str( MemUsed() ) + " bytes" + CRLF
cErrorLog += " Highest Value: " + Str( MemMax() ) + " bytes" + CRLF
// nSymNames() no longer returns a real value! 15/April/97
/*
cErrorLog += " SYMBOLS segment" + CRLF
cErrorLog += " " + LTrim( Str( nSymNames() ) ) + " SymbolNames: " + ;
LTrim( Str( nSymNames() * 16 ) ) + " bytes"
*/
// Generates a file with an Error Log
BEGIN SEQUENCE
oOldError = ErrorBlock( { || DoBreak() } )
MemoWrit( "Error.log", cErrorLog )
END SEQUENCE
ErrorBlock( oOldError )
DEFINE DIALOG oDlg ;
SIZE 300, 200 + If( lIsWinNT, 50, 0 ) ;
TITLE DLG_TITLE
@ 0, 0 SAY oSay PROMPT OemToAnsi( cMessage ) ;
CENTERED OF oDlg FONT oFont SIZE 149, 20
oSay:nStyle = nOR( oSay:nStyle, 128 ) // SS_NOPREFIX
oSay:nTop = 3
oSay:nLeft = 22
oSay:nBottom = 25
oSay:nRight = 148
@ 24, 6 SAY "&Stack List" OF oDlg FONT oFont PIXEL
n = aStack[ 1 ]
@ 33, 3 LISTBOX oLbx VAR n ITEMS aStack OF oDlg ;
SIZE 145, 60 + If( lIsWinNT, 18, 0 ) PIXEL
if nButtons == 1 .or. nButtons == 3
@ 88 + If( lIsWinNT, 24, 0 ), 60 BUTTON "&Quit" OF oDlg ACTION oDlg:End() ;
SIZE 30, 11 PIXEL FONT oFont DEFAULT
else
@ 88 + If( lIsWinNT, 24, 0 ), 37 BUTTON "&Quit" OF oDlg ACTION oDlg:End() ;
SIZE 30, 11 PIXEL FONT oFont
endif
if e:CanRetry
@ 88 + If( lIsWinNT, 24, 0 ), If( nButtons == 2, 82, 13 ) BUTTON "&Retry" ;
OF oDlg ACTION ( lRet := .t., oDlg:End() ) ;
SIZE 30, 11 FONT oFont PIXEL
endif
if e:CanDefault
@ 88 + If( lIsWinNT, 24, 0 ), 108 BUTTON "&Default" OF oDlg ;
ACTION ( lRet := .f., oDlg:End() ) ;
SIZE 30, 11 FONT oFont PIXEL
endif
@ 21, 100 BUTTON "See Error.log file" OF oDlg FONT oFont PIXEL ;
SIZE 47, 10 ;
ACTION WinExec( "Notepad.exe error.log" )
ACTIVATE DIALOG oDlg CENTERED ;
ON PAINT DrawBitmap( hDC, hLogo, 6, 6 )
DeleteObject( hLogo )
if lRet == nil .or. ( !LWRunning() .and. lRet )
SET RESOURCES TO
ErrorLevel( 1 )
// Add these lines if using MDI child windows with dialogboxes
// for n = 1 to Len( GetAllWin() )
// if ValType( GetAllWin()[ n ] ) == "O"
// GetAllWin()[ n ]:UnLink()
// endif
// next
QUIT // must be QUIT !!!
endif
return lRet
//--------------------------------------------------------------------------//
/*
STATIC FUNCTION ErrorMessage(e)
LOCAL cMessage := if(empty(e:osCode) ,;
if(e:severity > ES_WARNING ,;
"ERROR " ,;
"ATENCION ") ,;
"(DOS ERROR "+NTRIM(e:osCode)+") " )
cMessage += if(ValType( e:subsystem ) == "C",;
e:subsystem() ,;
"???" )
cMessage += if(ValType( e:subCode ) == "N",;
"/" + NTRIM( e:subCode ) ,;
"/???" )
IF ( ValType(e:description) == "C" )
cMessage += " " + e:description
ENDIF
cMessage += if(!Empty( e:filename ),;
": " + e:filename ,;
if(!Empty( e:operation ),;
": " + e:operation ,;
"" ) )
RETURN cMessage
//----------------------------------------------------------------------------//
STATIC FUNCTION cGetInfo( uVal )
LOCAL cType := ValType( uVal )
DO CASE
CASE cType == "C"
RETU '"' + cValToChar( uVal ) + '"'
CASE cType == "O"
RETU "Class: " + uVal:ClassName()
CASE cType == "A"
RETU "Lon: " + Str( Len( uVal ), 4 )
OTHERWISE
RETU cValToChar( uVal )
ENDCASE
RETURN nil
FUNCTION ChkError(e, cFile)
IF Valtype(e) != "O"
e := ErrorNew()
e:Description := "CORRUPCION DETECTADA EN AUTO-APERTURA DEL INDICE"
e:osCode := 1012
e:severity := ES_ERROR
e:filename := cFile
ENDIF
RETURN e
*/
FUNCTION ErrorHandler(e,lLocalError)
LOCAL xRet
IF e:genCode == EG_OPEN .AND. ;
e:osCode == 32 .AND. ;
e:canDefault
NetErr(.T.)
RETU .F.
END
IF lLocalError
BREAK e
ENDIF
RETURN NIL
static func ErrorMessage( e )
// start error message
local cMessage := if( empty( e:OsCode ), ;
if( e:severity > ES_WARNING, "Error ", "Warning " ),;
"(DOS Error " + NTRIM(e:osCode) + ") " )
// add subsystem name if available
cMessage += if( ValType( e:SubSystem ) == "C",;
e:SubSystem() ,;
"???" )
// add subsystem's error code if available
cMessage += if( ValType( e:SubCode ) == "N",;
"/" + NTRIM( e:SubCode ) ,;
"/???" )
// add error description if available
if ( ValType( e:Description ) == "C" )
cMessage += " " + e:Description
end
// add either filename or operation
cMessage += if( ! Empty( e:FileName ),;
": " + e:FileName ,;
if( !Empty( e:Operation ),;
": " + e:Operation ,;
"" ) )
return cMessage
//----------------------------------------------------------------------------//
// returns extended info for a certain variable type
static function cGetInfo( uVal )
local cType := ValType( uVal )
do case
case cType == "C"
return '"' + cValToChar( uVal ) + '"'
case cType == "O"
return "Class: " + uVal:ClassName()
case cType == "A"
return "Len: " + Str( Len( uVal ), 4 )
otherwise
return cValToChar( uVal )
endcase
return nil
//----------------------------------------------------------------------------//
#define HKEY_LOCAL_MACHINE 2147483650 // 0x80000002
function GetCPU()
local oReg := TReg32():New( HKEY_LOCAL_MACHINE,;
"HARDWARE\DESCRIPTION\System\CentralProcessor\0",;
.f. )
local cCpu := oReg:Get( "ProcessorNameString" )
oReg:Close()
return cCpu
//----------------------------------------------------------------------------//
#ifdef __HARBOUR__
#ifndef __XHARBOUR__
REQUEST HB_GT_GUI
procedure HB_GTSYS() ; return
procedure HB_GT_GUI_DEFAULT() ; return
procedure FW_GT ; return
#endif
#endif
//----------------------------------------------------------------------------//
FUNCTION AbrirIdx(xIdx)
LOCAL oGenError
LOCAL bNewError, bOldError
LOCAL aIdxFiles
LOCAL cIdxFile
LOCAL nFor
LOCAL lOk
bNewError := {|oError| ErrorHandler(oError,.T.) }
bOldError := Errorblock(bNewError)
//aOpened := {}
lOk := .T.
IF Valtype(xIdx) == "A"
aIdxFiles := xIdx
ELSE
aIdxFiles := {}
Aadd(aIdxFiles,xIdx)
ENDIF
BEGIN SEQUENCE
FOR nFor := 1 TO len(aIdxFiles)
cIdxFile := aIdxFiles[nFor]
IF File(cIdxFile)
OrdListAdd(cIdxFile)
ELSE
lOk := .F.
ENDIF
NEXT
OrdSetFocus(0)
RECOVER USING oGenError
lOk := .F.
IF oGenError != NIL
* oGenError := ChkError(oGenError, cIdxFile)
MsgStop("ERROR EN LA APERTURA DE INDICES+CRLF+IMPOSIBLE CONTINUAR","ERROR FATAL")
ENDIF
END SEQUENCE
Errorblock(bOldError)
RETURN lOk
FUNCTION Indexacdx( cFile , cIndex , aInd , lEspera )
LOCAL oDlg
LOCAL oMeter , lSalida:=.T. , oBtn , oFont
LOCAL cAlias
LOCAL nActual
DEFAULT lEspera:=.F.
cAlias := OpenDbf( cFile , 1 , .F. , .F. , lEspera ) // Exclusivo
IF EMPTY(cAlias)
MsgStop("NO FUE POSIBLE ABRIR EL ARCHIVO "+cFileName(cFile),"AVISO DEL SISTEMA")
RETURN( NIL )
ENDIF
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0,-10 // definimos fuente tipo Windows 95
DEFINE DIALOG oDlg RESOURCE "DLG_INDEX" FONT oFont TITLE "CREACION DE INDICES PARA "+cFileName(cFile)
REDEFINE METER oMeter Var nActual ID 116 OF oDlg NOPERCENTAGE UPDATE
REDEFINE BUTTON oBtn ID 1 OF oDlg UPDATE;
ACTION ( lSalida:=.F. ,Indexar( oMeter , cAlias , cIndex , aInd ), lSalida:=.T. , oDlg:End() )
ACTIVATE DIALOG oDlg VALID ( IIF(lSalida==.T., lSalida ,Eval({|| MsgInfo("SE ESTA GENERANDO UN INDICE","AVISO DEL SISTEMA"),.F.}))) CENTERED
(cAlias)->(DBCLOSEAREA())
RETURN ( NIL )
FUNCTION Indexar( oMeter , cAlias , cIndex , aIndices )
LOCAL i,nTotal,nContador
*cAlias := OpenDbf( cFile , 1 , .F. , .F. , .T. ) // Exclusivo
*IF EMPTY(cAlias)
* MsgStop("NO FUE GENERAR EL INDICE","ERROR AL GENERAR INDICES")
* RETURN
*ENDIF
IF FILE( cIndex )
ERASE( cIndex )
ENDIF
oMeter:nTotal := (cAlias)->(LASTREC())*LEN( aIndices )
nContador := 1
FOR i := 1 TO LEN( aIndices )
INDEX ON &(aIndices[i,1]) TAG (aIndices[i,2]) EVAL (oMeter:SET(nContador),nContador++,.T.)
NEXT
RETURN
static function DoBreak()
BREAK
return nil
//-----------