DLL con sintaxis de VB6 / DLL with VB6 sintax

[César E. Lozada]

¿Tiene una llamada a una DLL en VB6 y quiere usarla en FWH sin traducirla? Aquí tiene cómo hacerlo.

Do you have a DLL call with VB6 sintax a you want to use it in FWH without translate it? Here you have how to make it.

Ejemplo / Example
****************************************************
#include "Fivewin.ch"
FUNCTION Test()
Local cUrl:="http://planteles.me.gob.ve/login.php?entrada"
Local cSaveAs:="temp"
Local nResult

nResult:=URLDownloadToFile(0, cURL, cSaveAs, 0, 0)

RETURN nil

*-----------------------------------------
#include "vbdll.ch"

// FWH entiende esta sintaxis / FWH understands this sintax

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ;
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ;
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

****************************************************

¿Cómo? // How?

Copiar lo siguiente en: / Copy this in
vb6dll.ch


//============================================
//vb6 dll calls translation to FWH
//Cesar Lozada, Los Teques, Venezuela (March 30, 2008)
//============================================

#ifndef _VBDLL_CH_
#define _VBDLL_CH_

#xTranslate ByVal <x> => <x>
#xTranslate ByRef <x> => @<x>
#xTranslate As Long => AS LONG
#xTranslate As Integer => AS LONG
#Translate As String => AS STRING
#Translate As Boolean => AS BOOL
#Translate As Any => AS LPSTR
#Translate As Pointer => AS LPSTR
#Translate As Void => AS VOID

#xTranslate NOREF( [@]<x> ) => <x>

#xTranslate _DLL_FUNCT_ <cFunction> PARAMS [<Par1> AS <Typ1>] [,<ParN> AS <TypN>] [AS <cRes>] [LIB <cLib>] [ALIAS <cAlias>] =>;
Local hDll:=DllHandle( <cLib> );;
Local uResult, cFarProc;;
IF Abs(hDll) > 32 ;;
cFarProc := GetProcAddress(hDLL, if( [Empty(<cAlias>) ==] .T., <(cFunction)>, <cAlias> ),;
.T.,<cRes> [,<Typ1>][,<TypN>]);;
uResult:= CallDll(cFarProc[,<Par1>][,<ParN>]);;
ELSE;;
MsgAlert("Error código "+Str(hDll,,,.T.)+" al cargar "+<(cFunction)>,"DLL CALL");;
ENDIF;;
return uResult

#xCommand Private Declare Function <cFunction> [LIB <cLib>] [ALIAS <cAlias>];
( [<Par1> AS <Typ1>] [,<ParN> AS <TypN>] ) [As <cRes>];
=>;
Static Function <cFunction>([NOREF(<Par1>)][,NOREF(<ParN>)]);;
_DLL_FUNCT_ <cFunction> PARAMS [<Par1> AS <Typ1>] [,<ParN> AS <TypN>] [AS <cRes>] [LIB <cLib>] [ALIAS <cAlias>]


#xCommand Public Declare Function <cFunction> [LIB <cLib>] [ALIAS <cAlias>];
( [<Par1> AS <Typ1>] [,<ParN> AS <TypN>] ) [As <cRes>];
=>;
Function <cFunction>([NOREF(<Par1>)][,NOREF(<ParN>)]);;
_DLL_FUNCT_ <cFunction> PARAMS [<Par1> AS <Typ1>] [,<ParN> AS <TypN>] [AS <cRes>] [LIB <cLib>] [ALIAS <cAlias>]

#xCommand Declare Function <cFunction> [LIB <cLib>] [ALIAS <cAlias>];
( [<Par1> AS <Typ1>][,<ParN> AS <TypN>] ) [As <cRes>];
=>;
Function <cFunction>([NOREF(<Par1>)][,NOREF(<ParN>)] );;
_DLL_FUNCT_ <cFunction> PARAMS [<Par1> AS <Typ1>] [,<ParN> AS <TypN>] [AS <cRes>] [LIB <cLib>] [ALIAS <cAlias>]

#endif


============================================

Agregar estas funciones a su código: / Add these functions to your code:

//============================================
Function DllHandle(cDll,lFree)
*-----------------------------------------------
* LoadLibrary (keeps handle in static array) or FreeLibrary (-ies)
* Sintax:
* DllHandle(cDll)....... (Load cDll or retrieve cDll handle) -> cDll handle
* DllHandle(cDll,.T.)... Free cDll handle
* DllHandle()............. Free all handles
*-----------------------------------------------
Local h, hDll:=0, u
Static ahDll
DEFAULT ahDll:={}
DEFAULT lFree:=(.F. .or. pCount()=0)
IF lFree
IF Empty(cDll)
aEval(ahDll,{|u| FreeLibrary(u[2])})
ahDll:={}
ELSEIF (h:=aScan(ahDll,{|u| u[1]==Upper(cDll) }))>0
FreeLibrary(ahDll[h,2])
aDel(ahDll,h); aSize(ahDll,Len(ahDll)-1)
ENDIF
ELSE
IF (h:=aScan(ahDll,{|u| u[1]==Upper(cDll) }))=0
hDll:=LoadLibrary(cDll)
aAdd(ahDll,{Upper(cDll),hDll})
h:=Len(ahDll)
ENDIF
hDll:=ahDll[h,2]
ENDIF
return hDll
*-----------------------------------------
EXIT PROCEDURE DllFreeAll()
DllHandle()
RETURN
*==========================================

[Antonio Linares]

César,

Muy bueno! gracias!

[Biel EA6DD]

Gran aporte Cesar, gracias.

[Otto]

César,

Thank you for this sample. I tried to compile this sample but get following error.

c:\fwhtests\806\tutor02.prg(27) Error E0021 Circularity detected in #translate: 'As'
c:\fwhtests\806\tutor02.prg(27) Error E0030 Syntax error: "syntax error at 'FUNCTION'"
c:\fwhtests\806\tutor02.prg(30) Warning W0007 Function 'MAIN' does not end with RETURN statement

Do you have a sample with a link file.
Thanks in advance
Otto

[CARLOS ATUNCAR]

César,

Thank you for this sample. I tried to compile this sample but get following error.

c:\fwhtests\806\tutor02.prg(27) Error E0021 Circularity detected in #translate: 'As'
c:\fwhtests\806\tutor02.prg(27) Error E0030 Syntax error: "syntax error at 'FUNCTION'"
c:\fwhtests\806\tutor02.prg(30) Warning W0007 Function 'MAIN' does not end with RETURN statement

Do you have a sample with a link file.
Thanks in advance
Otto

Saludos alguien tiene esta funcion operativa estoy tratando de usarla y me da un error

Application
===========
Path and name: G:\MySql\Gestion\demo\Gestion.exe (32 bits)
Size: 3,489,280 bytes
Compiler version: xHarbour 1.2.3 Intl. (SimpLex) (Build 20141106)
FiveWin Version: FWHX 15.07
Windows version: 6.2, Build 9200

Time from start: 0 hours 0 mins 12 secs
Error occurred at: 19/10/2016, 18:56:49
Error description: Error BASE/1003 No existe la variable: LONG

Stack Calls
===========
Called from: Bin\ruc.prg => URLDOWNLOADTOFILE( 0 )
Called from: Bin\ruc.prg => BRUC( 232 )
Called from: Bin\ruc.prg => (b)ADDREG( 141 )
Called from: .\source\classes\TGET.PRG => TGET:LVALID( 1207 )

[Antonio Linares]

Prueba a añadir este fichero de cabecera a tu PRG:

#include "FiveWin.ch"
#include "dll.ch"