How to implement PeekStr()

[FWExplorer]

Hi,

I've been struggling more than a week, with trying to a get a string from a pointer returned from a DLL.

I can't get a straight answer, in any of the forums. There doesn't seem to be a specific example that's relevant.


CallGoal is a Prolog function that returns a pointer to a string

Code: Select all  Expand view  RUN

Result_call := hb_DynCall( {"CallGoal", Lib_h, HB_DYN_CALLCONV_STDCALL}, Prolog_Id_n )

, but I can't figure out how to get the string from Result_call. It's been years since working with the C API, and I've tried some HB_FUNC code, but I'm nearly clueless.


The string itself, fyi, is in the form


XSYYYYNL
Where:
X = T means success, F means failure, E means an error occurred and I means a request for input
S = <space>
YYYY = four-digit query number (0000 is first query)
NL = new line (<ctrl-M><ctrl-J>)

Can anyone assist with this, by providing an actual example of a similar scenario?

[Antonio Linares]

Please let me know what you get doing:

? ValType( Result_call )

? Result_call

[FWExplorer]

Hi Antonio,

The ValType returns a "U". But in the debugger, it's interpreted as an "N", e.g. 7258044

Code: Select all  Expand view  RUN

Lib_h := hb_libLoad ("INT386W.DLL")


IF !Empty (Lib_h)

    ? "INT386W.DLL loaded!"

    Prolog_Id_n := hb_DynCall ( {"LoadProlog", Lib_h, HB_DYN_CALLCONV_STDCALL}, "", 0, 0, 0 )

    ? "Calling LoadProlog: " + Iif ( Prolog_Id_n > 0, "Succeeded!", "Failed!")

    // Result_lpstr := hb_DynCall( {"InitGoal", Lib_h, HB_DYN_CALLCONV_STDCALL}, Prolog_Id_n, "write('What the,...World?'). " )
    // Result_lpstr := hb_DynCall( {"InitGoal", Lib_h, HB_DYN_CALLCONV_STDCALL}, Prolog_Id_n, "consult(count). " )

    Result_init := hb_DynCall( {"InitGoal", Lib_h, HB_DYN_CALLCONV_STDCALL}, Prolog_Id_n, "member( brown, [the,quick,brown,fox] ). " )

    Result_call := hb_DynCall( {"CallGoal", Lib_h, HB_DYN_CALLCONV_STDCALL}, Prolog_Id_n )

    ResultCall_Type = ValType( Result_n )
    ? "Result_call Type: "
    ?? ResultCall_Type
    Wait
 

Please let me know what you get doing:

? ValType( Result_call )

? Result_call

[carlos vargas]

Antonio
in harbour_mod exist the funcion PtrToStr, Pointer To String.

I think it would be logical to include that code in harbour directly

Code: Select all  Expand view  RUN

/*
**  pointers.c -- Pointers high level management module
**
** (c) FiveTech Software SL, 2019-2020
** Developed by Antonio Linares alinares@fivetechsoft.com
** MIT license https://github.com/FiveTechSoft/mod_har ... er/LICENSE
*/

#include <hbapi.h>

//----------------------------------------------------------------//

HB_FUNC( PTRTOSTR )
{
   #ifdef HB_ARCH_32BIT
      const char * * pStrs = ( const char * * ) hb_parnl( 1 );  
   #else
      const char * * pStrs = ( const char * * ) hb_parnll( 1 );  
   #endif

   hb_retc( * ( pStrs + hb_parnl( 2 ) ) );
}

//----------------------------------------------------------------//

HB_FUNC( PTRTOUI )
{
   #ifdef HB_ARCH_32BIT
      unsigned int * pNums = ( unsigned int * ) hb_parnl( 1 );  
   #else
      unsigned int * pNums = ( unsigned int * ) hb_parnll( 1 );  
   #endif

   hb_retnl( * ( pNums + hb_parnl( 2 ) ) );
}

//----------------------------------------------------------------//

[FWExplorer]

Thanks Antonio,

This is exactly what I was looking for.


Unfortunately, the program closes while in the middle of executing

Code: Select all  Expand view  RUN

Result_lpstr := PtrToStr( Result_call, 8 )

, but at least this is a start.


I can't locate the docs on this function. What is that second parameter? Is it the expected length of the string?


By the way, I sent you an email earlier today, about renewing my FTDN subscription.



Regards,

[carlos vargas]

umm,
HB_ARCH_32BIT

I don't remember if this constant exists in harbour, you can do the test with only that part of the code, avoiding the part for 64 bits.

Code: Select all  Expand view  RUN

HB_FUNC( PTRTOSTR )
{
   const char * * pStrs = ( const char * * ) hb_parnl( 1 );  

   hb_retc( * ( pStrs + hb_parnl( 2 ) ) );
}
 

this a example use for harbour_mod.
to work with only harbour, some adjustments would have to be made

Code: Select all  Expand view  RUN

#ifdef __PLATFORM__WINDOWS
   #include "c:\harbour\include\hbdyn.ch"
#else
   #include "/usr/include/harbour/hbdyn.ch"
#endif

#define HB_VERSION_BITWIDTH  17
#define NULL 0        

static pLib, hMySQL := 0, hConnection := 0, hMyRes := 0

//----------------------------------------------------------------//

function Main()

   local nRetVal, n, m, hField, hRow

   // ShowConsole()
   // SetMode( 40, 120 )
   
   pLib = hb_LibLoad( hb_SysMySQL() )

   ?? "pLib = " + ValType( pLib ) + ;
      If( ValType( pLib ) == "P", " (MySQL library properly loaded)", " (MySQL library not found)" )

   if ValType( pLib ) == "P"
      hMySQL = mysql_init()
      ? "hMySQL = " + Str( hMySQL ) + " (MySQL library " + ;
      If( hMySQL != 0, "properly initalized)", "failed to initialize)" )
   endif      
         
   ? If( hMySQL != 0, "MySQL version: " + mysql_get_server_info( hMySQL ), "" )  

   if hMySQL != 0
      ? "Connection = "
      ?? hConnection := mysql_real_connect( "localhost", "harbour", "password", "dbHarbour", 3306 )
      ?? If( hConnection != hMySQL, " (Failed connection)", " (Successfull connection)" )
      ?  If( hConnection != hMySQL, "Error: " + mysql_error( hMySQL ), "" )
   endif
   
   if hConnection != 0
      nRetVal = mysql_query( hConnection, "select * from users" )
      ? "MySQL query " + If( nRetVal == 0, "succeeded", "failed" )
      if nRetVal != 0
         ? "error: " + Str( nRetVal )
      endif
   endif  
   
   if hConnection != 0
      hMyRes = mysql_store_result( hConnection )
      ? "MySQL store result " + If( hMyRes != 0, "succeeded", "failed" )
      ?
   endif  
   
   if hMyRes != 0
      ? "Number of rows: " + Str( mysql_num_rows( hMyRes ) )
   endif  
   
   if hMyRes != 0
      ? "Number of fields: " + Str( mysql_num_fields( hMyRes ) )
      ? "<table border=1 cellspacing=0>"
      ?? "<tr>"
      for n = 1 to mysql_num_fields( hMyRes )
         hField = mysql_fetch_field( hMyRes )
         if hField != 0
            ?? "<td>" + PtrToStr( hField, 0 ) + "</td>"
         endif  
      next
      ?? "</tr>"
      for n = 1 to mysql_num_rows( hMyRes )
         if ( hRow := mysql_fetch_row( hMyRes ) ) != 0
            ?? "<tr>"
               for m = 1 to mysql_num_fields( hMyRes )
                  ?? "<td>" + PtrToStr( hRow, m - 1 ) + "</td>"
               next
            ?? "</tr>"
         endif
      next  
      ?? "</table>"      
   endif  

   if hMyRes != 0
      mysql_free_result( hMyRes )
   endif

   if hMySQL != 0
      mysql_close( hMySQL )
   endif  
   
   if ValType( pLib ) == "P"
      ? "MySQL library properly freed: ", HB_LibFree( pLib )
   endif                          

return nil

//----------------------------------------------------------------//

function mysql_init()

return hb_DynCall( { "mysql_init", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ) }, NULL )

//----------------------------------------------------------------//

function mysql_close( hMySQL )

return hb_DynCall( { "mysql_close", pLib,;
                   hb_SysCallConv(), hb_SysLong() }, hMySQL )

//----------------------------------------------------------------//

function mysql_real_connect( cServer, cUserName, cPassword, cDataBaseName, nPort )

   if nPort == nil
      nPort = 3306
   endif  

return hb_DynCall( { "mysql_real_connect", pLib, hb_bitOr( hb_SysLong(),;
                     hb_SysCallConv() ), hb_SysLong(),;
                     HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR,;
                     HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG },;
                     hMySQL, cServer, cUserName, cPassword, cDataBaseName, nPort, 0, 0 )
                     
//----------------------------------------------------------------//

function mysql_query( hConnect, cQuery )

return hb_DynCall( { "mysql_query", pLib, hb_bitOr( HB_DYN_CTYPE_INT,;
                   hb_SysCallConv() ), hb_SysLong(), HB_DYN_CTYPE_CHAR_PTR },;
                   hConnect, cQuery )

//----------------------------------------------------------------//

function mysql_use_result( hMySQL )

return hb_DynCall( { "mysql_use_result", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ), hb_SysLong() }, hMySQL )

//----------------------------------------------------------------//

function mysql_store_result( hMySQL )

return hb_DynCall( { "mysql_store_result", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ), hb_SysLong() }, hMySQL )

//----------------------------------------------------------------//

function mysql_free_result( hMyRes)

return hb_DynCall( { "mysql_free_result", pLib,;
                   hb_SysCallConv(), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_fetch_row( hMyRes )

return hb_DynCall( { "mysql_fetch_row", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_num_rows( hMyRes )

return hb_DynCall( { "mysql_num_rows", pLib, hb_bitOr( hb_SysLong(),;
                  hb_SysCallConv() ), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_num_fields( hMyRes )

return hb_DynCall( { "mysql_num_fields", pLib, hb_bitOr( HB_DYN_CTYPE_LONG_UNSIGNED,;
                   hb_SysCallConv() ), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_fetch_field( hMyRes )

return hb_DynCall( { "mysql_fetch_field", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_get_server_info( hMySQL )

return hb_DynCall( { "mysql_get_server_info", pLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR,;
                   hb_SysCallConv() ), hb_SysLong() }, hMySql )

//----------------------------------------------------------------//

function mysql_error( hMySQL )

return hb_DynCall( { "mysql_error", pLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR,;
                   hb_SysCallConv() ), hb_SysLong() }, hMySql )

//----------------------------------------------------------------//

function hb_SysLong()

return If( hb_OSIS64BIT(), HB_DYN_CTYPE_LLONG_UNSIGNED, HB_DYN_CTYPE_LONG_UNSIGNED )  

//----------------------------------------------------------------//

function hb_SysCallConv()

return If( ! "Windows" $ OS(), HB_DYN_CALLCONV_CDECL, HB_DYN_CALLCONV_STDCALL )

//----------------------------------------------------------------//
   
function hb_SysMySQL()

   local cLibName

   if ! "Windows" $ OS()
      if "Darwin" $ OS()
         cLibName = "/usr/local/Cellar/mysql/8.0.16/lib/libmysqlclient.dylib"
      else  
         cLibName = If( hb_version( HB_VERSION_BITWIDTH ) == 64,;
                        "/usr/lib/x86_64-linux-gnu/libmariadb.so.3",; // libmysqlclient.so.20 for mariaDB
                        "/usr/lib/x86-linux-gnu/libmariadbclient.so" )
      endif                  
   else
      cLibName = If( hb_version( HB_VERSION_BITWIDTH ) == 64,;
                     "c:/Apache24/htdocs/libmysql64.dll",;
                     "c:/Apache24/htdocs/libmysql.dll" )
   endif

return cLibName    

//----------------------------------------------------------------//
 

[FWExplorer]

Thanks Carlos,

I still don't understand what the second parameter is, but I tried both 0 and 1, and the application immediately exits.

HB_ARCH_32BIT is defined in hbdefs.h, in this section

Code: Select all  Expand view  RUN

#if defined( HB_OS_WIN_64 )
#  define HB_ARCH_64BIT
#elif ULONG_MAX > UINT_MAX && UINT_MAX > USHRT_MAX
#  define HB_ARCH_64BIT
#elif ULONG_MAX == UINT_MAX && UINT_MAX > USHRT_MAX
#  define HB_ARCH_32BIT
#elif ULONG_MAX > UINT_MAX && UINT_MAX == USHRT_MAX
#  define HB_ARCH_16BIT
#endif
 

But the application still exits, during the StrToPtr call, after including hbdefs and using 0 or 1 as the second parameter.

I don't believe this is something that you or Antonio can assist with. I'll break for a few days, and look at it fresh near the end of the week.


Thanks,

umm,
HB_ARCH_32BIT

I don't remember if this constant exists in harbour, you can do the test with only that part of the code, avoiding the part for 64 bits.

Code: Select all  Expand view  RUN

HB_FUNC( PTRTOSTR )
{
   const char * * pStrs = ( const char * * ) hb_parnl( 1 );  

   hb_retc( * ( pStrs + hb_parnl( 2 ) ) );
}
 

this a example use for harbour_mod.
to work with only harbour, some adjustments would have to be made

Code: Select all  Expand view  RUN

#ifdef __PLATFORM__WINDOWS
   #include "c:\harbour\include\hbdyn.ch"
#else
   #include "/usr/include/harbour/hbdyn.ch"
#endif

#define HB_VERSION_BITWIDTH  17
#define NULL 0        

static pLib, hMySQL := 0, hConnection := 0, hMyRes := 0

//----------------------------------------------------------------//

function Main()

   local nRetVal, n, m, hField, hRow

   // ShowConsole()
   // SetMode( 40, 120 )
   
   pLib = hb_LibLoad( hb_SysMySQL() )

   ?? "pLib = " + ValType( pLib ) + ;
      If( ValType( pLib ) == "P", " (MySQL library properly loaded)", " (MySQL library not found)" )

   if ValType( pLib ) == "P"
      hMySQL = mysql_init()
      ? "hMySQL = " + Str( hMySQL ) + " (MySQL library " + ;
      If( hMySQL != 0, "properly initalized)", "failed to initialize)" )
   endif      
         
   ? If( hMySQL != 0, "MySQL version: " + mysql_get_server_info( hMySQL ), "" )  

   if hMySQL != 0
      ? "Connection = "
      ?? hConnection := mysql_real_connect( "localhost", "harbour", "password", "dbHarbour", 3306 )
      ?? If( hConnection != hMySQL, " (Failed connection)", " (Successfull connection)" )
      ?  If( hConnection != hMySQL, "Error: " + mysql_error( hMySQL ), "" )
   endif
   
   if hConnection != 0
      nRetVal = mysql_query( hConnection, "select * from users" )
      ? "MySQL query " + If( nRetVal == 0, "succeeded", "failed" )
      if nRetVal != 0
         ? "error: " + Str( nRetVal )
      endif
   endif  
   
   if hConnection != 0
      hMyRes = mysql_store_result( hConnection )
      ? "MySQL store result " + If( hMyRes != 0, "succeeded", "failed" )
      ?
   endif  
   
   if hMyRes != 0
      ? "Number of rows: " + Str( mysql_num_rows( hMyRes ) )
   endif  
   
   if hMyRes != 0
      ? "Number of fields: " + Str( mysql_num_fields( hMyRes ) )
      ? "<table border=1 cellspacing=0>"
      ?? "<tr>"
      for n = 1 to mysql_num_fields( hMyRes )
         hField = mysql_fetch_field( hMyRes )
         if hField != 0
            ?? "<td>" + PtrToStr( hField, 0 ) + "</td>"
         endif  
      next
      ?? "</tr>"
      for n = 1 to mysql_num_rows( hMyRes )
         if ( hRow := mysql_fetch_row( hMyRes ) ) != 0
            ?? "<tr>"
               for m = 1 to mysql_num_fields( hMyRes )
                  ?? "<td>" + PtrToStr( hRow, m - 1 ) + "</td>"
               next
            ?? "</tr>"
         endif
      next  
      ?? "</table>"      
   endif  

   if hMyRes != 0
      mysql_free_result( hMyRes )
   endif

   if hMySQL != 0
      mysql_close( hMySQL )
   endif  
   
   if ValType( pLib ) == "P"
      ? "MySQL library properly freed: ", HB_LibFree( pLib )
   endif                          

return nil

//----------------------------------------------------------------//

function mysql_init()

return hb_DynCall( { "mysql_init", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ) }, NULL )

//----------------------------------------------------------------//

function mysql_close( hMySQL )

return hb_DynCall( { "mysql_close", pLib,;
                   hb_SysCallConv(), hb_SysLong() }, hMySQL )

//----------------------------------------------------------------//

function mysql_real_connect( cServer, cUserName, cPassword, cDataBaseName, nPort )

   if nPort == nil
      nPort = 3306
   endif  

return hb_DynCall( { "mysql_real_connect", pLib, hb_bitOr( hb_SysLong(),;
                     hb_SysCallConv() ), hb_SysLong(),;
                     HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR,;
                     HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG },;
                     hMySQL, cServer, cUserName, cPassword, cDataBaseName, nPort, 0, 0 )
                     
//----------------------------------------------------------------//

function mysql_query( hConnect, cQuery )

return hb_DynCall( { "mysql_query", pLib, hb_bitOr( HB_DYN_CTYPE_INT,;
                   hb_SysCallConv() ), hb_SysLong(), HB_DYN_CTYPE_CHAR_PTR },;
                   hConnect, cQuery )

//----------------------------------------------------------------//

function mysql_use_result( hMySQL )

return hb_DynCall( { "mysql_use_result", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ), hb_SysLong() }, hMySQL )

//----------------------------------------------------------------//

function mysql_store_result( hMySQL )

return hb_DynCall( { "mysql_store_result", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ), hb_SysLong() }, hMySQL )

//----------------------------------------------------------------//

function mysql_free_result( hMyRes)

return hb_DynCall( { "mysql_free_result", pLib,;
                   hb_SysCallConv(), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_fetch_row( hMyRes )

return hb_DynCall( { "mysql_fetch_row", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_num_rows( hMyRes )

return hb_DynCall( { "mysql_num_rows", pLib, hb_bitOr( hb_SysLong(),;
                  hb_SysCallConv() ), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_num_fields( hMyRes )

return hb_DynCall( { "mysql_num_fields", pLib, hb_bitOr( HB_DYN_CTYPE_LONG_UNSIGNED,;
                   hb_SysCallConv() ), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_fetch_field( hMyRes )

return hb_DynCall( { "mysql_fetch_field", pLib, hb_bitOr( hb_SysLong(),;
                   hb_SysCallConv() ), hb_SysLong() }, hMyRes )

//----------------------------------------------------------------//

function mysql_get_server_info( hMySQL )

return hb_DynCall( { "mysql_get_server_info", pLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR,;
                   hb_SysCallConv() ), hb_SysLong() }, hMySql )

//----------------------------------------------------------------//

function mysql_error( hMySQL )

return hb_DynCall( { "mysql_error", pLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR,;
                   hb_SysCallConv() ), hb_SysLong() }, hMySql )

//----------------------------------------------------------------//

function hb_SysLong()

return If( hb_OSIS64BIT(), HB_DYN_CTYPE_LLONG_UNSIGNED, HB_DYN_CTYPE_LONG_UNSIGNED )  

//----------------------------------------------------------------//

function hb_SysCallConv()

return If( ! "Windows" $ OS(), HB_DYN_CALLCONV_CDECL, HB_DYN_CALLCONV_STDCALL )

//----------------------------------------------------------------//
   
function hb_SysMySQL()

   local cLibName

   if ! "Windows" $ OS()
      if "Darwin" $ OS()
         cLibName = "/usr/local/Cellar/mysql/8.0.16/lib/libmysqlclient.dylib"
      else  
         cLibName = If( hb_version( HB_VERSION_BITWIDTH ) == 64,;
                        "/usr/lib/x86_64-linux-gnu/libmariadb.so.3",; // libmysqlclient.so.20 for mariaDB
                        "/usr/lib/x86-linux-gnu/libmariadbclient.so" )
      endif                  
   else
      cLibName = If( hb_version( HB_VERSION_BITWIDTH ) == 64,;
                     "c:/Apache24/htdocs/libmysql64.dll",;
                     "c:/Apache24/htdocs/libmysql.dll" )
   endif

return cLibName    

//----------------------------------------------------------------//
 

[Antonio Linares]

> By the way, I sent you an email earlier today, about renewing my FTDN subscription.

I haven't received it. Please email it again to both alinares@fivetechsoft.com and antonio.fivetech@gmail.com

Please email me the DLL and I will implement it Is it win-prolog ?

[FWExplorer]

You're right. You didn't receive it, because I accidentally sent it, and CCd it, to myself.

Re-sent, thanks Antonio.

Yes, it's Win/LPA-Prolog. I forwarded the DLLs & auxiliary files.

Edit: Got an UnDelivered Mail, probably because of a zip file attachment, from antonio.fivetech@gmail.com.

If you didn't receive it at alinares@fivetechsoft.com, let me know. I'll put the zip file on my website.

> By the way, I sent you an email earlier today, about renewing my FTDN subscription.

I haven't received it. Please email it again to both alinares@fivetechsoft.com and antonio.fivetech@gmail.com

Please email me the DLL and I will implement it Is it win-prolog ?

[Antonio Linares]

Dear D.,

Here it is the WinProlog API properly working:

to build it use this go.bat

Code: Select all  Expand view  RUN

set path=c:\bcc7\bin
c:\harbour\bin\win\bcc\hbmk2 -n winprolog.prg
winprolog

winprolog.prg

Code: Select all  Expand view  RUN

#include "hbdyn.ch"

static hLib

//----------------------------------------------------------------//

function Main()

   local nId, nRetCode

   hLib = hb_libLoad( "INT386W.DLL" )

   if ! Empty( hLib )
      ? "INT386W.DLL loaded!"

      nId = LoadProlog()
      ? "Calling LoadProlog: " + If( nId > 0, "Succeeded!", "Failed!" )

      ? InitGoal( nId, "write('Hello World'). " )
      ? CallGoal( nId )

      ? InitGoal( nId, "input( `Please tell me your name`, Name ). " )
      ? CallGoal( nId )
      ? TellGoal( nId, "brian. " )

      ? InitGoal( nId, "write('What the,...World?'). " )
      ? CallGoal( nId )

      ? InitGoal( nId, "member( brown, [the,quick,brown,fox] ). " )
      ? CallGoal( nId )
      ? ExitGoal( nId )

      ? HaltProlog( nId )

      hb_libFree( hLib )
   endif

return nil

//----------------------------------------------------------------//

function LoadProlog( cCommandLine, nBufferSize, nEncryption, nTickle )

   hb_default( @cCommandLine, "" )
   hb_default( @nBufferSize, 0 )
   hb_default( @nEncryption, 0 )
   hb_default( @nTickle, 0 )

return hb_DynCall( { "LoadProlog", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_LONG ),;
                   HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG },;
                   cCommandLine, nBufferSize, nEncryption, nTickle )    

//----------------------------------------------------------------//

function InitGoal( nId, cGoal )

return hb_DynCall( { "InitGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_CHAR_PTR ),;
                   HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_CHAR_PTR }, nId, cGoal )    

//----------------------------------------------------------------//

function CallGoal( nId )

return hb_DynCall( { "CallGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_CHAR_PTR ),;
                   HB_DYN_CTYPE_LONG }, nId )    

//----------------------------------------------------------------//

function TellGoal( nId, cGoal )

return hb_DynCall( { "TellGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_CHAR_PTR ),;
                   HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_CHAR_PTR }, nId, cGoal )    

//----------------------------------------------------------------//

function ExitGoal( nId )

return hb_DynCall( { "ExitGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_BOOL ),;
                    HB_DYN_CTYPE_LONG }, nId )                      

//----------------------------------------------------------------//

function HaltProlog( nId )

return hb_DynCall( { "HaltProlog", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_BOOL ),;
                    HB_DYN_CTYPE_LONG }, nId )                      

//----------------------------------------------------------------//

function CallOneGoal( nId, cGoal )

   local cResult := InitGoal( nId, cGoal ) + CallGoal( nId, cGoal )
 
   ExitGoal( nId )

return cResult    

//----------------------------------------------------------------//

output

INT386W.DLL loaded!
Calling LoadProlog: Succeeded!
G 0000

T 0000
Hello World
G 0001

I 0001
Please tell me your name
T 0001

G 0002

T 0002
What the,...World?
G 0003

T 0003

.T.
.T.

[FWExplorer]

Wow, I can't believe it. I wasn't expecting this level of completeness, just a few tips on getting the query string.

Thanks, chief.

Dear Dwayne,

Here it is the WinProlog API properly working:

to build it use this go.bat

Code: Select all  Expand view  RUN

set path=c:\bcc7\bin
c:\harbour\bin\win\bcc\hbmk2 -n dwayne.prg
dwayne

dwayne.prg

Code: Select all  Expand view  RUN

#include "hbdyn.ch"

static hLib

//----------------------------------------------------------------//

function Main()

   local nId, nRetCode

   hLib = hb_libLoad( "INT386W.DLL" )

   if ! Empty( hLib )
      ? "INT386W.DLL loaded!"

      nId = LoadProlog()
      ? "Calling LoadProlog: " + If( nId > 0, "Succeeded!", "Failed!" )

      ? InitGoal( nId, "write('Hello World'). " )
      ? CallGoal( nId )

      ? InitGoal( nId, "input( `Please tell me your name`, Name ). " )
      ? CallGoal( nId )
      ? TellGoal( nId, "brian. " )

      ? InitGoal( nId, "write('What the,...World?'). " )
      ? CallGoal( nId )

      ? InitGoal( nId, "member( brown, [the,quick,brown,fox] ). " )
      ? CallGoal( nId )
      ? ExitGoal( nId )

      ? HaltProlog( nId )

      hb_libFree( hLib )
   endif

return nil

//----------------------------------------------------------------//

function LoadProlog( cCommandLine, nBufferSize, nEncryption, nTickle )

   hb_default( @cCommandLine, "" )
   hb_default( @nBufferSize, 0 )
   hb_default( @nEncryption, 0 )
   hb_default( @nTickle, 0 )

return hb_DynCall( { "LoadProlog", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_LONG ),;
                   HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG },;
                   cCommandLine, nBufferSize, nEncryption, nTickle )    

//----------------------------------------------------------------//

function InitGoal( nId, cGoal )

return hb_DynCall( { "InitGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_CHAR_PTR ),;
                   HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_CHAR_PTR }, nId, cGoal )    

//----------------------------------------------------------------//

function CallGoal( nId )

return hb_DynCall( { "CallGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_CHAR_PTR ),;
                   HB_DYN_CTYPE_LONG }, nId )    

//----------------------------------------------------------------//

function TellGoal( nId, cGoal )

return hb_DynCall( { "TellGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_CHAR_PTR ),;
                   HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_CHAR_PTR }, nId, cGoal )    

//----------------------------------------------------------------//

function ExitGoal( nId )

return hb_DynCall( { "ExitGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_BOOL ),;
                    HB_DYN_CTYPE_LONG }, nId )                      

//----------------------------------------------------------------//

function HaltProlog( nId )

return hb_DynCall( { "HaltProlog", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_BOOL ),;
                    HB_DYN_CTYPE_LONG }, nId )                      

//----------------------------------------------------------------//

function CallOneGoal( nId, cGoal )

   local cResult := InitGoal( nId, cGoal ) + CallGoal( nId, cGoal )
 
   ExitGoal( nId )

return cResult    

//----------------------------------------------------------------//

output

INT386W.DLL loaded!
Calling LoadProlog: Succeeded!
G 0000

T 0000
Hello World
G 0001

I 0001
Please tell me your name
T 0001

G 0002

T 0002
What the,...World?
G 0003

T 0003

.T.
.T.

[FWExplorer]

If anyone doing prolog and following this, keep in mind that you'll need a write statement (there are alternatives to this), in order to assign the current value of the resolution of X to a Harbour variable.

So if you wanted to get a list of all the members of a list, you would do this:

Code: Select all  Expand view  RUN

? InitGoal( Prolog_Id_n, "member( X, [the,quick,brown,fox] ), write( X ) . " )
Result_s := CallGoal( Prolog_Id_n )
 

, and the first such call would return something like

"T 0000\r\nthe"

, and you would take a substring to bypass the status part, and retrieve "the".

Wow, I can't believe it. I wasn't expecting this level of completeness, just a few tips on getting the query string.

Thanks, chief.

Dear Dwayne,

Here it is the WinProlog API properly working:

to build it use this go.bat

Code: Select all  Expand view  RUN

set path=c:\bcc7\bin
c:\harbour\bin\win\bcc\hbmk2 -n dwayne.prg
dwayne

dwayne.prg

Code: Select all  Expand view  RUN

#include "hbdyn.ch"

static hLib

//----------------------------------------------------------------//

function Main()

   local nId, nRetCode

   hLib = hb_libLoad( "INT386W.DLL" )

   if ! Empty( hLib )
      ? "INT386W.DLL loaded!"

      nId = LoadProlog()
      ? "Calling LoadProlog: " + If( nId > 0, "Succeeded!", "Failed!" )

      ? InitGoal( nId, "write('Hello World'). " )
      ? CallGoal( nId )

      ? InitGoal( nId, "input( `Please tell me your name`, Name ). " )
      ? CallGoal( nId )
      ? TellGoal( nId, "brian. " )

      ? InitGoal( nId, "write('What the,...World?'). " )
      ? CallGoal( nId )

      ? InitGoal( nId, "member( brown, [the,quick,brown,fox] ). " )
      ? CallGoal( nId )
      ? ExitGoal( nId )

      ? HaltProlog( nId )

      hb_libFree( hLib )
   endif

return nil

//----------------------------------------------------------------//

function LoadProlog( cCommandLine, nBufferSize, nEncryption, nTickle )

   hb_default( @cCommandLine, "" )
   hb_default( @nBufferSize, 0 )
   hb_default( @nEncryption, 0 )
   hb_default( @nTickle, 0 )

return hb_DynCall( { "LoadProlog", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_LONG ),;
                   HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG },;
                   cCommandLine, nBufferSize, nEncryption, nTickle )    

//----------------------------------------------------------------//

function InitGoal( nId, cGoal )

return hb_DynCall( { "InitGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_CHAR_PTR ),;
                   HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_CHAR_PTR }, nId, cGoal )    

//----------------------------------------------------------------//

function CallGoal( nId )

return hb_DynCall( { "CallGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_CHAR_PTR ),;
                   HB_DYN_CTYPE_LONG }, nId )    

//----------------------------------------------------------------//

function TellGoal( nId, cGoal )

return hb_DynCall( { "TellGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_CHAR_PTR ),;
                   HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_CHAR_PTR }, nId, cGoal )    

//----------------------------------------------------------------//

function ExitGoal( nId )

return hb_DynCall( { "ExitGoal", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_BOOL ),;
                    HB_DYN_CTYPE_LONG }, nId )                      

//----------------------------------------------------------------//

function HaltProlog( nId )

return hb_DynCall( { "HaltProlog", hLib, hb_bitOr( HB_DYN_CALLCONV_STDCALL, HB_DYN_CTYPE_BOOL ),;
                    HB_DYN_CTYPE_LONG }, nId )                      

//----------------------------------------------------------------//

function CallOneGoal( nId, cGoal )

   local cResult := InitGoal( nId, cGoal ) + CallGoal( nId, cGoal )
 
   ExitGoal( nId )

return cResult    

//----------------------------------------------------------------//

output

INT386W.DLL loaded!
Calling LoadProlog: Succeeded!
G 0000

T 0000
Hello World
G 0001

I 0001
Please tell me your name
T 0001

G 0002

T 0002
What the,...World?
G 0003

T 0003

.T.
.T.

[Antonio Linares]

https://www.swi-prolog.org/

[joseluispalma]

Hi,

And what can be used for?

[FWExplorer]

Been there, done that. Nothing wrong with SWI, it's a standard and has lots of support & sample applications.

But I like the LPA debugger, and their nearly instant customer service.

But also, their 16 bit/32 extended Dos version has the codebase as the 32 & 64 Win versions. So you can literally test & develop prolog code on your android tablet in iDosBox on your recliner at night ; and run it in Windows the next day.

I've tried others, as well. Visual Prolog was nice, with typed variables, like their predecessors Turbo & PDA Prolog. But a couple of versions into Windows, and they decided to implement OOP, in a very messy & inconvenient way.

LPA is comfortable & easy, and the documention is well-written.

https://www.swi-prolog.org/