FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin para Harbour/xHarbour xHarbour 64 bits y xbScritp - (Solucionado)
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 06:42 PM
Carlos,

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

carlos.prg
Code (fw): Select all Collapse
#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
Posts: 514
Joined: Sun Oct 16, 2005 03:32 AM
Re: xHarbour 64 bits y xbScritp - (Solucionado)
Posted: Mon Sep 16, 2024 06:56 PM
Maestro, funcion贸 en FWH64. :D
Perfecto FWH-24.07 :D

Maestro muchas gracias, ahora lo del pdfharu.

Un abrazo,

Saludos,



Carlos Gallego



*** FWH-25.12, xHarbour 1.3.1 Build 20241008, Borland C++7.70, PellesC, ADS 11.1***

Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 07: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
Posts: 514
Joined: Sun Oct 16, 2005 03:32 AM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 07: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 :)

Saludos,



Carlos Gallego



*** FWH-25.12, xHarbour 1.3.1 Build 20241008, Borland C++7.70, PellesC, ADS 11.1***

Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 07:09 PM
Genial! :-D
regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 07:12 PM
Esta parte es la que falta copiar del anterior fichero dllcall.c:
Code (fw): Select all Collapse
#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
Posts: 514
Joined: Sun Oct 16, 2005 03:32 AM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 07: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-25.12, xHarbour 1.3.1 Build 20241008, Borland C++7.70, PellesC, ADS 11.1***

Posts: 9020
Joined: Thu Oct 06, 2005 08:17 PM
Re: xHarbour 64 bits y xbScritp - (Solucionado)
Posted: Mon Sep 16, 2024 07:24 PM
Code (fw): Select all Collapse
error C2065: 'DC_FLAG_FLOAT': undeclared identifier
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: xHarbour 64 bits y xbScritp - (Solucionado)
Posted: Mon Sep 16, 2024 07:27 PM

define DC_FLAG_FLOAT 0x1

regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: xHarbour 64 bits y xbScritp - (Solucionado)
Posted: Mon Sep 16, 2024 07: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 (fw): Select all Collapse
#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
Posts: 514
Joined: Sun Oct 16, 2005 03:32 AM
Re: xHarbour 64 bits y xbScritp - (Solucionado)
Posted: Mon Sep 16, 2024 08: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-25.12, xHarbour 1.3.1 Build 20241008, Borland C++7.70, PellesC, ADS 11.1***

Posts: 9020
Joined: Thu Oct 06, 2005 08:17 PM
Re: xHarbour 64 bits y xbScritp - (Solucionado)
Posted: Mon Sep 16, 2024 09:01 PM
This is a console sample I'm using (from xHarbour docs). It crashes at DLLEXECUTECALL():
Code (fw): Select all Collapse
#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
Posts: 670
Joined: Wed Oct 19, 2005 06:41 PM
Re: xHarbour 64 bits y xbScritp - (Solucionado)
Posted: Thu Oct 31, 2024 04:39 PM

Carlos buenos dias

Wilson Gamboa te saluda

me ha entrado curiosidad tu metodo de construccion de los programas yo estoy inicnaado algo parecido con fwh usando archivos hrb me funcioa muy bien peeeeroooooo ( siempre hay uno ) no he podido eliminar el tema de cargar en el exe los recursos y debo usarlos por eso segun yo pierdo la ventaja que tenia al necesitar cambiar el ejecutable principal por los recursos como hciste tu con ese tema con tu metodo

un abrazo y gracias por tu respuesta

pd: me avisas si tomas cafe para irte a visitar y obsequiarte un cafe que produzco para mi consumo ( vivo en Quito como tu )

Wilson 'W' Gamboa A
Wilson.josenet@gmail.com
Posts: 514
Joined: Sun Oct 16, 2005 03:32 AM
Re: xHarbour 64 bits y xbScritp - (Solucionado)
Posted: Sat Nov 02, 2024 04:25 PM
Wilson, buenos d铆as.

Disculpa no haber contestado antes.

Voy a preparar un ejemplo completo, y te lo env铆o con el c贸digo. Dame un d铆a.

Un abrazo, y claro que me encanta el caf茅, no puedo iniciar el d铆a sin una taza de caf茅 bien cargado, y luego en la tarde, otra para agradecer y festejar el d铆a que est谩 terminando :D

Saludos,



Carlos Gallego



*** FWH-25.12, xHarbour 1.3.1 Build 20241008, Borland C++7.70, PellesC, ADS 11.1***

Posts: 670
Joined: Wed Oct 19, 2005 06:41 PM
Re: xHarbour 64 bits y xbScritp - (Solucionado)
Posted: Mon Nov 04, 2024 07:19 PM

Carlos muchas gracias

no se, me pasas tu telefono por interno

fuerte abrazo

Wilson 'W' Gamboa A
Wilson.josenet@gmail.com