Antonio,
I should have been thinking of my error handler, I'm not awake.
Here is the Error I get:
Error BASE/1081 Argument error: + Called from DOSTRING(4)
Not quite sure what to think. Any ideas?
Thanks
Dave
I modified my chbdll.bat and added the errorsys to it
here is the new chbdll.bat file
******************************************************************************************
REM Self contained Harbour DLL, original idea and research Antonio Linares
@ECHO OFF
CLS
IF A%1 == A GOTO :SINTAX
IF NOT EXIST %1.prg GOTO :NOEXIST
ECHO Compiling...
SET hdir=c:\harbour
SET bcdir=c:\bcc55
%hdir%\bin\harbour -n -w errorsys /i%hdir%\include
%bcdir%\bin\bcc32 -c -D__EXPORT__ -I%hdir%\include;%bcdir%\include errorsys.c
%hdir%\bin\harbour %1 /n /i%hdir%\include /w /p %2 %3 > clip.log
@type clip.log
IF ERRORLEVEL 1 PAUSE
IF ERRORLEVEL 1 GOTO EXIT
ECHO -O2 -I%hdir%\include;\harbour\include;%bcdir%\include;%bcdir%\lib %1.c > b32.bc
%bcdir%\bin\bcc32 -WDR -M -c @b32.bc
:ENDCOMPILE
IF EXIST %1.rc %bcdir%\bin\brc32 -r %1
ECHO %bcdir%\lib\c0w32.obj + > b32.bc
echo %1.obj+errorsys.obj+maindll.obj, + >> b32.bc
ECHO %1.dll, + >> b32.bc
ECHO %1.map, + >> b32.bc
ECHO %hdir%\lib\hbrtl.lib + >> b32.bc
ECHO %hdir%\lib\hbvm.lib + >> b32.bc
ECHO %hdir%\lib\gtwin.lib + >> b32.bc
ECHO %hdir%\lib\hblang.lib + >> b32.bc
ECHO %hdir%\lib\hbmacro.lib + >> b32.bc
ECHO %hdir%\lib\hbrdd.lib + >> b32.bc
ECHO %hdir%\lib\rddntx.lib + >> b32.bc
ECHO %hdir%\lib\rddcdx.lib + >> b32.bc
ECHO %hdir%\lib\hbdebug.lib + >> b32.bc
ECHO %hdir%\lib\hbcommon.lib + >> b32.bc
ECHO %hdir%\lib\hbpp.lib + >> b32.bc
ECHO %hdir%\lib\hbmzip.lib + >> b32.bc
ECHO %hdir%\lib\hbsix.lib + >> b32.bc
ECHO %hdir%\lib\rddfpt.lib + >> b32.bc
ECHO %bcdir%\lib\cw32.lib + >> b32.bc
ECHO %bcdir%\lib\import32.lib + >> b32.bc
ECHO %bcdir%\lib\psdk\odbc32.lib + >> b32.bc
ECHO %bcdir%\lib\uuid.lib + >> b32.bc
ECHO %bcdir%\lib\psdk\rasapi32.lib, >> b32.bc
IF EXIST %1.res ECHO %1.res >> b32.bc
%bcdir%\bin\ilink32 -Tpd -aa -s -L%bcdir%\lib -L%bcdir%\lib\PSDK @b32.bc
REM delete temporary files
@del %1.c
@del %1.il?
IF ERRORLEVEL 1 GOTO LINKERROR
ECHO * Self contained DLL successfully built
GOTO EXIT
ECHO
:LINKERROR
REM if exist meminfo.txt notepad meminfo.txt
REM PAUSE * Linking errors *
GOTO EXIT
:SINTAX
ECHO SYNTAX: Build [Program] {-- No especifiques la extensi«n PRG
ECHO {-- Don't specify .PRG extension
GOTO EXIT
:NOEXIST
ECHO The specified PRG %1 does not exist
:EXIT
********************************************************************************
Here is the errorsys.prg I am using:
********************************************************************************
/*
* $Id: errorsys.prg,v 1.2 2002/02/21 23:08:28 jgiraldo Exp $
*/
/*
* Harbour Project source code:
* The default error handler
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - <!-- m --><a class="postlink" href="http://www.harbour-project.org">http://www.harbour-project.org</a><!-- m -->
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site <!-- m --><a class="postlink" href="http://www.gnu.org/">http://www.gnu.org/</a><!-- m -->).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
#include "error.ch"
PROCEDURE ErrorSys
ErrorBlock( { | oError | DefError( oError ) } )
RETURN
STATIC FUNCTION DefError( oError )
LOCAL cMessage
LOCAL cDOSError
LOCAL aOptions
LOCAL nChoice
LOCAL n
// By default, division by zero results in zero
IF oError:genCode == EG_ZERODIV
RETURN 0
ENDIF
// Set NetErr() of there was a database open error
IF oError:genCode == EG_OPEN .AND. ;
oError:osCode == 32 .AND. ;
oError:canDefault
NetErr( .T. )
RETURN .F.
ENDIF
// Set NetErr() if there was a lock error on dbAppend()
IF oError:genCode == EG_APPENDLOCK .AND. ;
oError:canDefault
NetErr( .T. )
RETURN .F.
ENDIF
cMessage := ErrorMessage( oError )+Chr(13)
IF ! Empty( oError:osCode )
cDOSError := "(DOS Error " + LTrim( Str( oError:osCode ) ) + ")"
ENDIF
/* RETRY OPTIONS NOT AVAILABLE RIGHT NOW
COMMENTED OUT ONLY FOR DELPHI INTEGRATION
// Build buttons
aOptions := {}
// AAdd( aOptions, "Break" )
AAdd( aOptions, "Quit" )
IF oError:canRetry
AAdd( aOptions, "Retry" )
ENDIF
IF oError:canDefault
AAdd( aOptions, "Default" )
ENDIF
// Show alert box
nChoice := 0
WHILE nChoice == 0
IF Empty( oError:osCode )
nChoice := Alert( cMessage, aOptions )
ELSE
nChoice := Alert( cMessage + ";" + cDOSError, aOptions)
ENDIF
ENDDO
IF ! Empty( nChoice )
DO CASE
CASE aOptions[ nChoice ] == "Break"
Break( oError )
CASE aOptions[ nChoice ] == "Retry"
RETURN .T.
CASE aOptions[ nChoice ] == "Default"
RETURN .F.
ENDCASE
ENDIF
*/
// "Quit" selected
IF ! Empty( oError:osCode )
cMessage += " " + cDOSError+Chr(13)
ENDIF
n := 2
WHILE ! Empty( ProcName( n ) )
/* CHANGED */
cMessage += "Called from " + ProcName( n ) + ;
"(" + AllTrim( Str( ProcLine( n ) ) ) + ")"+Chr(13)
// QUESTION: from a DLL point of view, there is not main procedure,
// instead of that, something that is not a valid string is
// given, causing this errorsys routine to be re-entrant.
// This next line is a temporal workaround to this problem,
// and a specific code to this Harbour to Delphi integration.
If Upper(ProcName(n)) = 'MACROCALL'
Exit
EndIf
n++
ENDDO
memowrit("error.log",cmessage )
*** D('QUIT') // NOTE: A QUIT in a DLL is something not very smart, better to
// QUIT // let Delphi to end properly.
RETURN .F.
// [vszakats]
STATIC FUNCTION ErrorMessage( oError )
LOCAL cMessage
// start error message
cMessage := iif( oError:severity > ES_WARNING, "Error", "Warning" ) + " "
// add subsystem name if available
IF ISCHARACTER( oError:subsystem )
cMessage += oError:subsystem()
ELSE
cMessage += "???"
ENDIF
// add subsystem's error code if available
IF ISNUMBER( oError:subCode )
cMessage += "/" + LTrim( Str( oError:subCode ) )
ELSE
cMessage += "/???"
ENDIF
// add error description if available
IF ISCHARACTER( oError:description )
cMessage += " " + oError:description
ENDIF
// add either filename or operation
DO CASE
CASE !Empty( oError:filename )
cMessage += ": " + oError:filename
CASE !Empty( oError:operation )
cMessage += ": " + oError:operation
ENDCASE
RETURN cMessage
