Colaboração;
migrei de xHborbor para Harbour 3.2 e notei que a função hb_FuncPtr em Harbor não esta funcionando;
ValType( hb_FuncPtr( wexec ) )
a linha acima em xHarbour retorna "P" se "wexec" existe e deveria retornar "S" em Harbour, só que retorna "S" mesmo não existindo;
utilizando a rotina "errorsys.prg" para gerar as informações de erro, acrescentei as linhas abaixo que resolveu o problema:
if oError:gencode == EG_NOFUNC // erro de função não encontrada
// acrescente uma mensagem que a rotina não existe
return .T. // retorna para a rotina que originou o erro sem interromper o programa
endif
espero ter ajudado;
harbour hb_funcPtr
Moderador: Moderadores
-
Itamar M. Lins Jr.
- Administrador
- Mensagens: 7929
- Registrado em: 30 Mai 2007 11:31
- Localização: Ilheus Bahia
- Curtiu: 1 vez
harbour hb_funcPtr
Isso é um dos BUGs do xHarbour que segundo consta ninguém sabe ninguém viu.
No Harbour não precisa disso.
Valtype() retorna a variável do tipo POINTER corretamente.
Itamar M. Lins Jr.
No Harbour não precisa disso.
Valtype() retorna a variável do tipo POINTER corretamente.
Saudações,In xHarbour above code creates pointer item ( VALTYPE(funcSym) == "P" )
which can be used in some cases like in Harbour but because xHarbour VM
does not know if given pointer item is function reference or not then in
such context xHarbour has to accept any pointer items as function
references so any user mistake can cause GPF or some HVM structure
corruptions.
Itamar M. Lins Jr.
Saudações,
Itamar M. Lins Jr.
Itamar M. Lins Jr.
harbour hb_funcPtr
Pessoal, até hj eu não tenho uma "Rotina personalizada de Erro" que funcione adequadamente em meu sistemas console Harbour e xHarbour .
Já experimentei todas as q achei aqui no fórum, nenhuma funfou 100% e eu terminei usando a "padrão" (que não adianta nada) colocando apenas a chamada Errorsys() no programa inicial.
Se vcs possuirem "rotina de erro" q funcione 100% pra harbour e xHarbour e puderem postar , seria ótimo pra mim..
Já experimentei todas as q achei aqui no fórum, nenhuma funfou 100% e eu terminei usando a "padrão" (que não adianta nada) colocando apenas a chamada Errorsys() no programa inicial.
Se vcs possuirem "rotina de erro" q funcione 100% pra harbour e xHarbour e puderem postar , seria ótimo pra mim..
lugab
-
Minduim
- Usuário Nível 2
- Mensagens: 59
- Registrado em: 06 Abr 2011 13:02
- Localização: Santo andré - SP
harbour hb_funcPtr
lugab;
a rotina errorsys.prg que utilizo foi retirada aqui do forum, acrescentada com algumas perfumarias pessoais;
com você declarou que já experimentou todas, entendo que não adianta postar aqui, pois estaria sendo repetitivo
e não atende as suas necessidades;
a rotina errorsys.prg que utilizo foi retirada aqui do forum, acrescentada com algumas perfumarias pessoais;
com você declarou que já experimentou todas, entendo que não adianta postar aqui, pois estaria sendo repetitivo
e não atende as suas necessidades;
-
Hasse
- Usuário Nível 4
- Mensagens: 820
- Registrado em: 19 Out 2004 10:30
- Localização: Jaraguá do Sul - SC
harbour hb_funcPtr
Bom dia Lugab.
Eu tenho uma rotina de erro que estou usando desde 2006 e que me atende de forma adequada, copiada do "ErroLog.prg" do Luiz Henrique Santos, com muitas perfumarias adaptadas para o meu uso no xHarbour. Nunca testei no Harbour. Parece-me que esta rotina foi copiada e adpatada do ErrorLog.prg do velho e bom Clipper.
Esta rotina cria um arquivo para cada ocorrência de erro, incrementando o nome do arquivo ErrorLog. Desta forma posso rastrear a sequência de erros mais facilmente.
Eu tenho uma rotina de erro que estou usando desde 2006 e que me atende de forma adequada, copiada do "ErroLog.prg" do Luiz Henrique Santos, com muitas perfumarias adaptadas para o meu uso no xHarbour. Nunca testei no Harbour. Parece-me que esta rotina foi copiada e adpatada do ErrorLog.prg do velho e bom Clipper.
Código: Selecionar todos
*--------------------------------------------------------------------------------------------------
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* *
* ERRORLOG.PRG *
* *
* Luiz Henrique dos Santos *
* luiz.hs@uol.com.br *
* *
* Adaptado por Ivo Fritz Hasse Data: 30/04/2006 *
* *
* ver os códigos de erro em: error.ch *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// Função para Criação de Arquivo LOG contendo os Erros
*
*--------------------------------------------------------------------------------------------------
FUNCTION ErrorLog( oErr, nProcLine )
Local cScreen := SaveScreen() ,;
cCorAnt := SetColor() ,;
cLogFile := Space(12) ,;
nWorkArea := Select() ,;
nRange := ( Maxcol()+1 ) * 2 ,;
nStart := 1
Local aArqTemp := Directory( 'ERRORLOG.*' )
Local nFhandle , nCount , nForLoop , nMemHandle ,;
nMemLength , nMemWidth , nMemCount , cOutstring ,;
cSubstring , cVarName , cVarType , cTemp ,;
nLenTemp , nBytes , cVarRec
Local cExt, I
Local aTeclas := {}
*-------------------------------- Arquivar o Buffer do teclado num Array --------------------------
AADD( aTeclas, LastKey() )
For nConta = 1 TO 15
nn := Inkey()
IF nn == 0
EXIT
ENDIF
AADD( aTeclas, nn )
Next
*-------------------------------- Setar DEVICE para a Tela ----------------------------------------
#include "set.ch"
c_device := SET(_SET_DEVICE)
SET DEVICE TO SCREEN
If ( oErr:GenCode() == 5 ) && Divisão por zero.
@ 01,00 SAY "DivisÆo por Zero no M¢dulo >"+Procname(2)+"<, na Linha >" + StrValue(Procline(2)) + "<"
SetColor( cCorAnt )
Inkey( 2 )
Return( 0 ) && Retorna o valor 0 (zero)
Endif
IF ( ProcName(2) == "IMPREXA" )
If ( oErr:GenCode() == 1 ) && Variáveis incompatíveis.
Alertar("********** Exame: '" + c_codexa + "' **********;;" +;
"H um erro no '" + c_codexa + ".IMP', na linha abaixo. Verifique. ;;" +;
"=>>" + c_var1 + "<<= ;;" +;
"Possivelmente as vari veis nÆo sejam do mesmo tipo.")
SetColor( cCorAnt )
Return .F.
Endif
If ( oErr:GenCode() == 7 ) && Erro de sintaxe.
Alertar("********** Exame: '" + c_codexa + "' **********;;" +;
"H um erro no '" + c_codexa + ".IMP', na linha abaixo. Verifique. ;;" +;
"=>>" + c_var1 + "<<= ;;" )
SetColor( cCorAnt )
Return .F.
Endif
ENDIF
If ( oErr:GenCode() == 21 .And. oErr:OsCode() == 32 .And. oErr:CanDefault() )
NetErr(.T.) && 21 - Erro de abertura de arquivo.
SetColor( cCorAnt ) && 32 - Corrupção de arquivo.
Return .F.
EndIf
If ( oErr:GenCode() == 40 .And. oErr:CanDefault() ) && 40 - Erro de Append.
NetErr(.T.)
SetColor( cCorAnt )
Return .F.
EndIf
*------------------------------------ Gerar a extensão do LogFile ---------------------------------
cExt:= '000'
For I:= 1 To Len( aArqTemp )
If Val( cExt ) < Val( Substr( aArqTemp[I][1], 10, 3 ) )
cExt:= Substr( aArqTemp[I][1], 10, 3 )
EndIf
EndFor
cExt := StrZero( Val( cExt ) + 1, 3 )
cLogFile := 'ERRORLOG.' + cExt
*----------------------------------- Gerar as mensagens de erro de TELA ---------------------------
__cErro := ""
DescrErro()
NumerErro := "/" + STRTRAN( StrValue(oErr:SubCode()), ".", "" )
n_pos1 := AT( NumerErro, __cErro )
n_pos2 := AT( CHR(10), __cErro, n_pos1 ) - 01
*
__Error := Padr('Tipo de Mensagem .: ' + oErr:SubSystem(),50 ) + ";" +;
Padr('N£mero do Erro ...: ' + StrValue(oErr:SubCode()),50 ) + ";" +;
Padr('Descri‡Æo ........: ' + oErr:Description(),50) + ";" +;
Padr('Objeto do Erro ...: ' + Upper(oErr:Operation() ),50) + ";" +;
Padr('Erro do DOS ......: ' + Strvalue(oErr:OsCode() ),50) + ";" +;
Padr('µrea de Trabalho .: ' + StrValue(Select() ),50) + ";" +;
Padr('Nome do Arquivo ..: ' + oErr:FileName(),50) + ";" +;
Padr('Module Name.... ..: ' + oErr:ModuleName(),50) + ";" +;
Padr('M¢dulo .....: ' + Procname(2) + REPLICATE(".",15-LEN(Procname(2))) +;
': Linha... ' + StrValue(Procline(2)),50)
nCount := 2
While ! Empty( Procname( ++nCount) )
__Error += ";" + Padr(SPACE(14) + Procname(nCount) +;
REPLICATE(".",15-LEN(Procname(nCount))) +;
': Linha... ' + StrValue(Procline(nCount)),50)
IF nCount > 6
EXIT
ENDIF
EndDo
*----------------------------------- Alerta de TELA do erro ocorrido ------------------------------
If oErr:Severity() > 1 && Erro Severo ou Catastrófico.
Alertar('Ocorreu um erro irrecuper vel na aplica‡Æo. ;;' +;
__Error + ' ; ;' +;
'Maiores detalhes no arquivo ' + cLogFile)
Else && Erro de Simples ALERTA.
Alertar('Ocorreu um erro na aplica‡Æo, por‚m o ;' +;
'trabalho pode continuar. ;;' + __Error + ' ; ;' +;
'Maiores detalhes no arquivo ' + cLogFile)
EndIf
*------------------------------------ Gravar informações sobre o erro -----------------------------
SetColor('W+/R')
@ 10,15 Clear To 12,65
@ 10,15 To 12,65 Double
@ 11,17 Say 'Aguarde... Gravando informa‡äes sobre o erro ...'
SetColor( cCorAnt )
nFhandle:= Fcreate( cLogFile, 0 )
If nFhandle < 4
Alertar( ' As informa‡äes referentes ao erro;' +;
'nÆo puderam ser salvas. ' )
Else
FWriteLine( nFhandle, padc( ' Informações sobre o Erro - ErrorLog ', 83, '*' ) )
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, ' Tipo de Mensagem ..............: ' + oErr:SubSystem() )
FWriteLine( nFhandle, ' Número do Erro ................: ' + StrValue(oErr:SubCode()) )
FWriteLine( nFhandle, ' Descrição .....................: ' + oErr:Description() )
FWriteLine( nFhandle, ' Objeto do Erro ................: ' + Upper(oErr:Operation()) )
FWriteLine( nFhandle, ' Erro do DOS ...................: ' + Strvalue(oErr:OsCode()) )
FWriteLine( nFhandle, ' Área de Trabalho ..............: ' + StrValue(Select()) )
FWriteLine( nFhandle, ' Nome do arquivo ...............: ' + Dbf() )
FWriteLine( nFhandle, ' Nome do Arquivo associado .....: ' + oErr:FileName )
FWriteLine( nFhandle, ' Número de argumentos ..........: ' + AllTrim(Str(Len(oErr:args))),50)
FWrite ( nFhandle, ' Módulo .........: ' )
nCount := 1
While ! Empty( Procname( ++nCount) )
cFile := Procname(nCount) + REPLICATE(".",25-LEN(Procname(nCount)))
FWriteLine( nFhandle, cFile + ' :Linha... ' +;
Padr(StrValue(Procline(nCount)), 20) )
Fwrite( nFhandle, ' ' )
EndDo
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, Padc( ' Informações do Código de Erro ', 83, '*' ) )
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, ' oErr:GenCode().................: ' + StrValue(oErr:GenCode()))
FWriteLine( nFhandle, ' oErr:OsCode().(DOS)............: ' + StrValue(oErr:OsCode()))
FWriteLine( nFhandle, ' oErr:Severity()................: ' + StrValue(oErr:Severity()))
FWriteLine( nFhandle, ' oErr:CanDefault()..............: ' + StrValue(oErr:CanDefault()))
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, Padc( ' Informações do ambiente DOS ', 83, '*' ) )
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, ' Data ..........................: ' + Dtoc( Date()) )
FWriteLine( nFhandle, ' Hora ..........................: ' + Time() )
FWriteLine( nFhandle, ' Espaço em Disco ...............: ' + StrValue(DiskSpace()) )
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, Padc( ' Informações da Memória Convencional ', 83, '*' ) )
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, ' Memória Livre .................: ' + StrValue(Memory(0)) )
FWriteLine( nFhandle, ' Maior Bloco Contínuo ..........: ' + StrValue(Memory(1)) )
FWriteLine( nFhandle, ' Memória Disponível ( RUN ) ....: ' + StrValue(Memory(2)) )
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, Padc( ' Informações do ambiente Clipper / xHarbour ', 83, '*' ) )
FWriteLine( nFhandle, '' )
FwriteLine( nFhandle, ' Exact is ......................: ' + StrValue(Set(01),.T.))
FWriteLine( nFhandle, ' Fixed is ......................: ' + StrValue(Set(02),.T.))
FWriteLine( nFhandle, ' Decimals is at ................: ' + StrValue(Set(03)))
FWriteLine( nFhandle, ' Path is set to ................: ' + StrValue(Set(06)))
FWriteLine( nFhandle, ' Default is at .................: ' + StrValue(Set(07)))
FWriteLine( nFhandle, ' Epoch is ......................: ' + StrValue(Set(05)))
FWriteLine( nFhandle, ' Date Format at ................: ' + StrValue(Set(04)))
FWriteLine( nFhandle, ' Alternate is ..................: ' + StrValue(Set(18),.T.))
FWriteLine( nFhandle, ' Alter File is .................: ' + StrValue(Set(19)))
FWriteLine( nFhandle, ' Console is ....................: ' + StrValue(Set(17),.T.))
FWriteLine( nFhandle, ' Margin is set .................: ' + StrValue(Set(25)))
FWriteLine( nFhandle, ' Printer is ....................: ' + StrValue(Set(23),.T.))
FWriteLine( nFhandle, ' Printer File ..................: ' + StrValue(Set(24)))
FWriteLine( nFhandle, ' Device is at ..................: ' + StrValue(Set(20)))
FWriteLine( nFhandle, ' Bell is .......................: ' + StrValue(Set(26),.T.))
FWriteLine( nFhandle, ' Confirm is ....................: ' + StrValue(Set(27),.T.))
FWriteLine( nFhandle, ' Delimiters are ................: ' + StrValue(Set(33),.T.))
FWriteLine( nFhandle, ' Delimit Chars .................: ' + StrValue(Set(34)))
FWriteLine( nFhandle, ' Escape is set .................: ' + StrValue(Set(28),.T.))
FWriteLine( nFhandle, ' Intensity is ..................: ' + StrValue(Set(31),.T.))
FWriteLine( nFhandle, ' Scoreboard is .................: ' + StrValue(Set(32),.T.))
FWriteLine( nFhandle, ' Wrap is set ...................: ' + StrValue(Set(35),.T.))
FWriteLine( nFhandle, ' Message line ..................: ' + StrValue(Set(36)))
FWriteLine( nFhandle, ' Message Center ................: ' + StrValue(Set(37),.T.))
FWriteLine( nFhandle, ' Exclusive is ..................: ' + StrValue(Set(08),.T.))
FWriteLine( nFhandle, ' Softseek is ...................: ' + StrValue(Set(09),.T.))
FWriteLine( nFhandle, ' Unique is .....................: ' + StrValue(Set(10),.T.))
FWriteLine( nFhandle, ' Deleted is ....................: ' + StrValue(Set(11),.T.))
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, Padc( ' Detalhes da Área de Trabalho ', 83, '*' ) )
FWriteLine( nFhandle, '' )
For nCount := 1 to 55
If ! Empty( (nCount)->( Alias() ) )
(nCount)->(FWriteLine( nFhandle, ' Área de Trabalho ' + REPL('.',30) + ': ' + StrValue( Select())))
(nCount)->(FWriteLine( nFhandle, ' Alias .........................: ' + Upper(Alias()) ))
(nCount)->(FWriteLine( nFhandle, ' Registro Atual ................: ' + Strvalue( Recno()) ))
(nCount)->(FWriteLine( nFhandle, ' Total de registros.............: ' + StrValue( Lastrec()) ))
(nCount)->(FWriteLine( nFhandle, ' Filtro Atual ..................: ' + DbFilter() ))
(nCount)->(FWriteLine( nFhandle, ' Expressão de Relacionamento ...: ' + DbRelation() ))
(nCount)->(FWriteLine( nFhandle, ' Ordem do Índice ...............: ' + StrValue( IndexOrd())))
(nCount)->(FWriteLine( nFhandle, ' Chave do Índice ...............: ' + IndexKey( IndexOrd())))
(nCount)->(FWriteLine( nFhandle, ' --------------------------------------------------------' ))
(nCount)->(FWriteLine( nFhandle, '' ))
EndIf
EndFor
*------------------------------------ Cópia da TELA onde ocorreu o erro ---------------------------
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, Padc( ' Tela onde ocorreu o Erro ', 83, '*' ) )
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, 'Ú' + Replicate('Ä',Maxcol()+3) + '¿' )
cScreen := HB_OemToAnsi( cScreen )
For nCount:= 1 to Maxrow()
cOutString := ''
cSubString := Substr(cScreen, nStart, nRange )
For nForLoop:= 1 to nRange step 2
cOutString += Substr(cSubString, nForLoop, 1)
EndFor
FWriteLine( nFhandle, '³ '+cOutString+' ³' )
nStart += nRange
EndFor
FWriteLine( nFhandle, 'À' + Replicate('Ä', Maxcol()+3) + 'Ù' )
*------------------------------------ Lista as Variáveis de Memória -------------------------------
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, padc( ' Variáveis de Memória ', 83, '*' ) )
FWriteLine( nFhandle, '' )
Save All Like * to ErrorMem
nMemHandle := Fopen( 'Errormem.mem', 2 )
nMemLength := Fseek( nMemHandle, 0, 2)
Fseek(nMemHandle,0)
nCount := 1
While Fseek(nMemHandle, 0, 1)+1 < nMemLength
nMemWidth:= space(18)
Fread( nMemHandle, @nMemWidth, 18 )
cVarName := Left( nMemWidth, At( Chr(0) , nMemWidth ) -1 )
cVartype := Substr( nMemWidth, 12, 1 )
cVarRec := Bin2w( Right( nMemWidth, 2 ) )
nMemCount:= If( cVarType $ Chr(195)+Chr(204), 14+cVarRec, 22 )
Fseek(nMemHandle, nMemCount, 1)
cTemp := Left(cVarName + Space(10), 10)
*==================================================================================================
* As 5 linhas abaixo foram adicionadas por Ivo F Hasse, 15/05/2006.
* Imprime o valor da variáveis numéricas e o estado da variáveis lógicas.
*--------------------------------------------------------------------------------------------------
cTemp += ' Tipo ' + Type(cVarName)
cTemp += ' = ' + IF( Type(cVarName) == 'C', ['] + &cVarName + ['],;
IIF( Type(cVarName) == 'L',StrValue( &cVarName ),;
IIF( Type(cVarName) == 'N',StrValue( &cVarName ),;
StrValue( cVarName ))))
*==================================================================================================
*--------------------------------------------------------------------------------------------------
* cTemp += ' ' + If( Type(cVarName) == 'C', ['] + &cVarName + ['],;
* StrValue( cVarName ))
* StrValue( &cVarName ))
* ==>> esta linha acima gera erro quando existem variáveis lógicas,
* e foi substituída pelas linhas acima, criada em 15/05/2006 <<==
*--------------------------------------------------------------------------------------------------
nBytes := 0
Do Case
Case Type(cVarName) == 'C'
nBytes += ( nLenTemp := Len( &cVarName. ) )
Case Type(cVarName) == 'N'
nBytes += ( nLenTemp := 9 )
Case Type(cVarName) == 'L'
nBytes += ( nLenTemp := 2 )
Case Type(cVarName) == 'D'
nBytes += ( nLenTemp := 9 )
EndCase
Fwrite( nFhandle, ' ' + Transform(nLenTemp, '9999999') + ' Bytes -> ')
FWriteLine( nFhandle, ' ' + cTemp )
EndDo
*------------------------------------ Lista as Últimas Teclas Pressionadas ------------------------
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, padc( ' Últimas Teclas Pressionadas ', 83, '*' ) )
FWriteLine( nFhandle, '' )
Fwrite( nFhandle, ' LastKey() -> ' + Transform(aTeclas[1], '9999999') )
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, '' )
For nConta = 2 TO Len( aTeclas )
Fwrite( nFhandle, ' Buffer do teclado'+Str(nConta-01,02)+' -> ' + Transform(aTeclas[nConta], '9999999') )
FWriteLine( nFhandle, '' )
Next nConta
*------------------------------------ FIM DA LISTA DA DESCRIÇÃO DO ERRO ---------------------
FWriteLine( nFhandle, '' )
FWriteLine( nFhandle, padc( ' Fim da Descrição do Erro - ErrorLog ', 83, '*' ) )
FWriteLine( nFhandle, '' )
Fclose( nMemHandle )
Ferase( 'Errormem.mem' )
Fclose( nFhandle )
EndIf
SetColor(cCorAnt)
@ 10,15 Clear To 12,65
If ( oErr:OsCode() == 2 .Or. oErr:OsCode() == 3 )
Break(oErr)
EndIf
If oErr:Severity() == 3
ErrorLevel(1)
Cls
DbCloseAll()
Quit
EndIf
If ! oErr:CanDefault()
Break(oErr)
EndIf
IF c_device = "PRINTER"
DO WHILE SET(_SET_DEVICE) <> "PRINTER"
SET DEVICE TO PRINTER
ENDDO
ENDIF
Return .F.
// Fim da funcao ErrorLog()
*
*--------------------------------------------------------------------------------------------------
Static Function StrValue( cString, OnOff )
Local cRetValue:= Space(01) ,;
cFormat := Space(01) ,;
nFormat := 0 ,;
nDecimals:= 0 ,;
cStrDec := Space(01) ,;
nOndDec := 0
If Empty(OnOff)
OnOff:= .F.
EndIf
Do Case
Case ValType( cString ) == 'C'
cRetValue:= cString
Case ValType( cString ) == 'N'
cStrDec := Str( cString )
nOndDec := At(".", cStrDec )
nDecimals:= 0
If ( nOndDec > 0)
nDecimals:= Len( alltrim( SubStr( cStrDec, nOndDec + 1 ) ) )
endif
cFormat := '@E 999,999,999,999,999,999,999,999,999'
If nDecimals > 0
cFormat+= '.'
For nFormat:= 1 to nDecimals
cFormat+= '9'
EndFor
cRetValue:= alltrim( transform( cString , cFormat ) )
Else
cRetValue:= alltrim( transform( cString , cFormat ) )
EndIf
Case ValType( cString ) == 'M'
cRetValue:= If( Len(cString) > (Memory(0) * 1024) * .80, ;
Left(cString, Int( (Memory(0)*1024)*.80) ), cString )
Case ValType( cString ) == 'D'
cRetValue:= Dtoc( cString )
Case ValType( cString ) == 'L'
cRetValue:= If( OnOff, If(cString, 'On', 'Off'), ;
If(cString, 'True', 'False') )
EndCase
Return( cRetValue )
*
*
*--------------------------------------------------------------------------------------------------
Function Alertar(expC1,expA2,expC3)
/*
<expC1> Mensagem de Alertar
<expA2> Array com Opcoes de Retorno
<expC3> Expressao de Cores do Video
*/
Local Fundo := SaveScreen() ,;
Corant := SetColor() ,;
Curant := SetCursor() ,;
MsgAlert:= {} ,;
PxyAlert:= Array(4) ,;
TamAlert:= 00 ,;
IniAlert:= 01 ,;
MenAlert:= space(01) ,;
OpcAlert:= 00
expC1:= If( Empty(expC1) , 'ERRO' , expC1 )
expA2:= If( Empty(expA2) , { ' Ok ' } , expA2 )
expC3:= If( Empty(expC3) , 'R/W,W+/R' , expC3 )
SetColor(expC3)
SetCursor(0)
While At(';',expC1) > 0
Aadd( MsgAlert , Substr( expC1 , 1 , At(';',expC1)-1 ) )
expC1 := Substr( expC1 , At(';',expC1)+1 )
TamAlert:= If( Len( MsgAlert[Len(MsgAlert)] ) > TamAlert , ;
Len( MsgAlert[Len(MsgAlert)] ) , ;
TamAlert )
EndDo
Aadd( MsgAlert , expC1 )
TamAlert:= If( Len( MsgAlert[Len(MsgAlert)] ) > TamAlert , ;
Len( MsgAlert[Len(MsgAlert)] ) , ;
TamAlert )
MenAlert:= expA2[1]
For IniAlert:= 2 to Len(expA2)
MenAlert+= Space(03) + expA2[IniAlert]
EndFor
TamAlert:= If( Len( MenAlert ) > TamAlert , ;
Len( MenAlert ) , TamAlert )
PxyAlert[1]:= Int( ( 24 - ( Len(MsgAlert) + 6 ) ) / 2 )
PxyAlert[2]:= Int( ( 80 - ( TamAlert + 4 ) ) / 2 )
PxyAlert[3]:= PxyAlert[01] + Len(MsgAlert) + 3
PxyAlert[4]:= PxyAlert[02] + TamAlert + 3
DispBox( PxyAlert[1], PxyAlert[2], PxyAlert[3], PxyAlert[4], ;
Chr(219)+Chr(223)+Chr(219)+Chr(219)+Chr(219)+Chr(220)+ ;
Chr(219)+Chr(219)+' ' )
For IniAlert:= 1 to Len(MsgAlert)
DevPos( PxyAlert[1] + IniAlert , PxyAlert[2]+2 )
DevOut( Padc( MsgAlert[IniAlert] , TamAlert ) )
EndFor
MenAlert:= Int( ( 79 - Len( AllTrim(MenAlert) ) ) / 2 ) - 3
While OpcAlert == 0
DevPos( PxyAlert[1] + 2 + Len(MsgAlert) , MenAlert )
For IniAlert:= 1 to Len(expA2)
@ PxyAlert[1] + 2 + Len(MsgAlert) , Col() + 3 Prompt expA2[IniAlert]
EndFor
Menu To OpcAlert
EndDo
SetColor( Corant )
SetCursor( Curant )
RestScreen(,,,,Fundo)
RETURN( OpcAlert )
*
*
*--------------------------------------------------------------------------------------------------
STATIC FUNCTION FGravaTxt(cArq, cText)
*
IF FILE(cArq)
*
FHandle := FOpen(cArq, 2 )
FSeek(FHandle, 0, 2 )
*
ELSE
*
FHandle := FCreate(cArq, 0 )
*
ENDIF
*
Fwrite( FHandle, cText )
FWriteLine( FHandle, "" )
*
FClose(FHandle )
*
RETURN( NIL )
*
*
*--------------------------------------------------------------------------------------------------
STATIC FUNCTION FWriteLine( nHandle, cString )
*
Fwrite( nHandle, cString )
Fwrite( nHandle, chr(13) )
Fwrite( nHandle, chr(10) )
*
Return( Nil )Hasse
CP200 / CP500 / Basic / dBase III / dBase IV / Clipper Summer / RTlink / Exospace.
Clipper 5.3b / Blinker 7.0 / CDX com TAG
xHarbour 1.2.1-6604 / Borland C++ (5.5.1) 32 bit / HBmake.
Harbour 3.2.0dev (r1412121623) / MINGW / HBM2 / MiniGui HMG 3.1.4 / IDE (Roberto Lopez).
"Conheça todas as teorias, domine todas as técnicas, mas, quando tocares uma alma humana, seja apenas outra alma humana." (C.G.Jung)
CP200 / CP500 / Basic / dBase III / dBase IV / Clipper Summer / RTlink / Exospace.
Clipper 5.3b / Blinker 7.0 / CDX com TAG
xHarbour 1.2.1-6604 / Borland C++ (5.5.1) 32 bit / HBmake.
Harbour 3.2.0dev (r1412121623) / MINGW / HBM2 / MiniGui HMG 3.1.4 / IDE (Roberto Lopez).
"Conheça todas as teorias, domine todas as técnicas, mas, quando tocares uma alma humana, seja apenas outra alma humana." (C.G.Jung)
-
rubens
- Colaborador
- Mensagens: 1520
- Registrado em: 16 Ago 2003 09:05
- Localização: Nova Xavantina - MT
harbour hb_funcPtr
Olá...
E como usar hasse... ?
Só salvar como errorsys.prg e compilar junto com o sistema ?
Obrigado
Rubens
E como usar hasse... ?
Só salvar como errorsys.prg e compilar junto com o sistema ?
Obrigado
Rubens
"Eu e minha casa servimos ao Senhor e você 
"
"-
Hasse
- Usuário Nível 4
- Mensagens: 820
- Registrado em: 19 Out 2004 10:30
- Localização: Jaraguá do Sul - SC
harbour hb_funcPtr
Basta incluir a chamada logo após o início....
e compilar. Só......... rsrsrsrs....
Código: Selecionar todos
FUNCTION MAIN()
*
LOCAL oERR := ERRORBLOCK( { | oERROR | ERRORLOG( oERROR ) } )Hasse
CP200 / CP500 / Basic / dBase III / dBase IV / Clipper Summer / RTlink / Exospace.
Clipper 5.3b / Blinker 7.0 / CDX com TAG
xHarbour 1.2.1-6604 / Borland C++ (5.5.1) 32 bit / HBmake.
Harbour 3.2.0dev (r1412121623) / MINGW / HBM2 / MiniGui HMG 3.1.4 / IDE (Roberto Lopez).
"Conheça todas as teorias, domine todas as técnicas, mas, quando tocares uma alma humana, seja apenas outra alma humana." (C.G.Jung)
CP200 / CP500 / Basic / dBase III / dBase IV / Clipper Summer / RTlink / Exospace.
Clipper 5.3b / Blinker 7.0 / CDX com TAG
xHarbour 1.2.1-6604 / Borland C++ (5.5.1) 32 bit / HBmake.
Harbour 3.2.0dev (r1412121623) / MINGW / HBM2 / MiniGui HMG 3.1.4 / IDE (Roberto Lopez).
"Conheça todas as teorias, domine todas as técnicas, mas, quando tocares uma alma humana, seja apenas outra alma humana." (C.G.Jung)
-
rubens
- Colaborador
- Mensagens: 1520
- Registrado em: 16 Ago 2003 09:05
- Localização: Nova Xavantina - MT
harbour hb_funcPtr
Bom dia...
Tá faltando a função descrerro()
Linha 117
Obrigado
Rubens
Tá faltando a função descrerro()
Linha 117
Obrigado
Rubens
"Eu e minha casa servimos ao Senhor e você "
"-
Hasse
- Usuário Nível 4
- Mensagens: 820
- Registrado em: 19 Out 2004 10:30
- Localização: Jaraguá do Sul - SC
harbour hb_funcPtr
Segue no Anexo.
Ainda não está funcionando a contento. Veja se te dá um tempo para arredondar esta função.
Ainda não está funcionando a contento. Veja se te dá um tempo para arredondar esta função.
- Anexos
-
DescrErro.prg- (7.11 KiB) Baixado 73 vezes
Hasse
CP200 / CP500 / Basic / dBase III / dBase IV / Clipper Summer / RTlink / Exospace.
Clipper 5.3b / Blinker 7.0 / CDX com TAG
xHarbour 1.2.1-6604 / Borland C++ (5.5.1) 32 bit / HBmake.
Harbour 3.2.0dev (r1412121623) / MINGW / HBM2 / MiniGui HMG 3.1.4 / IDE (Roberto Lopez).
"Conheça todas as teorias, domine todas as técnicas, mas, quando tocares uma alma humana, seja apenas outra alma humana." (C.G.Jung)
CP200 / CP500 / Basic / dBase III / dBase IV / Clipper Summer / RTlink / Exospace.
Clipper 5.3b / Blinker 7.0 / CDX com TAG
xHarbour 1.2.1-6604 / Borland C++ (5.5.1) 32 bit / HBmake.
Harbour 3.2.0dev (r1412121623) / MINGW / HBM2 / MiniGui HMG 3.1.4 / IDE (Roberto Lopez).
"Conheça todas as teorias, domine todas as técnicas, mas, quando tocares uma alma humana, seja apenas outra alma humana." (C.G.Jung)