Traducir VB a C

Traducir VB a C

Postby José Vicente Beltrán » Fri Jul 01, 2016 2:09 pm

Hola foro, como los asiduos podrán comprobar, cada cierto tiempo insisto con este tema por si alguien puede ayudarme.
Mi solicitud es si alguien puede traducir el codigo que adjunto de VB a Codigo C para poder incrustarlo dentro de FW, ya que no domino C ni de lejos y directamente el codigo FW no funciona.
El código en VB es
Code: Select all  Expand view
Dim des As String * 15000
Dim paginahtml As String * 4096
Dim ret As Long
Dim edi As string
Dim nif As String
Dim wadedinet As New OAdedinet

ret = wadedinet.Adedinet(nif, edi, des, paginahtml)


El código traducido a FW por mi (que no funciona) es
Code: Select all  Expand view
static function pruebasedi()
local edi := strtran( memoread("E:\edi.exp"), hb_osnewline(), "" )
local nif := "11112792R"
local ret := 0
public wadedinet := CreateObject( "Adedinet.OAdedinet" )
public des := Space(15000)
public paginahtml := space(4096)

ret := Adedinet(nif, edi, @des, @paginahtml)

msginfo( ret, "RET")
msginfo( des, "DES")
msginfo(paginahtml, "PAGINAHTML")
return .t.
 


La funcion debe pasar a una Dll instalada previamente (adedinet.dll) y de uso publico de la Agencia Tributaria española, un NIF (nif) y un archivo plano (edi), y recibir un archivo plano conteniendo la respuesta (des) mas un archivo html (paginahtml).
La función en FW devuelve ret = 0 (significa que no hay errores), pero los archivos des y paginahtml regresan vacios siempre.

Gracias por su tiempo
Saludos
User avatar
José Vicente Beltrán
 
Posts: 282
Joined: Mon Oct 10, 2005 8:55 am
Location: Algeciras, España

Re: Traducir VB a C

Postby hmpaquito » Fri Jul 01, 2016 3:11 pm

José Vicente,

Leyendo http://www.lawebdelprogramador.com/foro ... 8-dll.html

Pareciera que la variable edi ha de contener el nombre y ruta del fichero edi. Ojo con mayusculas/ minusculas.

Salu2
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: Traducir VB a C

Postby hmpaquito » Fri Jul 01, 2016 3:14 pm

Por cierto,

Acabo de comprobar el NIF 11112792R y parece que es un nif erroneo: tendria que ser 11112792C.

Es probable que con parametros erroneos no devuelva ningun tipo de resultado
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: Traducir VB a C

Postby José Vicente Beltrán » Fri Jul 01, 2016 4:14 pm

Gracias por responder,
Ya habia leido el post de referencia, pero despues de retocar segun tus sugerencias sigue sin funcionar, es por eso que queria probar con la version en C si alguien pudiera traducirla.
Saludos
User avatar
José Vicente Beltrán
 
Posts: 282
Joined: Mon Oct 10, 2005 8:55 am
Location: Algeciras, España

Re: Traducir VB a C

Postby hmpaquito » Fri Jul 01, 2016 4:45 pm

Aquí está la versión en C++, pero parece que tampoco les funciona.
https://www.c-plusplus.net/forum/45888-full
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: Traducir VB a C

Postby José Vicente Beltrán » Fri Jul 01, 2016 5:03 pm

Gracias de nuevo, este enlace no lo conocía, pero se deduce que la cosa es mas complicada de lo que parece. :shock:
User avatar
José Vicente Beltrán
 
Posts: 282
Joined: Mon Oct 10, 2005 8:55 am
Location: Algeciras, España

Re: Traducir VB a C

Postby hmpaquito » Fri Jul 01, 2016 5:06 pm

Bueno... ahí parece que han implementado el acceso OLE al OCX a nivel de C.
Yo creo que lo que tu necesitas es el interfaz C para acceder el objeto OLE.

A ver si algún master le hinca el diente y nos lo explica mejor.
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: Traducir VB a C

Postby Antonio Linares » Fri Jul 01, 2016 5:24 pm

Prueba asi:

ret := Adedinet( AnsiToWide( nif ), AnsiToWide( edi ), @des, @paginahtml)
regards, saludos

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

Re: Traducir VB a C

Postby José Vicente Beltrán » Sat Jul 02, 2016 8:22 am

Gracias Antonio,
En este caso AnsiToWide() no funciona.
...... peeeeero, debemos estar muy cerca porque despues de algunos retoques, 'ret' ya devuelve los códigos correctos, y no hay errores.
El problema que falta por solucionar es que cuando 'ret' = 0, 'des' y 'paginahtml' deberian devolver la información correspondiente ... y SIEMPRE estan VACIOS.
La llamada a la funcion contenida en la DLL queda como sigue:
Code: Select all  Expand view
local edi := StrTran(memoread("E:\edi.EXP"), hb_osnewline(), "")
local nif := "11112792C"
local des := space(Len(edi)*2+5000)
local paginahtml := space(25000)
private wadedinet := CreateObject( "Adedinet.OAdedinet" )

ret := wadedinet:Adedinet(nif, edi, @des, @paginahtml)


Adjunto el codigo fuente de la funcion a la que se llama dentro de la DLL por si alguien puede interpretarla y dar con la solución de como se le deben pasar los parámetros:
Code: Select all  Expand view
// OAdedinet.cpp : Implementation of COAdedinet
#include "stdafx.h"
#include "Adedinet.h"
#include "OAdedinet.h"
#include "FirmaDigital.h"
#include "seleccion.h"
#include "conexion.h"
#include "respuesta.h"
#include "Edifact.h"
#include "Entorno.h"
#include "AceptCancel.h"

/////////////////////////////////////////////////////////////////////////////
// COAdedinet

STDMETHODIMP COAdedinet::Adedinet(BSTR Nif, BSTR Edi, BSTR Descripcion, BSTR PaginaHtml, long* retorno)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
   
    // TODO: Add your implementation code here
    USES_CONVERSION;
    BSTR temp;
    FirmaDigital F;
    seleccion S;
    conexion CI;
    long ret;  // DWORD
    LPTSTR Datos_Envio;
    PCCERT_CONTEXT pCertContextSelFirma;
    PCCERT_CONTEXT pCertContextSelAutent;

    CERT_CONTEXT CertContext;
    LPTSTR Pagina_Respuesta;

    respuesta R;
    char buffer[13];
    char resultado[14];
    unsigned long pp;
    Edifact E;     
    Entorno EN;

    AceptCancel Dialogo;

    char Descrip[500];

    // pasar a ansi
    Nif = (BSTR)W2A(Nif);
    Edi = (BSTR)W2A(Edi);

    put_descripcion( L"" );
    put_paginahtml( L"" );
    // Validar entorno

    if ( ( ret = EN.Validar_Entorno()) != 0 )
    {
        R.Error_Descripcion(ret, Descrip);
        temp = (BSTR)A2W( (char*) Descrip);
        if ( Descripcion)
            wcscpy(Descripcion,temp);
        put_descripcion( temp );
       
        *retorno= ret;
        return S_OK;
    }

    // Validar fichero EDIFACT

    if ( ( ret = E.Comprobar_Edifact(( char*)Edi)) != 0 )
    {
        R.Error_Descripcion(ret, Descrip);
        temp = (BSTR)A2W( (char*) Descrip);
        if ( Descripcion)
            wcscpy(Descripcion,temp);
        put_descripcion( temp );
       
        *retorno= ret;
        return S_OK;
    }

    // Certificados. Para firma y para autentificacion.
    pCertContextSelFirma = S.FindCertContext((char*)Nif, (unsigned long*)&ret, MODO_FIRMA);
    if (ret!=0)     {
        pCertContextSelFirma = S.FindCertContext2((char*)Nif, (unsigned long*)&ret);
    }
    pCertContextSelAutent = S.FindCertContext((char*)Nif, (unsigned long*)&ret, MODO_AUTENTICACION);
   
    if ( ret == 0 )
    {
        // Reserva de memoria paea el envio
        int lenvio = lstrlen((char*)Edi);
        Datos_Envio = new char [lenvio*2+5000]; //[500000]

        ret = F.Firma( (char*)Edi,pCertContextSelFirma, Datos_Envio);
        if ( ret == 0 )
        {
            // Reserva de espacio para la recepcion
            Pagina_Respuesta = new char [65000]; // [4016]

//          ret = CI.ConexionInternet(CertContext,Datos_Envio, Pagina_Respuesta);

// Alerta del envio.
//          Dialogo.m_texto = Datos_Envio;
//          int RetModal;
//          Dialogo.CenterWindow();
//          RetModal = Dialogo.DoModal();
//          if (RetModal == IDOK)
                ret = CI.ConexionInternet(pCertContextSelAutent,Datos_Envio, Pagina_Respuesta);
//          else
//              ret = 2011;   // Se cancelo el envio.

            if ( ret == 0)
            {
                // Pagina HTML
                temp = (BSTR)A2W( (char*) Pagina_Respuesta);
                if ( PaginaHtml)
                    wcscpy(PaginaHtml,temp);
                put_paginahtml( temp );

                /* ********************* */
               
                //MessageBox( NULL, (char*) Pagina_Respuesta, "ASCII", MB_OK );
                //MessageBoxW( NULL, PaginaHtml, L"UNICODE", MB_OK );
                //strcpy((char*) PaginaHtml,Pagina_Respuesta);

                /* ********************* */

                // Controlar los codigos devueltos
                ret = R.Trata_Respuesta(Pagina_Respuesta);
                if ( ret == 0 )
                {   // respuesta
                    temp = (BSTR)A2W( (char*) Pagina_Respuesta);
                    if ( Descripcion)
                        wcscpy(Descripcion,temp);
                    put_descripcion( temp );
       
                }
                else if ( ret < 600001)
                        {
                            // Descripcion del error, bola 5 y 6
                            temp = (BSTR)A2W( (char*) Pagina_Respuesta);
                            if ( Descripcion)
                                wcscpy(Descripcion,temp);
                            put_descripcion( temp );
                        }
                     else
                        {
                            R.Error_Descripcion(ret, Descrip);
                            temp = (BSTR)A2W( (char*) Descrip);
                            if ( Descripcion )
                                wcscpy(Descripcion,temp);
                            put_descripcion( temp );
       
                        }
            }   
            else
            {
                // Descripcion del error, fallo bola 5
                R.Error_Descripcion(ret, Descrip);
                temp = (BSTR)A2W( (char*) Descrip);
                if ( Descripcion)
                    wcscpy(Descripcion,temp);
                put_descripcion( temp );
                ret = 500000 + ret;
            }
           
            delete Pagina_Respuesta;
        }
        else
        {
            // Descripcion de error, fallo bola 4
            if (ret < 400041 || ret > 400045)
            {   
                R.Error_Descripcion(ret, Descrip);
                ret = 400000 + ret;
            }
            else
            {
                R.Error_Descripcion(ret, Descrip);
               
            }
            temp = (BSTR)A2W( (char*) Descrip);
            if ( Descripcion)
                wcscpy(Descripcion,temp);
            put_descripcion( temp );
       
        }

        delete Datos_Envio;

        *retorno= ret;
        return S_OK;
    }
    else
    {
        //Descripcion de error, fallo en bola 3
        if (ret < 300041 )
        {   
            R.Error_Descripcion(ret, Descrip);
            ret = 300000 + ret;
        }
        else
        {
            R.Error_Descripcion(ret, Descrip);
            if ( ret > 300048 )
            {
                // Adecuar numero de error
                strcpy(resultado,"3");
                pp=ret;
                _ultoa(pp,buffer,10);
                strcat (resultado,buffer);  
                ret = atol(resultado);
            }
        }
        temp = (BSTR)A2W( (char*) Descrip);
        if ( Descripcion)
            wcscpy(Descripcion,temp);
        put_descripcion( temp );
        *retorno= ret;
        return S_OK;
    }

    return S_OK;
}

STDMETHODIMP COAdedinet::get_descripcion(BSTR *pVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    *pVal = ::SysAllocString( m_Descripcion );

    return S_OK;
}

STDMETHODIMP COAdedinet::put_descripcion(BSTR newVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here
    if ( m_Descripcion )
    {
        ::SysFreeString( m_Descripcion );
    }

    m_Descripcion = ::SysAllocString( newVal );

    return S_OK;
}

STDMETHODIMP COAdedinet::get_paginahtml(BSTR *pVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    *pVal = ::SysAllocString( m_PaginaHtml );

    return S_OK;
}

STDMETHODIMP COAdedinet::put_paginahtml(BSTR newVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    if ( m_PaginaHtml )
    {
        ::SysFreeString( m_PaginaHtml );
    }

    m_PaginaHtml = ::SysAllocString( newVal );

    return S_OK;
}
 


Ni que decir tiene que cuando no hay errores, 'ret' deberia devolver siempre '0' seguido de 'des' y 'paginahtml' con su información.
justo lo que hace ahora pero 'des' y 'paginahtml' vacios.

¡Que cerquita estamos! :oops:
User avatar
José Vicente Beltrán
 
Posts: 282
Joined: Mon Oct 10, 2005 8:55 am
Location: Algeciras, España

Re: Traducir VB a C

Postby Antonio Linares » Sat Jul 02, 2016 8:48 am

José Vicente,

BSTR es una cadena unicode, y los parámetros que espera son de tipo BSTR:

https://msdn.microsoft.com/es-es/library/windows/desktop/ms221069(v=vs.85).aspx

Por eso te sugerí que probases con AnsiToWide()
regards, saludos

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

Re: Traducir VB a C

Postby Antonio Linares » Sat Jul 02, 2016 8:59 am

Es diferente a Unicode, pues lleva delante 4 bytes con su longitud y dos ceros al final como se explica aqui:

Length prefix A four-byte integer that contains the number of bytes in the following data string. It appears immediately before the first character of the data string. This value does not include the terminating null character.
Data string A string of Unicode characters. May contain multiple embedded null characters.
Terminator Two null characters.


La forma recomendada de construir esas cadenas es:

BSTR MyBstr = SysAllocString(L"I am a happy BSTR");

En nuestro caso sería, SysAllocString( AnsiToWide( "I am a happy BSTR" ) )

Buscando la forma de implementar SysAllocString() he revisado los fuentes de FWH y Harbour y solo
he encontrado una función en la que se usa:

Code: Select all  Expand view
static BSTR hb_oleItemToString( PHB_ITEM pItem )
{
   UINT uiStrLen = ( UINT ) hb_itemCopyStrU16( pItem, HB_CDP_ENDIAN_NATIVE,
                                               NULL, UINT_MAX );
   BSTR strVal = SysAllocStringLen( NULL, uiStrLen );

   hb_itemCopyStrU16( pItem, HB_CDP_ENDIAN_NATIVE, strVal, uiStrLen + 1 );

   return strVal;
}


Necesitamos implementar la función SysAllocString() fijándonos en ese código
regards, saludos

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

Re: Traducir VB a C

Postby Antonio Linares » Sat Jul 02, 2016 9:02 am

Mira lo que comenta aqui:

If you pass a simple Unicode string as an argument to a COM function that is expecting a BSTR, the COM function will fail.


Si se usa una simple cadena unicode (como hemos hecho con AnsiToWide()) la función fallará
regards, saludos

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

Re: Traducir VB a C

Postby Antonio Linares » Sat Jul 02, 2016 9:12 am

Prueba con esta función SysAllocString()

Code: Select all  Expand view
#pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>
#include <hbstack.h>
#include <hbapicdp.h>

HB_FUNC( SYSALLOCSTRING )
{
   BSTR strVal = SysAllocString( ( WCHAR * ) hb_parc( 1 ) );

   hb_itemCopyStrU16( hb_stackReturnItem(), HB_CDP_ENDIAN_NATIVE, strVal, hb_parclen( 1 ) + 1 );

  SysFreeString( strVal );
}

#pragma ENDDUMP
 

Desde tu código haz:

ret := Adedinet( SysAllocString( AnsiToWide( nif ) ), SysAllocString( AnsiToWide( edi ) ), @des, @paginahtml)
regards, saludos

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

Re: Traducir VB a C

Postby José Vicente Beltrán » Sat Jul 02, 2016 4:27 pm

Antonio me perdonarás el peñazo, pero al compilar me sale el error:

Error E2451 wmaster.prg 3514: Undefined symbol 'HB_CDP_ENDIAN_NATIVE' in function HB_FUN_SYSALLOCSTRING
Warning W8065 wmaster.prg 3514: Call to function 'hb_itemCopyStrU16' with no prototype in function HB_FUN_SYSALLOCSTRING
:roll:
User avatar
José Vicente Beltrán
 
Posts: 282
Joined: Mon Oct 10, 2005 8:55 am
Location: Algeciras, España

Re: Traducir VB a C

Postby Antonio Linares » Sat Jul 02, 2016 7:46 pm

Tienes que añadir:

#include <hbapistr.h>
regards, saludos

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

Next

Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 95 guests