Retorno de chamada DLL

[Ari]

Querido

Estoy creando llamadas a funciones mysql mediante el comando:

(Tengo otras razones importantes para hacerlo, sé sobre TDolphin, pero no puedo usarlo).

Estos a continuación están funcionando bien.

Code: Select all  Expand view  RUN

* =============================================================================
DLL FUNCTION mysql_init( mysql AS LONG ) AS LONG PASCAL   FROM "mysql_init"   LIB hLibMySQL // ok
* =============================================================================

DLL FUNCTION mysql_real_connect( mysql       AS LONG   ,;
                                 host        AS LPSTR  ,;
                                 user        AS LPSTR  ,;
                                 passwd      AS LPSTR  ,;
                                 db          AS LPSTR  ,;
                                 port        AS _INT   ,;
                                 unix_socket AS _INT   ,;[b][/b]
                                 client_flag AS _INT  ) AS BOOL PASCAL        ;
    FROM "mysql_real_connect"                                     LIB hLibMySQL // ok
* =============================================================================

DLL FUNCTION mysql_query( mysql AS LONG, cQuery AS LPSTR ) AS _INT PASCAL   FROM "mysql_query"   LIB hLibMySQL // ok
* =============================================================================
 

Estas otras funciones no funcionan generan GPF porque el tipo de retorno no es correcto:

Code: Select all  Expand view  RUN

DLL FUNCTION mysql_fetch_row( mysql AS LONG ) AS LPSTR PASCAL                 ;
    FROM "mysql_fetch_row"                                       LIB hLibMySQL // MYSQL_ROW
* =============================================================================

DLL FUNCTION mysql_list_dbs( mysql AS LONG, const AS LPSTR ) AS PTR PASCAL  ;
    FROM "mysql_list_dbs"                                         LIB hLibMySQL // MYSQL_RES

DLL FUNCTION mysql_fetch_field( result AS LONG ) AS LPSTR PASCAL              ;
    FROM "mysql_fetch_field"                                    LIB hLibMySQL // MYSQL_FIELD
 

en el comando return Tengo algunos tipos, los probé todos sin éxito

Code: Select all  Expand view  RUN

#ifndef _C_TYPES
   #define _C_TYPES
   #define VOID     0
   #define BYTE     1
   #define CHAR     2
   #define WORD     3
   #define BOOL     5
   #define HDC      6
   #define LONG     7
   #define _INT     7
   #define STRING   8
   #define LPSTR    9
   #define PTR     10
   #define _DOUBLE 11         // conflicts with BORDER DOUBLE
   #define DWORD   12
#endif
 

¿Quieres la ayuda de los maestros para resolver esto?

Ari
Brasil

[carlos vargas]

de los ejemplos de mysql de mod_harbour

Code: Select all  Expand view  RUN

#include "hbdyn.ch"
#include "common.ch"

#define MYSQL_CLIENTLIB "libmysql.dll"
//#define MYSQL_CLIENTLIB "/usr/lib/x86_64-linux-gnu/libmysqlclient.so.20"

#define CRLF hb_OsNewLine()

STATIC pLib

function Main()
 local hMySql, hMyRes
 local nErr, cErr
 local nResStatus
 local cSql
 local nRows, nFields

 cSql := "SELECT num_roc, fecha, cliente FROM roc"

 setmode(25,80)
 cls
 
 hMySql := mysql_real_connect( "192.168.10.10", "myusuario", "myclave123", "mybasededatos", 3306, 0 )

 ?"pLib =", pLib, MyType( pLib )
 ?"hMySql =", hb_ntos( hMySql ), MyType( hMySql )

 IF mysql_errno( hMySql ) ==  0

  ?"Version: " + mysql_get_server_info( hMySql )
  ?"Sql: " + cSql
 
  nResStatus := mysql_real_query( hMySql, cSql )
 
  IF nResStatus == 0
   hMyRes := mysql_store_result( hMySql )
   
   ?"hMyRes= ", hb_ntos( hMyRes ), MyType( hMyRes )
   
   nRows := mysql_num_rows( hMyRes )
   nFields := mysql_num_fields( hMyRes )
   
   ?"Rows: ", hb_ntos( nRows ), MyType( nRows )
   ?"Fields: ", hb_ntos( nFields ), MyType( nFields )
   
   ?"-----------------------"
   ?mysql_fetch_field( hMyRes )
   
  ELSE
   ?"ErrNo: ", hb_ntos( mysql_errno( hMySql ) ), "Error: ", mysql_error( hMySql )  
  ENDIF
 
 ELSE
    ?"ErrNo: ", hb_ntos( mysql_errno( hMySql ) ), "Error: ", mysql_error( hMySql )
 ENDIF
 
 mysql_close( hMySql )
 
 hb_LibFree( pLib )
 
return nil

/*------------------------------------------------------------*/

function MyType( v )
return "[" + valtype( v ) + "]"

/*------------------------------------------------------------*/

function mysql_real_connect( cHost, cUser, cPass, cDatabase, nPort, nFlag )
 local hMySql
 
 pLib := hb_LibLoad( MYSQL_CLIENTLIB )
 
 hMySql := hb_DynCall( { "mysql_init", pLib, HB_DYN_CALLCONV_CDECL }, NIL )
 
 if !empty( hMySql )
  hb_DynCall( { "mysql_real_connect", pLib, HB_DYN_CALLCONV_CDECL, ;
              HB_DYN_CTYPE_LONG_UNSIGNED, ; /*MYSQL* connection handler*/
              HB_DYN_CTYPE_CHAR_PTR     , ; /*const char *host*/
              HB_DYN_CTYPE_CHAR_PTR     , ; /*const char *user*/
              HB_DYN_CTYPE_CHAR_PTR     , ; /*const char *passwd*/
              HB_DYN_CTYPE_CHAR_PTR     , ; /*const char *db*/
              HB_DYN_CTYPE_LONG         , ; /*unsigned int port*/
              HB_DYN_CTYPE_CHAR_PTR     , ; /*const char *unix_socket*/
              HB_DYN_CTYPE_LONG }       , ; /*unsigned long client_flag*/
              hMySql, cHost, cUser, cPass, cDatabase, nPort, NIL, nFlag )
 endif

return hMySql

/*------------------------------------------------------------*/

function mysql_close( hMySql )
 
 if !empty( pLib )
  hb_DynCall( { "mysql_close", pLib, HB_DYN_CALLCONV_CDECL, ;
                                     HB_DYN_CTYPE_LONG_UNSIGNED }, hMySql )
 endif
 
return nil

/*------------------------------------------------------------*/

function mysql_errno( hMySql )
 local nError := 0
 
 if !empty( pLib )
  nError := hb_DynCall( { "mysql_errno", pLib, HB_DYN_CALLCONV_CDECL, ;
                                               HB_DYN_CTYPE_LONG_UNSIGNED }, hMySql )
 endif
 
return nError

/*------------------------------------------------------------*/

function mysql_error( hMySql )
 local cError := ""
 
 if !empty( pLib )
  cError := hb_DynCall( { "mysql_error", pLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CALLCONV_CDECL ), ;
                                               HB_DYN_CTYPE_LONG_UNSIGNED }, hMySql )
 endif
 
return cError

/*------------------------------------------------------------*/

function mysql_real_query( hMySql, cQuery )
 local nRet
 local nLen := len(cQuery)

 if !empty( pLib )
  nRet := hb_DynCall( { "mysql_real_query", pLib, HB_DYN_CALLCONV_CDECL, ;
                         HB_DYN_CTYPE_LONG_UNSIGNED  , ; /*MYSQL *mysql*/
                         HB_DYN_CTYPE_CHAR_PTR       , ; /*const char *stmt_str*/
                         HB_DYN_CTYPE_LONG_UNSIGNED }, ; /*unsigned long length*/
                         hMySql, cQuery, nLen )
 endif
 
return nRet

/*------------------------------------------------------------*/

function mysql_store_result( hMySql )
 local hMyRes
 
 if !empty( pLib )
  hMyRes := hb_DynCall( { "mysql_store_result", pLib, HB_DYN_CALLCONV_CDECL, ;
                                                      HB_DYN_CTYPE_LONG_UNSIGNED }, hMySql )
 endif

return hMyRes

/*------------------------------------------------------------*/

function mysql_free_result( hMyRes )
 
 if !empty( pLib )
  hb_DynCall( { "mysql_free_result", pLib, HB_DYN_CALLCONV_CDECL, ;
                                           HB_DYN_CTYPE_LONG_UNSIGNED }, hMyRes )
 endif
 
return nil

/*------------------------------------------------------------*/

function mysql_get_server_info( hMySql )
 local cVersion := ""
 
 if !empty( pLib )
  cVersion := hb_DynCall( { "mysql_get_server_info", pLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CALLCONV_CDECL ), ;
                                                           HB_DYN_CTYPE_LONG_UNSIGNED }, hMySql )
 endif
 
return cVersion

/*------------------------------------------------------------*/

function mysql_num_rows( hMyRes )
 local nRows := 0
 
 if !empty( pLib ) .and. !empty( hMyRes )
  nRows := hb_DynCall( { "mysql_num_rows", pLib, hb_bitOr( HB_DYN_CALLCONV_CDECL, HB_DYN_CTYPE_LLONG_UNSIGNED ), ;
                                                 HB_DYN_CTYPE_LLONG_UNSIGNED }, hMyRes )
 endif
 
return nRows

/*------------------------------------------------------------*/

function mysql_num_fields( hMyRes )
 local nFields := 0
 
 if !empty( pLib ) .and. !empty( hMyRes )
  nFields := hb_DynCall( { "mysql_num_fields", pLib, hb_bitOr( HB_DYN_CALLCONV_CDECL, HB_DYN_CTYPE_INT_UNSIGNED ), ;
                                               HB_DYN_CTYPE_INT_UNSIGNED }, hMyRes )
 endif
 
return nFields

/*------------------------------------------------------------*/

function mysql_fetch_field( hMyRes )
 local hField
 
 if !empty( pLib ) .and. !empty( hMyRes )
  hField := hb_DynCall( { "mysql_fetch_field", pLib, hb_bitor( HB_DYN_CALLCONV_CDECL, HB_DYN_CTYPE_VOID_PTR ), ;
                                                     HB_DYN_CTYPE_LONG_UNSIGNED }, hMyRes )
 endif
 
return hField

/*------------------------------------------------------------*/


function My_FetchRow( hMyRes )
 local hRow
 
 if !empty( pLib ) .and. !empty( hMyRes )
  hRow := hb_DynCall( { "mysql_fetch_row", pLib, HB_DYN_CALLCONV_CDECL, ;
                                                 HB_DYN_CTYPE_LONG_UNSIGNED }, hMyRes )
 endif
 
return hRow

/*------------------------------------------------------------*/
#pragma BEGINDUMP

#include "hbapi.h"

HB_FUNC( PTRTOSTR )
{
   const char ** pStrs = (const char **) hb_parnll(1);
   hb_retc( * ( pStrs + hb_parnl( 2 ) ) );
}

#pragma ENDDUMP
 

[Ari]

Gracias.

[Ari]

Carlos

Primero, muchas gracias por la ayuda anterior, ahora necesito la función hb_dyncall (), uso xHarbour y no tengo esta función.

Sabes dónde puedo encontrar, busqué en todas partes sin éxito.

Gracias
Ari

[carlos vargas]

DllCall()
Executes a function located in a dynamically loaded external library.
Syntax

DllCall( <cDllFile>|<nDllHandle>, ;
[<nCallingConvention>] , ;
<cFuncName>|<nOrdinal> , ;
[<xParams,...>] ) --> nResult

Arguments
<cDllFile>
A character string holding the name of the DLL file where the function is located. This is an external DLL, not created by xHarbour. If a character string is passed for <cDllFile>, it must contain complete path information, unless the file is located in the current directory, or in the list of directories held in the SET PATH environment variable of the operating system.
<nDllHandle>
Alternatively, the first parameter can be a numeric DLL handle as returned by function LoadLibrary().
<nCallingConvention>
The calling convention to use for the DLL function can optionally be specified. Constants are available for this parameter. Calling conventions Constant Value Description
DC_CALL_CDECL 0x0010 C calling convention (__cdecl)
DC_CALL_STD *) 0x0020 Standard convention for WinAPI (__stdcall)
*) default

<cFuncName>
This is a character string holding the symbolic name of the function to call. Unlike regular xHarbour functions, this function name is case sensitive.
<nOrdinal>
Instead of the symbolic function name, the numeric ordinal position of the function inside the DLL file can be passed. This is, however, not recommended, since ordinal positions of functions may change between DLL versions.
<xParams,...>
The values of all following parameters specified in a comma separated list are passed on to the DLL function. Return
The function returns the result of the called DLL function as a numeric value.
Description
Function DllCall() can be used to execute functions located in DLL files which are not created by the xHarbour compiler and linker. This allows for executing functions residing in system DLLs of the operating system or Third Party producers, for example.

The DLL that contains a function is either specified by its numeric DLL handle, or by its symbolic file name. In the latter case, DllCall() loads the library, executes the function and frees the library when the function has returned. When a numeric DLL handle is specified, the DLL is already loaded by LoadLibrary(), and it remains loaded when the DLL function is complete. The DLL must then be released explicitely with FreeLibrary().
When more than three parameters are specified, all <xParams,...> are passed on to the DLL function. However, since xHarbour has its own data types and more of them are available than in the C language, only values of a restricted number of data types can be passed. The values are converted to corresponding C data types.

Data type conversion PRG level C level
Character *char
C structure *void
Date DWORD
Logical DWORD
NIL ( DWORD ) NULL
Numeric
- Integer DWORD
- Decimal number double
Pointer *void

If other xHarbour data types are passed to DllCall(), a runtime error is generated.
Note: many Windows API functions are available as a Unicode and an Ansi version. If this is the case, DllCall() uses the Ansi version of the WinAPI function.

Example

Code: Select all  Expand view  RUN

// The example outlines how a Windows API function can be wrapped
// within an xHarbour function without reverting to xHarbour's
// extend API. The GetVolumeInformation() wrapper obtains only
// the volume name and serial number. Other information available
// from the WinAPI function is ignored. Note that the "out"
// parameters of the API must be passed by reference to DllCall().

   #define DC_CALL_STD            0x0020
   #define MAX_PATH                  260

   PROCEDURE Main
      LOCAL cDrive := "D:\"
      LOCAL cVolName, cVolSerial

      cVolName := GetVolumeInformation( cDrive, @cVolSerial )

      ? cVolName                      // result: BACKUP

      ? cVolSerial                    // result: 584C:2AE1
   RETURN


   FUNCTION GetVolumeInformation( cVolume, cSerial )
      LOCAL cVolumeName := Replicate( Chr(0), MAX_PATH+1 )
      LOCAL nNameSize   := Len( cVolumeName )
      LOCAL nResult

      cSerial := U2Bin(0)

      nResult :=                    ;  // * C prototype *
         DllCall(                   ;
           "Kernel32.dll"         , ;  // DLL to call
            DC_CALL_STD           , ;  // calling vonvention
           "GetVolumeInformation" , ;  // BOOL GetVolumeInformation(
            cVolume               , ;  //   LPCTSTR lpRootPathName ,
           @cVolumeName           , ;  //   LPTSTR lpVolumeNameBuffer ,
            nNameSize             , ;  //   DWORD nVolumeNameSize ,
           @cSerial               , ;  //   LPDWORD lpVolumeSerialNumber ,
            0                     , ;  //   LPDWORD lpMaximumComponentLength ,
            0                     , ;  //   LPDWORD lpFileSystemFlags ,
            0                     , ;  //   LPTSTR lpFileSystemNameBuffer ,
            0                       )  //   DWORD nFileSystemNameSize )

      // format serial number as FFFF:FFFF
      cSerial := NumToHex( Bin2U(cSerial), 8 )
      cSerial := Stuff( cSerial, 5, 0, ":" )

   RETURN Left( cVolumeName, At( Chr(0), cVolumeName ) - 1 )