xHarbour 64 bits y xbScritp - (Solucionado)

Re: xHarbour 64 bits y xbScritp

Postby Antonio Linares » Mon Sep 16, 2024 6:42 pm

Carlos,

Puedes probar esta versión por favor ? Aqui parece construirse bien:

carlos.prg
Code: Select all  Expand view
#include "FiveWin.ch"

function Main()

   local oWnd, oDlg

   DEFINE WINDOW oWnd

      @ 2, 2 BUTTON "Test" ACTION ( pp_run("PRUEBA1.SCR") ) SIZE 80, 20
      @ 4, 2 BUTTON "Exit" ACTION ( oWnd:End ) SIZE 80, 20

   ACTIVATE WINDOW oWnd

return nil


#pragma BEGINDUMP

#ifndef NODLL

#define _WIN32_WINNT 0x0400
#define WIN32_LEAN_AND_MEAN

#include "hbapiitm.h"
#include <windows.h>
#include "hbdll.h"
#include "hbapi.h"
#include "hbstack.h"
#include "hbvm.h"

#define DC_FLAG_FLOAT 0x1

#define EXEC_DLL 0x45584543

typedef struct tag_ExecStruct
{
   DWORD dwType;
   char * cDLL;
   HMODULE hDLL;
   char * cProc;
   DWORD dwOrdinal;
   DWORD dwFlags;
   FARPROC lpFunc;
} EXECSTRUCT, * PEXECSTRUCT;

static PHB_DYNS pHB_CSTRUCTURE = NULL, pPOINTER, pVALUE, pBUFFER, pDEVALUE;

HB_EXTERN_BEGIN
char * hb_parcstruct( int iParam, ... );
HB_EXTERN_END

char * hb_parcstruct( int iParam, ... )
{
   HB_THREAD_STUB_ANY

   HB_TRACE( HB_TR_DEBUG, ( "hb_parcstruct(%d, ...)", iParam ) );

   if( pHB_CSTRUCTURE == NULL )
   {
      pHB_CSTRUCTURE = hb_dynsymFind( "HB_CSTRUCTURE" );

      pPOINTER       = hb_dynsymGetCase( "POINTER" );
      pVALUE         = hb_dynsymGetCase( "VALUE" );
      pBUFFER        = hb_dynsymGetCase( "BUFFER" );
      pDEVALUE       = hb_dynsymGetCase( "DEVALUE" );
   }

   if( ( iParam >= 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) )
   {
      PHB_ITEM pItem    = ( iParam == -1 ) ? hb_stackReturnItem() : hb_stackItemFromBase( iParam );
      BOOL     bRelease = FALSE;

      if( HB_IS_BYREF( pItem ) )
      {
         pItem = hb_itemUnRef( pItem );
      }

      if( HB_IS_ARRAY( pItem ) && ! HB_IS_OBJECT( pItem ) )
      {
         va_list  va;
         ULONG    ulArrayIndex;
         PHB_ITEM pArray = pItem;

         va_start( va, iParam );
         ulArrayIndex   = va_arg( va, ULONG );
         va_end( va );

         pItem          = hb_itemNew( NULL );
         bRelease       = TRUE;

         hb_arrayGet( pArray, ulArrayIndex, pItem );
      }

      if( strncmp( hb_objGetClsName( pItem ), "C Structure", 11 ) == 0 )
      {
         hb_vmPushSymbol( pVALUE->pSymbol );
         hb_vmPush( pItem );
         hb_vmSend( 0 );

         if( bRelease )
         {
            hb_itemRelease( pItem );
         }

         //return hb_stackReturnItem()->item.asString.value;
         return hb_itemGetCPtr( hb_stackReturnItem() ) ;
      }
   }

   return NULL;
}

static HB_GARBAGE_FUNC( _DLLUnload )
{
   PEXECSTRUCT xec = ( PEXECSTRUCT ) Cargo;

   if( xec->dwType == EXEC_DLL )
   {
      if( xec->cDLL != NULL )
      {
         if( xec->hDLL != NULL )
         {
            FreeLibrary( xec->hDLL );
         }
         hb_xfree( xec->cDLL );
      }
      if( xec->cProc != NULL )
      {
         hb_xfree( xec->cProc );
      }
      xec->dwType = 0;
   }
}

HB_FUNC( DLLPREPARECALL )
{
   PEXECSTRUCT xec = ( PEXECSTRUCT ) hb_gcAlloc( sizeof( EXECSTRUCT ), _DLLUnload );

   memset( xec, 0, sizeof( EXECSTRUCT ) );

   if( HB_ISCHAR( 1 ) )
   {
      xec->cDLL = hb_strdup( hb_parc( 1 ) );
      xec->hDLL = LoadLibrary( xec->cDLL );
   }
   else
   {
      xec->hDLL = ( HMODULE ) hb_parptr( 1 );
   }

   if( HB_ISNUM( 2 ) )
   {
      xec->dwFlags = hb_parnl( 2 );
   }
   else
   {
      xec->dwFlags = DC_CALL_STD;
   }

   if( xec->hDLL )
   {
      if( HB_ISCHAR( 3 ) )
      {
         xec->cProc = ( char * ) hb_xgrab( hb_parclen( 3 ) + 2 );
         hb_strncpy( xec->cProc, hb_parc( 3 ), hb_parclen( 3 ) );
      }
      else if( HB_ISNUM( 3 ) )
      {
         xec->dwOrdinal = hb_parnl( 3 );
      }
   }
   else
   {
      if( xec->cDLL )
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall:LoadLibrary() failed!", xec->cDLL, MB_OK | MB_ICONERROR );
      }
      else
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall() invalid handle argument!", "DllPrepareCall", MB_OK | MB_ICONERROR );
      }
   }

   xec->dwType = EXEC_DLL;
   xec->lpFunc = ( FARPROC ) GetProcAddress( xec->hDLL, xec->cProc != NULL ? ( LPCSTR ) xec->cProc : ( LPCSTR ) ( DWORD_PTR ) xec->dwOrdinal );

   if( xec->lpFunc == NULL && xec->cProc )
   {
      xec->cProc[ hb_parclen( 3 ) ] = 'A';
      xec->cProc[ hb_parclen( 3 ) + 1 ] = '\0';
      xec->lpFunc = ( FARPROC ) GetProcAddress( xec->hDLL, xec->cProc );
   }

   if( xec->hDLL && xec->lpFunc )
   {
      hb_retptrGC( xec );
   }
   else if( xec->hDLL && xec->lpFunc == NULL )
   {
      if( xec->cProc )
      {
         LPVOID lpMsgBuf;
         FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, NULL,
                        GetLastError(), MAKELANGID( LANG_NEUTRAL, SUBLANG_DEFAULT ),
                        ( LPTSTR ) &lpMsgBuf, 0, NULL );
         MessageBox( GetActiveWindow(), ( LPCSTR ) lpMsgBuf, "DllPrepareCall:GetProcAddress() failed!", MB_OK | MB_ICONERROR );
         LocalFree( lpMsgBuf );
      }
      else
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall:GetProcAddress() invalid ordinal argument!", "DllPrepareCall", MB_OK | MB_ICONERROR );
      }
   }
}

HB_FUNC( GETPROCADDRESS )
{
   FARPROC lpProcAddr;
   char cFuncName[ MAX_PATH ];

   if( ( lpProcAddr = GetProcAddress( ( HMODULE ) hb_parptr( 1 ),
                                      HB_ISCHAR( 2 ) ? ( LPCSTR ) hb_parcx( 2 ) :
                                      ( LPCSTR ) ( DWORD_PTR ) hb_parnint( 2 ) ) ) == 0 )
   {
      if( HB_ISCHAR( 2 ) )
      {
         hb_xstrcpy( cFuncName, hb_parc( 2 ), 0 );
         hb_xstrcat( cFuncName, "A", 0 );
         lpProcAddr = GetProcAddress( ( HMODULE ) hb_parptr( 1 ), cFuncName );
      }
   }

   hb_retptr( ( void * ) lpProcAddr );
}

#ifdef _WIN64
// #include <intrin.h>

typedef struct
{
   DWORD64 Low;
   DWORD64 High;
} RESULT;

typedef struct
{
   DWORD64 dwFlags;
   int nWidth;
   union
   {
      BYTE bArg;
      SHORT usArg;
      DWORD dwArg;
      DWORD64 qwArg;
      double dArg;
   };
   void * pArg;
} DYNAPARM;

RESULT DynaCall64(DWORD64 Flags, FARPROC lpFunction, int nArgs, DYNAPARM Parm[], void* pRet, int nRetSiz)
{
    RESULT Res = { 0 };
    DWORD64 args[4] = { 0 };  // For the first 4 arguments
    double dargs[4] = { 0 };  // For float/double arguments
    int i, nIntArgs = 0, nFloatArgs = 0;

    // Prepare arguments
    for (i = 0; i < nArgs && i < 4; i++)
    {
        if (Parm[i].dwFlags & DC_FLAG_FLOAT)
        {
            dargs[nFloatArgs++] = Parm[i].dArg;
        }
        else
        {
            args[nIntArgs++] = Parm[i].qwArg;
        }
    }

    // Call the function using inline assembly
   __asm
   {
      // Load floating point arguments into XMM registers
      movsd xmm0, qword ptr [dargs]
      movsd xmm1, qword ptr [dargs + 8]
      movsd xmm2, qword ptr [dargs + 16]
      movsd xmm3, qword ptr [dargs + 24]

      // Load integer arguments into registers
      mov rcx, args[0]
      mov rdx, args[8]
      mov r8, args[16]
      mov r9, args[24]

      // Adjust stack for any remaining arguments (if nArgs > 4)
      sub rsp, 32  // Shadow space for Win64 ABI

      // Call the function
      call lpFunction

      // Restore stack
      add rsp, 32

      // Store the result
      mov Res.Low, rax
      mov Res.High, rdx
   }

    // Handle return value if needed
    if (pRet && nRetSiz > 0)
    {
        memcpy(pRet, &Res, nRetSiz);
    }

    return Res;
}
#else
// Mantener la implementación original de DynaCall para 32 bits
#endif

static void DllExec(int iFlags, FARPROC lpFunction, int iParams, int iFirst, int iArgCnt, PEXECSTRUCT xec)
{
#ifdef _WIN64
    DYNAPARM Parm[32];  // Ajusta el tamaño según sea necesario
    int i;
    for (i = 0; i < iArgCnt && i < 32; i++)
    {
        // Configurar Parm[i] basándose en los argumentos de Harbour
        // Esto dependerá de cómo estés pasando los argumentos desde Harbour
        if (HB_ISNUM(iFirst + i))
        {
            Parm[i].dwFlags = 0;
            Parm[i].qwArg = (DWORD64)hb_parnd(iFirst + i);
        }
        else if (HB_ISPOINTER(iFirst + i))
        {
            Parm[i].dwFlags = 0;
            Parm[i].pArg = hb_parptr(iFirst + i);
        }
        // Agregar más tipos según sea necesario
    }
    RESULT Res = DynaCall64(iFlags, lpFunction, iArgCnt, Parm, NULL, 0);
    // Manejar el resultado según sea necesario
    hb_retnint((HB_PTRDIFF)Res.Low);
#else
    // Implementación existente para 32 bits
#endif
}

HB_FUNC( DLLEXECUTECALL )
{
   int iParams = hb_pcount();
   int iFirst = 2;
   int iArgCnt = iParams - 1;
   PEXECSTRUCT xec = ( PEXECSTRUCT ) hb_parptr( 1 );

   if( xec != NULL )
   {
      if( xec->dwType == EXEC_DLL )
      {
         if( xec->hDLL != NULL )
         {
            if( xec->lpFunc != NULL )
            {
               DllExec( 0, xec->lpFunc, iParams, iFirst, iArgCnt, xec );
            }
         }
      }
   }
}

HB_FUNC( DLLCALL )
{
   int iParams = hb_pcount();
   int iFirst = 4;
   int iArgCnt = iParams - 3;
   int iFlags;
   BOOL lUnload = FALSE;
   HMODULE hInst;
   FARPROC lpFunction;
   BYTE cFuncName[ MAX_PATH ];

   if( HB_ISCHAR( 1 ) )
   {
      hInst = LoadLibrary( hb_parc( 1 ) );
      lUnload = TRUE;
   }
   else
   {
      hInst = ( HMODULE ) hb_parptr( 1 );
   }

   if( hInst == NULL )
   {
      hb_ret();
      return;
   }

   iFlags = hb_parni( 2 );

   if( ( lpFunction = GetProcAddress( hInst,
                                      HB_ISCHAR( 3 ) ? ( LPCSTR ) hb_parcx( 3 ) :
                                      ( LPCSTR ) ( DWORD_PTR ) hb_parnint( 3 ) ) ) == 0 )
   {
      if( HB_ISCHAR( 3 ) )
      {
         hb_xstrcpy( ( char * ) cFuncName, hb_parc( 3 ), 0 );
         hb_xstrcat( ( char * ) cFuncName, "A", 0 );
         lpFunction = GetProcAddress( hInst, ( const char * ) cFuncName );
      }
   }

   if( lpFunction != NULL )
   {
      DllExec( iFlags, lpFunction, iParams, iFirst, iArgCnt, NULL );
   }

   if( lUnload )
   {
      FreeLibrary( hInst );
   }
}

#endif /* NODLL */

HB_FUNC( LOADLIBRARY )
{
   hb_retptr( ( void * ) LoadLibraryA( ( LPCSTR ) hb_parcx( 1 ) ) );
}

HB_FUNC( FREELIBRARY )
{
   hb_retl( FreeLibrary( ( HMODULE ) hb_parptr( 1 ) ) );
}

HB_FUNC( GETLASTERROR )
{
   hb_retnint( ( HB_PTRDIFF ) GetLastError() );
}

HB_FUNC( SETLASTERROR )
{
   hb_retnint( ( HB_PTRDIFF ) GetLastError() );
   SetLastError( ( DWORD ) hb_parnint( 1 ) );
}

// compatibility
HB_FUNC( DLLLOAD )
{
   HB_FUNCNAME( LOADLIBRARY ) ();
}

// compatibility
HB_FUNC( DLLUNLOAD )
{
   HB_FUNCNAME( FREELIBRARY ) ();
}

#pragma ENDDUMP
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41858
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xHarbour 64 bits y xbScritp - (Solucionado)

Postby Cgallegoa » Mon Sep 16, 2024 6:56 pm

Maestro, funcionó en FWH64. :D
Perfecto FWH-24.07 :D

Maestro muchas gracias, ahora lo del pdfharu.

Un abrazo,
Last edited by Cgallegoa on Mon Sep 16, 2024 7:06 pm, edited 3 times in total.
Saludos,

Carlos Gallego

*** FWH-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***
Cgallegoa
 
Posts: 463
Joined: Sun Oct 16, 2005 3:32 am
Location: Quito - Ecuador

Re: xHarbour 64 bits y xbScritp

Postby Antonio Linares » Mon Sep 16, 2024 7:01 pm

Carlos,

ha construido bien y ha funcionado bien ?

Hay una parte que falta en el código para 32 bits, tenemos que copiarla desde el fichero original dllcall.c de 32 bits.

Una vez probado se lo damos a Enrico para que lo incluya en xHarbour ;-)

Muchisimas gracias por tu ayuda
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41858
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xHarbour 64 bits y xbScritp

Postby Cgallegoa » Mon Sep 16, 2024 7:08 pm

Si, probado con un ejemplo sencillo, carga el script, pasa y recibe variables sin problema, etc, tanto en FWH-24.07 32 bits como FWH-24.07 64 bits.

Acabas de recargarle el oxígeno a xHarbour :)
Last edited by Cgallegoa on Mon Sep 16, 2024 7:11 pm, edited 1 time in total.
Saludos,

Carlos Gallego

*** FWH-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***
Cgallegoa
 
Posts: 463
Joined: Sun Oct 16, 2005 3:32 am
Location: Quito - Ecuador

Re: xHarbour 64 bits y xbScritp

Postby Antonio Linares » Mon Sep 16, 2024 7:09 pm

Genial! :-D
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41858
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xHarbour 64 bits y xbScritp

Postby Antonio Linares » Mon Sep 16, 2024 7:12 pm

Esta parte es la que falta copiar del anterior fichero dllcall.c:

Code: Select all  Expand view
#else
// Mantener la implementación original de DynaCall para 32 bits
#endif


Si fueses tan amable de copiarla desde el fichero antiguo dllcall.c y luego probarlo tanto en 32 como en 64 bits para asegurarnos de que va bien.
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41858
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xHarbour 64 bits y xbScritp

Postby Cgallegoa » Mon Sep 16, 2024 7:16 pm

En realidad, no incluí el código en c en la version de 32 ya que pude construir xbscript.lib sin ningún inconveniente. En el script de compilación agregué:
ECHO C:\XHARBOUR-7.7\utils\xbscript\xbscript.lib + >> b32.bc
Y funciona de maravilla.
Saludos,

Carlos Gallego

*** FWH-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***
Cgallegoa
 
Posts: 463
Joined: Sun Oct 16, 2005 3:32 am
Location: Quito - Ecuador

Re: xHarbour 64 bits y xbScritp - (Solucionado)

Postby Enrico Maria Giordano » Mon Sep 16, 2024 7:24 pm

Code: Select all  Expand view
error C2065: 'DC_FLAG_FLOAT': undeclared identifier
User avatar
Enrico Maria Giordano
 
Posts: 8512
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour 64 bits y xbScritp - (Solucionado)

Postby Antonio Linares » Mon Sep 16, 2024 7:27 pm

#define DC_FLAG_FLOAT 0x1
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41858
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xHarbour 64 bits y xbScritp - (Solucionado)

Postby Antonio Linares » Mon Sep 16, 2024 7:52 pm

This is an enhanced version for both 32 and 64 bits.

Please test it, we need feedback to check if it working fine, thanks
Code: Select all  Expand view
#include "FiveWin.ch"

function Main()

   local oWnd, oDlg

   DEFINE WINDOW oWnd

      @ 2, 2 BUTTON "Test" ACTION ( pp_run("PRUEBA1.SCR") ) SIZE 80, 20
      @ 4, 2 BUTTON "Exit" ACTION ( oWnd:End ) SIZE 80, 20

   ACTIVATE WINDOW oWnd

return nil


#pragma BEGINDUMP

#ifndef NODLL

#define _WIN32_WINNT 0x0400
#define WIN32_LEAN_AND_MEAN

#include "hbapiitm.h"
#include <windows.h>
#include "hbdll.h"
#include "hbapi.h"
#include "hbstack.h"
#include "hbvm.h"

#define DC_FLAG_FLOAT            0x00000001
#define DC_FLAG_ARGPTR           0x00000002

#define EXEC_DLL 0x45584543

typedef struct tag_ExecStruct
{
   DWORD dwType;
   char * cDLL;
   HMODULE hDLL;
   char * cProc;
   DWORD dwOrdinal;
   DWORD dwFlags;
   FARPROC lpFunc;
} EXECSTRUCT, * PEXECSTRUCT;

static PHB_DYNS pHB_CSTRUCTURE = NULL, pPOINTER, pVALUE, pBUFFER, pDEVALUE;

HB_EXTERN_BEGIN
char * hb_parcstruct( int iParam, ... );
HB_EXTERN_END

char * hb_parcstruct( int iParam, ... )
{
   HB_THREAD_STUB_ANY

   HB_TRACE( HB_TR_DEBUG, ( "hb_parcstruct(%d, ...)", iParam ) );

   if( pHB_CSTRUCTURE == NULL )
   {
      pHB_CSTRUCTURE = hb_dynsymFind( "HB_CSTRUCTURE" );

      pPOINTER       = hb_dynsymGetCase( "POINTER" );
      pVALUE         = hb_dynsymGetCase( "VALUE" );
      pBUFFER        = hb_dynsymGetCase( "BUFFER" );
      pDEVALUE       = hb_dynsymGetCase( "DEVALUE" );
   }

   if( ( iParam >= 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) )
   {
      PHB_ITEM pItem    = ( iParam == -1 ) ? hb_stackReturnItem() : hb_stackItemFromBase( iParam );
      BOOL     bRelease = FALSE;

      if( HB_IS_BYREF( pItem ) )
      {
         pItem = hb_itemUnRef( pItem );
      }

      if( HB_IS_ARRAY( pItem ) && ! HB_IS_OBJECT( pItem ) )
      {
         va_list  va;
         ULONG    ulArrayIndex;
         PHB_ITEM pArray = pItem;

         va_start( va, iParam );
         ulArrayIndex   = va_arg( va, ULONG );
         va_end( va );

         pItem          = hb_itemNew( NULL );
         bRelease       = TRUE;

         hb_arrayGet( pArray, ulArrayIndex, pItem );
      }

      if( strncmp( hb_objGetClsName( pItem ), "C Structure", 11 ) == 0 )
      {
         hb_vmPushSymbol( pVALUE->pSymbol );
         hb_vmPush( pItem );
         hb_vmSend( 0 );

         if( bRelease )
         {
            hb_itemRelease( pItem );
         }

         //return hb_stackReturnItem()->item.asString.value;
         return hb_itemGetCPtr( hb_stackReturnItem() ) ;
      }
   }

   return NULL;
}

static HB_GARBAGE_FUNC( _DLLUnload )
{
   PEXECSTRUCT xec = ( PEXECSTRUCT ) Cargo;

   if( xec->dwType == EXEC_DLL )
   {
      if( xec->cDLL != NULL )
      {
         if( xec->hDLL != NULL )
         {
            FreeLibrary( xec->hDLL );
         }
         hb_xfree( xec->cDLL );
      }
      if( xec->cProc != NULL )
      {
         hb_xfree( xec->cProc );
      }
      xec->dwType = 0;
   }
}

HB_FUNC( DLLPREPARECALL )
{
   PEXECSTRUCT xec = ( PEXECSTRUCT ) hb_gcAlloc( sizeof( EXECSTRUCT ), _DLLUnload );

   memset( xec, 0, sizeof( EXECSTRUCT ) );

   if( HB_ISCHAR( 1 ) )
   {
      xec->cDLL = hb_strdup( hb_parc( 1 ) );
      xec->hDLL = LoadLibrary( xec->cDLL );
   }
   else
   {
      xec->hDLL = ( HMODULE ) hb_parptr( 1 );
   }

   if( HB_ISNUM( 2 ) )
   {
      xec->dwFlags = hb_parnl( 2 );
   }
   else
   {
      xec->dwFlags = DC_CALL_STD;
   }

   if( xec->hDLL )
   {
      if( HB_ISCHAR( 3 ) )
      {
         xec->cProc = ( char * ) hb_xgrab( hb_parclen( 3 ) + 2 );
         hb_strncpy( xec->cProc, hb_parc( 3 ), hb_parclen( 3 ) );
      }
      else if( HB_ISNUM( 3 ) )
      {
         xec->dwOrdinal = hb_parnl( 3 );
      }
   }
   else
   {
      if( xec->cDLL )
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall:LoadLibrary() failed!", xec->cDLL, MB_OK | MB_ICONERROR );
      }
      else
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall() invalid handle argument!", "DllPrepareCall", MB_OK | MB_ICONERROR );
      }
   }

   xec->dwType = EXEC_DLL;
   xec->lpFunc = ( FARPROC ) GetProcAddress( xec->hDLL, xec->cProc != NULL ? ( LPCSTR ) xec->cProc : ( LPCSTR ) ( DWORD_PTR ) xec->dwOrdinal );

   if( xec->lpFunc == NULL && xec->cProc )
   {
      xec->cProc[ hb_parclen( 3 ) ] = 'A';
      xec->cProc[ hb_parclen( 3 ) + 1 ] = '\0';
      xec->lpFunc = ( FARPROC ) GetProcAddress( xec->hDLL, xec->cProc );
   }

   if( xec->hDLL && xec->lpFunc )
   {
      hb_retptrGC( xec );
   }
   else if( xec->hDLL && xec->lpFunc == NULL )
   {
      if( xec->cProc )
      {
         LPVOID lpMsgBuf;
         FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, NULL,
                        GetLastError(), MAKELANGID( LANG_NEUTRAL, SUBLANG_DEFAULT ),
                        ( LPTSTR ) &lpMsgBuf, 0, NULL );
         MessageBox( GetActiveWindow(), ( LPCSTR ) lpMsgBuf, "DllPrepareCall:GetProcAddress() failed!", MB_OK | MB_ICONERROR );
         LocalFree( lpMsgBuf );
      }
      else
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall:GetProcAddress() invalid ordinal argument!", "DllPrepareCall", MB_OK | MB_ICONERROR );
      }
   }
}

HB_FUNC( GETPROCADDRESS )
{
   FARPROC lpProcAddr;
   char cFuncName[ MAX_PATH ];

   if( ( lpProcAddr = GetProcAddress( ( HMODULE ) hb_parptr( 1 ),
                                      HB_ISCHAR( 2 ) ? ( LPCSTR ) hb_parcx( 2 ) :
                                      ( LPCSTR ) ( DWORD_PTR ) hb_parnint( 2 ) ) ) == 0 )
   {
      if( HB_ISCHAR( 2 ) )
      {
         hb_xstrcpy( cFuncName, hb_parc( 2 ), 0 );
         hb_xstrcat( cFuncName, "A", 0 );
         lpProcAddr = GetProcAddress( ( HMODULE ) hb_parptr( 1 ), cFuncName );
      }
   }

   hb_retptr( ( void * ) lpProcAddr );
}

#ifdef _WIN64

typedef struct
{
   DWORD64 Low;
   DWORD64 High;
} RESULT;

typedef struct
{
   DWORD64 dwFlags;
   int nWidth;
   union
   {
      BYTE bArg;
      SHORT usArg;
      DWORD dwArg;
      DWORD64 qwArg;
      double dArg;
   };
   void * pArg;
} DYNAPARM;

RESULT DynaCall64(DWORD64 Flags, FARPROC lpFunction, int nArgs, DYNAPARM Parm[], void* pRet, int nRetSiz)
{
    RESULT Res = { 0 };
    DWORD64 args[4] = { 0 };  // For the first 4 arguments
    double dargs[4] = { 0 };  // For float/double arguments
    int i, nIntArgs = 0, nFloatArgs = 0;

    // Prepare arguments
    for (i = 0; i < nArgs && i < 4; i++)
    {
        if (Parm[i].dwFlags & DC_FLAG_FLOAT)
        {
            dargs[nFloatArgs++] = Parm[i].dArg;
        }
        else
        {
            args[nIntArgs++] = Parm[i].qwArg;
        }
    }

    // Call the function using inline assembly
   __asm
   {
      // Load floating point arguments into XMM registers
      movsd xmm0, qword ptr [dargs]
      movsd xmm1, qword ptr [dargs + 8]
      movsd xmm2, qword ptr [dargs + 16]
      movsd xmm3, qword ptr [dargs + 24]

      // Load integer arguments into registers
      mov rcx, args[0]
      mov rdx, args[8]
      mov r8, args[16]
      mov r9, args[24]

      // Adjust stack for any remaining arguments (if nArgs > 4)
      sub rsp, 32  // Shadow space for Win64 ABI

      // Call the function
      call lpFunction

      // Restore stack
      add rsp, 32

      // Store the result
      mov Res.Low, rax
      mov Res.High, rdx
   }

    // Handle return value if needed
    if (pRet && nRetSiz > 0)
    {
        memcpy(pRet, &Res, nRetSiz);
    }

    return Res;
}

#else

#define DC_CALL_STD_BO           ( DC_CALL_STD | DC_BORLAND )
#define DC_CALL_STD_MS           ( DC_CALL_STD | DC_MICROSOFT )
#define DC_CALL_STD_M8           ( DC_CALL_STD | DC_RETVAL_MATH8 )

#define DC_FLAG_ARGPTR           0x00000002

#define CTYPE_VOID               0
#define CTYPE_CHAR               1

#define CTYPE_UNSIGNED_CHAR      -1
#define CTYPE_CHAR_PTR           10
#define CTYPE_UNSIGNED_CHAR_PTR  -10

#define CTYPE_SHORT              2
#define CTYPE_UNSIGNED_SHORT     -2
#define CTYPE_SHORT_PTR          20
#define CTYPE_UNSIGNED_SHORT_PTR -20

#define CTYPE_INT                3
#define CTYPE_UNSIGNED_INT       -3
#define CTYPE_INT_PTR            30
#define CTYPE_UNSIGNED_INT_PTR   -30

#define CTYPE_LONG               4
#define CTYPE_UNSIGNED_LONG      -4
#define CTYPE_LONG_PTR           40
#define CTYPE_UNSIGNED_LONG_PTR  -40

#define CTYPE_FLOAT              5
#define CTYPE_FLOAT_PTR          50

#define CTYPE_DOUBLE             6
#define CTYPE_DOUBLE_PTR         60

#define CTYPE_VOID_PTR           7

#define CTYPE_BOOL               8

#define CTYPE_STRUCTURE          1000
#define CTYPE_STRUCTURE_PTR      10000

#pragma pack(1)

typedef union RESULT             // Various result types
{ int Int;                       // Generic four-byte type
  long Long;                     // Four-byte long
  void * Pointer;                // 32-bit pointer
  float Float;                   // Four byte real
  double Double;                 // 8-byte real
  __int64 int64;                 // big int (64-bit)
} RESULT;

typedef struct DYNAPARM
{
   DWORD dwFlags;             // Parameter flags
   int nWidth;                // Byte width
   union                      //
   { BYTE bArg;               // 1-byte argument
     SHORT usArg;             // 2-byte argument
     DWORD dwArg;             // 4-byte argument
     double dArg; };
   void * pArg;               // Pointer to argument
} DYNAPARM;

#pragma pack()

RESULT DynaCall( int Flags, LPVOID lpFunction, int nArgs,
                 DYNAPARM Parm[], LPVOID pRet, int nRetSiz )
{
   // Call the specified function with the given parameters. Build a
   // proper stack and take care of correct return value processing.
   RESULT   Res = { 0 };
   int      i, nInd, nSize, nLoops;
   DWORD    dwEAX, dwEDX, dwVal, * pStack, dwStSize = 0;
   BYTE *   pArg;

   #if defined( __MINGW32__ )
   #elif defined( __BORLANDC__ ) || defined( __DMC__ )
   #else
   DWORD * pESP;
   #endif

   // Reserve 256 bytes of stack space for our arguments
   #if defined( __MINGW32__ ) || defined( __clang__ )
   asm volatile ( "\tmovl %%esp, %0\n"
                  "\tsubl $0x100, %%esp\n"
                  : "=r" ( pStack ) );
   #elif defined( __BORLANDC__ ) || defined( __DMC__ )
   pStack   = ( DWORD * ) _ESP;
   _ESP     -= 0x100;
   #else
   _asm mov pStack, esp
   _asm mov pESP, esp
   _asm sub esp, 0x100
   #endif

   // Push args onto the stack. Every argument is aligned on a
   // 4-byte boundary. We start at the rightmost argument.
   for( i = 0; i < nArgs; i++ )
   {
      nInd     = ( nArgs - 1 ) - i;
      // Start at the back of the arg ptr, aligned on a DWORD
      nSize    = ( Parm[ nInd ].nWidth + 3 ) / 4 * 4;
      pArg     = ( BYTE * ) Parm[ nInd ].pArg + nSize - 4;
      dwStSize += ( DWORD ) nSize; // Count no of bytes on stack

      nLoops   = ( nSize / 4 ) - 1;

      while( nSize > 0 )
      {
         // Copy argument to the stack
         if( Parm[ nInd ].dwFlags & DC_FLAG_ARGPTR )
         {
            // Arg has a ptr to a variable that has the arg
            dwVal = ( DWORD ) pArg; // Get first four bytes
            pArg  -= 4;             // Next part of argument
         }
         else
         {
            // Arg has the real arg
            dwVal = *( ( DWORD * ) ( ( BYTE * ) ( &( Parm[ nInd ].dwArg ) ) + ( nLoops * 4 ) ) );
         }

         // Do push dwVal
         pStack--;         // ESP = ESP - 4
         *pStack  = dwVal; // SS:[ESP] = dwVal
         nSize    -= 4;
         nLoops--;
      }
   }

   if( ( pRet != NULL ) && ( ( Flags & DC_BORLAND ) || ( nRetSiz > 8 ) ) )
   {
      // Return value isn't passed through registers, memory copy
      // is performed instead. Pass the pointer as hidden arg.
      dwStSize += 4;             // Add stack size
      pStack--;                  // ESP = ESP - 4
      *pStack  = ( DWORD ) pRet; // SS:[ESP] = pMem
   }
   #if defined( __MINGW32__ ) || defined( __clang__ )
   asm volatile ( "\taddl $0x100, %%esp\n"         /* Restore to original position */
                  "\tsubl %2, %%esp\n"             /* Adjust for our new parameters */

                                                   /* Stack is now properly built, we can call the function */
                  "\tcall *%3\n"
                  : "=a" ( dwEAX ), "=d" ( dwEDX ) /* Save eax/edx registers */
                  : "r" ( dwStSize ), "r" ( lpFunction ) );

   /* Possibly adjust stack and read return values. */
   if( Flags & DC_CALL_CDECL )
   {
      asm volatile ( "\taddl %0, %%esp\n" : : "r" ( dwStSize ) );
   }

   if( Flags & DC_RETVAL_MATH4 )
   {
      asm volatile ( "\tfstps (%0)\n" : "=r" ( Res ) );
   }
   else if( Flags & DC_RETVAL_MATH8 )
   {
      asm volatile ( "\tfstpl (%0)\n" : "=r" ( Res ) );
   }
   else if( pRet == NULL )
   {
      Res.Int           = dwEAX;
      ( &Res.Int )[ 1 ] = dwEDX;
   }
   else if( ( ( Flags & DC_BORLAND ) == 0 ) && ( nRetSiz <= 8 ) )
   {
      /* Microsoft optimized less than 8-bytes structure passing */
      ( ( int * ) pRet )[ 0 ] = dwEAX;
      ( ( int * ) pRet )[ 1 ] = dwEDX;
   }
   #elif defined( __BORLANDC__ ) || defined( __DMC__ )
   _ESP  += ( 0x100 - dwStSize );
   _EDX  = ( DWORD ) &lpFunction;
   __emit__( 0xff, 0x12 ); // call [edx];
   dwEAX = _EAX;
   dwEDX = _EDX;

   // Possibly adjust stack and read return values.
   if( Flags & DC_CALL_CDECL )
   {
      _ESP += dwStSize;
   }

   if( Flags & DC_RETVAL_MATH4 )
   {
      _EBX  = ( DWORD ) &Res;
      _EAX  = dwEAX;
      _EDX  = dwEDX;
      __emit__( 0xd9, 0x1b );   //     _asm fnstp float ptr [ebx]
   }
   else if( Flags & DC_RETVAL_MATH8 )
   {
      _EBX  = ( DWORD ) &Res;
      _EAX  = dwEAX;
      _EDX  = dwEDX;
      __emit__( 0xdd, 0x1b );   //     _asm fnstp qword ptr [ebx]
   }
   else if( pRet == NULL )
   {
      _EBX  = ( DWORD ) &Res;
      _EAX  = dwEAX;
      _EDX  = dwEDX;
//         _asm mov DWORD PTR [ebx], eax
//         _asm mov DWORD PTR [ebx + 4], edx
      __emit__( 0x89, 0x03, 0x89, 0x53, 0x04 );
   }
   else if( ( ( Flags & DC_BORLAND ) == 0 ) && ( nRetSiz <= 8 ) )
   {
      _EBX  = ( DWORD ) pRet;
      _EAX  = dwEAX;
      _EDX  = dwEDX;
//         _asm mov DWORD PTR [ebx], eax
//         _asm mov DWORD PTR [ebx + 4], edx
      __emit__( 0x89, 0x03, 0x89, 0x53, 0x04 );
   }
   #else
   _asm add esp, 0x100           // Restore to original position
   _asm sub esp, dwStSize        // Adjust for our new parameters

   // Stack is now properly built, we can call the function
   _asm call[ lpFunction ]

   _asm mov dwEAX, eax           // Save eax/edx registers
   _asm mov dwEDX, edx           //

   // Possibly adjust stack and read return values.
   if( Flags & DC_CALL_CDECL )
   {
      _asm add esp, dwStSize
   }

   if( Flags & DC_RETVAL_MATH4 )
   {
      _asm fstp dword ptr[ Res ]
   }
   else if( Flags & DC_RETVAL_MATH8 )
   {
      _asm fstp qword ptr[ Res ]
   }
   else if( pRet == NULL )
   {
      _asm mov eax, [ dwEAX ]
      _asm mov DWORD PTR[ Res ], eax
      _asm mov edx, [ dwEDX ]
      _asm mov DWORD PTR[ Res + 4 ], edx
   }
   else if( ( ( Flags & DC_BORLAND ) == 0 ) && ( nRetSiz <= 8 ) )
   {
      // Microsoft optimized less than 8-bytes structure passing
      _asm mov ecx, DWORD PTR[ pRet ]
      _asm mov eax, [ dwEAX ]
      _asm mov DWORD PTR[ ecx ], eax
      _asm mov edx, [ dwEDX ]
      _asm mov DWORD PTR[ ecx + 4 ], edx
   }

   _asm mov esp, pESP
   #endif

   return Res;
}

#endif

static void DllExec(int iFlags, FARPROC lpFunction, int iParams, int iFirst, int iArgCnt, PEXECSTRUCT xec)
{
#ifdef _WIN64
    DYNAPARM Parm[32];  // Ajusta el tamaño según sea necesario
    int i;
    for (i = 0; i < iArgCnt && i < 32; i++)
    {
        // Configurar Parm[i] basándose en los argumentos de Harbour
        // Esto dependerá de cómo estés pasando los argumentos desde Harbour
        if (HB_ISNUM(iFirst + i))
        {
            Parm[i].dwFlags = 0;
            Parm[i].qwArg = (DWORD64)hb_parnd(iFirst + i);
        }
        else if (HB_ISPOINTER(iFirst + i))
        {
            Parm[i].dwFlags = 0;
            Parm[i].pArg = hb_parptr(iFirst + i);
        }
        // Agregar más tipos según sea necesario
    }
    RESULT Res = DynaCall64(iFlags, lpFunction, iArgCnt, Parm, NULL, 0);
    // Manejar el resultado según sea necesario
    hb_retnint((HB_PTRDIFF)Res.Low);
#else
    int      iRtype;
   int      iCnt = 0;
//   int iCmode;
   int      i;
   DYNAPARM Parm[ 15 ];
   RESULT   rc;

   if( xec )
   {
      iFlags      = xec->dwFlags;
      lpFunction  = xec->lpFunc;

      //TODO Params maybe explictly specified in xec!
   }

//   iCmode = iFlags & 0xf000;  // Unsupported Mode (specifies XBase++ Function1)
   iRtype   = iFlags & 0x0f00;   // Return type - An additional flag over XBase++
   iFlags   = iFlags & 0x00ff;   // Calling Convention

   if( iRtype == 0 )
   {
      iRtype = CTYPE_UNSIGNED_LONG;
   }

   memset( Parm, 0, sizeof( Parm ) );

   if( iArgCnt > 0 )
   {
      for( i = iFirst; i <= iParams; i++ )
      {
         switch( hb_parinfo( i ) & ~HB_IT_BYREF )
         {
            case HB_IT_NIL:
               Parm[ iCnt ].nWidth  = sizeof( void * );
               Parm[ iCnt ].dwArg   = ( DWORD ) NULL;
               break;

            case HB_IT_POINTER:
               Parm[ iCnt ].nWidth  = sizeof( void * );
               Parm[ iCnt ].dwArg   = ( DWORD ) hb_parptr( i );

               if( hb_parinfo( i ) & HB_IT_BYREF )
               {
                  Parm[ iCnt ].pArg    = &( Parm[ iCnt ].dwArg );
                  Parm[ iCnt ].dwFlags = DC_FLAG_ARGPTR;  // use the pointer
               }
               break;

            case HB_IT_INTEGER:
            case HB_IT_LONG:
            case HB_IT_DATE:
            case HB_IT_LOGICAL:
               Parm[ iCnt ].nWidth  = sizeof( DWORD );
               Parm[ iCnt ].dwArg   = ( DWORD ) hb_parnl( i );

               if( hb_parinfo( i ) & HB_IT_BYREF )
               {
                  Parm[ iCnt ].pArg    = &( Parm[ iCnt ].dwArg );
                  Parm[ iCnt ].dwFlags = DC_FLAG_ARGPTR;  // use the pointer
               }
               break;

            case HB_IT_DOUBLE:
               Parm[ iCnt ].nWidth  = sizeof( double );
               Parm[ iCnt ].dArg    = hb_parnd( i );

               if( hb_parinfo( i ) & HB_IT_BYREF )
               {
                  Parm[ iCnt ].nWidth  = sizeof( void * );
                  Parm[ iCnt ].pArg    = &( Parm[ iCnt ].dArg );
                  Parm[ iCnt ].dwFlags = DC_FLAG_ARGPTR;  // use the pointer
               }

               iFlags |= DC_RETVAL_MATH8;
               break;

            case HB_IT_STRING:
            case HB_IT_MEMO:
               Parm[ iCnt ].nWidth = sizeof( void * );

               if( hb_parinfo( i ) & HB_IT_BYREF )
               {
                  Parm[ iCnt ].pArg = malloc( ( size_t ) hb_parclen( i ) );
                  HB_MEMCPY( Parm[ iCnt ].pArg, hb_parc( i ), ( size_t ) hb_parclen( i ) );
               }
               else
               {
                  Parm[ iCnt ].pArg = ( void * ) hb_parc( i );
               }

               Parm[ iCnt ].dwFlags = DC_FLAG_ARGPTR;  // use the pointer
               break;

            case HB_IT_ARRAY:
               if( strncmp( hb_objGetClsName( hb_param( i, HB_IT_ANY ) ), "C Structure", 11 ) == 0 )
               {
                  Parm[ iCnt ].nWidth  = sizeof( void * );
                  Parm[ iCnt ].dwArg   = ( DWORD ) hb_parcstruct( i );
                  break;
               }

            default:
               MessageBox( GetActiveWindow(), "UNKNOWN Parameter Type!", "DLLCall Parameter Error!", MB_OK | MB_ICONERROR );
               return;
         }

         iCnt++;
      }
   }

   /*SetLastError(0);*/
   rc = DynaCall( iFlags, lpFunction, iArgCnt, Parm, NULL, 0 );

   /*if( GetLastError() )
      {
      LPVOID lpMsgBuf;

      FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER |
      FORMAT_MESSAGE_FROM_SYSTEM,
      NULL,
      GetLastError(),
      MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
      (LPTSTR) &lpMsgBuf,
      0, NULL );

      MessageBox( GetActiveWindow(), (LPCSTR) lpMsgBuf, "DllExec:DynaCall() failed!", MB_OK | MB_ICONERROR );

      LocalFree(lpMsgBuf);
      }*/


   if( iArgCnt > 0 )
   {
      iCnt = 0;

      for( i = iFirst; i <= iParams; i++ )
      {
         if( hb_parinfo( i ) & HB_IT_BYREF )
         {
            switch( hb_parinfo( i ) & ~HB_IT_BYREF )
            {
               case HB_IT_NIL:
                  hb_stornl( Parm[ iCnt ].dwArg, i );
                  break;

               case HB_IT_POINTER:
                  hb_storptr( ( void * ) Parm[ iCnt ].dwArg, i );
                  break;

               case HB_IT_INTEGER:
               case HB_IT_LONG:
               case HB_IT_DATE:
               case HB_IT_LOGICAL:
                  hb_stornl( Parm[ iCnt ].dwArg, i );
                  break;

               case HB_IT_DOUBLE:
                  hb_stornd( Parm[ iCnt ].dArg, i );
                  break;

               case HB_IT_STRING:
               case HB_IT_MEMO:
                  hb_storclen( ( char * ) Parm[ iCnt ].pArg, hb_parclen( i ), i );
                  free( Parm[ iCnt ].pArg );
                  break;

               case HB_IT_ARRAY:
                  if( strncmp( hb_objGetClsName( hb_param( i, HB_IT_ANY ) ), "C Structure", 11 ) == 0 )
                  {
                     hb_vmPushSymbol( pDEVALUE->pSymbol );
                     hb_vmPush( hb_param( i, HB_IT_ANY ) );
                     hb_vmSend( 0 );

                     break;
                  }

               default:
                  MessageBox( GetActiveWindow(), "UNKNOWN Parameter Type!", "DLLCall Parameter Error!", MB_OK | MB_ICONERROR );
                  return;
            }
         }

         iCnt++;
      }
   }

   // return the correct value
   switch( iRtype )
   {
      case CTYPE_BOOL:
         hb_retl( ( BOOL ) rc.Long );
         break;

      case CTYPE_VOID:
         hb_retni( 0 );
         break;

      case CTYPE_CHAR:
      case CTYPE_UNSIGNED_CHAR:
         hb_retni( ( char ) rc.Int );
         break;

      case CTYPE_SHORT:
      case CTYPE_UNSIGNED_SHORT:
         hb_retni( ( int ) rc.Int );
         break;

      case CTYPE_INT:
         hb_retni( ( int ) rc.Long );
         break;

      case CTYPE_LONG:
         hb_retnl( ( LONG ) rc.Long );
         break;

      case CTYPE_CHAR_PTR:
      case CTYPE_UNSIGNED_CHAR_PTR:
         hb_retc( ( char * ) rc.Long );
         break;

      case CTYPE_UNSIGNED_INT:
      case CTYPE_UNSIGNED_LONG:
         hb_retnl( rc.Long );
         break;

      case CTYPE_INT_PTR:
      case CTYPE_UNSIGNED_SHORT_PTR:
      case CTYPE_UNSIGNED_INT_PTR:
      case CTYPE_STRUCTURE_PTR:
      case CTYPE_LONG_PTR:
      case CTYPE_UNSIGNED_LONG_PTR:
      case CTYPE_VOID_PTR:
      case CTYPE_FLOAT_PTR:
      case CTYPE_DOUBLE_PTR:
         hb_retptr( ( void * ) rc.Long );
         break;

      case CTYPE_FLOAT:
         hb_retnd( rc.Float );
         break;

      case CTYPE_DOUBLE:
         hb_retnd( rc.Double );
         break;

      default:
         MessageBox( GetActiveWindow(), "Unknown return type!", "DLLCall Parameter Error!", MB_OK | MB_ICONERROR );
         break;
   }
   #endif
}

HB_FUNC( DLLEXECUTECALL )
{
   int iParams = hb_pcount();
   int iFirst = 2;
   int iArgCnt = iParams - 1;
   PEXECSTRUCT xec = ( PEXECSTRUCT ) hb_parptr( 1 );

   if( xec != NULL )
   {
      if( xec->dwType == EXEC_DLL )
      {
         if( xec->hDLL != NULL )
         {
            if( xec->lpFunc != NULL )
            {
               DllExec( 0, xec->lpFunc, iParams, iFirst, iArgCnt, xec );
            }
         }
      }
   }
}

HB_FUNC( DLLCALL )
{
   int iParams = hb_pcount();
   int iFirst = 4;
   int iArgCnt = iParams - 3;
   int iFlags;
   BOOL lUnload = FALSE;
   HMODULE hInst;
   FARPROC lpFunction;
   BYTE cFuncName[ MAX_PATH ];

   if( HB_ISCHAR( 1 ) )
   {
      hInst = LoadLibrary( hb_parc( 1 ) );
      lUnload = TRUE;
   }
   else
   {
      hInst = ( HMODULE ) hb_parptr( 1 );
   }

   if( hInst == NULL )
   {
      hb_ret();
      return;
   }

   iFlags = hb_parni( 2 );

   if( ( lpFunction = GetProcAddress( hInst,
                                      HB_ISCHAR( 3 ) ? ( LPCSTR ) hb_parcx( 3 ) :
                                      ( LPCSTR ) ( DWORD_PTR ) hb_parnint( 3 ) ) ) == 0 )
   {
      if( HB_ISCHAR( 3 ) )
      {
         hb_xstrcpy( ( char * ) cFuncName, hb_parc( 3 ), 0 );
         hb_xstrcat( ( char * ) cFuncName, "A", 0 );
         lpFunction = GetProcAddress( hInst, ( const char * ) cFuncName );
      }
   }

   if( lpFunction != NULL )
   {
      DllExec( iFlags, lpFunction, iParams, iFirst, iArgCnt, NULL );
   }

   if( lUnload )
   {
      FreeLibrary( hInst );
   }
}

#endif /* NODLL */

HB_FUNC( LOADLIBRARY )
{
   hb_retptr( ( void * ) LoadLibraryA( ( LPCSTR ) hb_parcx( 1 ) ) );
}

HB_FUNC( FREELIBRARY )
{
   hb_retl( FreeLibrary( ( HMODULE ) hb_parptr( 1 ) ) );
}

HB_FUNC( GETLASTERROR )
{
   hb_retnint( ( HB_PTRDIFF ) GetLastError() );
}

HB_FUNC( SETLASTERROR )
{
   hb_retnint( ( HB_PTRDIFF ) GetLastError() );
   SetLastError( ( DWORD ) hb_parnint( 1 ) );
}

// compatibility
HB_FUNC( DLLLOAD )
{
   HB_FUNCNAME( LOADLIBRARY ) ();
}

// compatibility
HB_FUNC( DLLUNLOAD )
{
   HB_FUNCNAME( FREELIBRARY ) ();
}

#pragma ENDDUMP
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41858
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xHarbour 64 bits y xbScritp - (Solucionado)

Postby Cgallegoa » Mon Sep 16, 2024 8:21 pm

Funciona perfecto en 64 bits, pero el mismo código en 32 bits al momento de compilación genera:
Error: Unresolved external '_dv_memcpy' referenced from C:\FWH-24.07\SAMPLES\PRUEBA1.OBJ


Recuerda que en FWH-24.07 32 bits funciona perfecto con lo que se descarga de https://github.com/ronpinkas/xbScript. El problema era con 64 bits.

En mi modesto conocimiento creo que se debe dejar tal cual está para 32 bits e incorporar sólo las modificaciones que se relacionen con los 64 bits, si es posible.

O, en el script de compilación poner condición "ifdef __64__" incluya "modifxbscrip.c" (con el código en c que has creado)
Saludos,

Carlos Gallego

*** FWH-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***
Cgallegoa
 
Posts: 463
Joined: Sun Oct 16, 2005 3:32 am
Location: Quito - Ecuador

Re: xHarbour 64 bits y xbScritp - (Solucionado)

Postby Enrico Maria Giordano » Mon Sep 16, 2024 9:01 pm

This is a console sample I'm using (from xHarbour docs). It crashes at DLLEXECUTECALL():

Code: Select all  Expand view
#define DC_CALL_STD 0x20


FUNCTION MAIN()

    LOCAL cString := "Hello World"
    LOCAL nWideLen := 2 * LEN( cString )
    LOCAL cWideChar := REPLICATE( CHR( 0 ), nWideLen )

    LOCAL pCallTemplate := DLLPREPARECALL( "kernel32.dll", DC_CALL_STD, "MultiByteToWideChar" )
    LOCAL nRet := DLLEXECUTECALL( pCallTemplate, 0, 0, cString, -1, @cWideChar, nWideLen )

    ? nRet

    INKEY( 0 )

    RETURN NIL
User avatar
Enrico Maria Giordano
 
Posts: 8512
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Previous

Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 35 guests