¿Como crear Interfaces?

Consultas sobre el lenguaje Pauscal

¿Como crear Interfaces?

Notapor PowerDeath » Jue Jun 18, 2015 12:52 am

Estoy escribiendo una nueva libreria que permite crear objetos COM en nuestros programas, pero no tengo la menor idea de como crear Interfaces funcionales.

Actualmente tengo un pequeño código que deberia emular una interface.

Código: Seleccionar todo
Prototipo pQueryInterface(:GUID,:Entero):Entero
Prototipo pAddRef(:Entero):Entero
Prototipo pRelease(:Entero):Entero

Prototipo pHrInit
Prototipo pAddTab(:Entero)
Prototipo pDeleteTab(:Entero)
Prototipo pActivateTab(:Entero)
Prototipo pSetActivateAlt(:Entero)

Estruc IUnknown,_
       QueryInterface:pQueryInterface,_
       AddRef:pAddRef,_
       Release:pRelease

Estruc ITaskbarList,_
       HrInit:pHrInit,_
       AddTab:pAddTab,_
       DeleteTab:pDeleteTab,_
       ActivateTab:pActivateTab,_
       SetActivateAlt:pSetActivateAlt


Pero la verdad, ya no se ni que estoy haciendo. ¿Alguna idea?
Imagen
PowerDeath
 
Mensajes: 160
Registrado: Sab Ago 11, 2012 5:29 am

Sponsor


Re: ¿Como crear Interfaces?

Notapor ErikH » Jue Jun 18, 2015 4:07 pm

Creo que ITaskbarList deberia quedar así:

Código: Seleccionar todo
Estruc ITaskbarList,_
       QueryInterface:pQueryInterface,_
       AddRef:pAddRef,_
       Release:pRelease,_
       HrInit:pHrInit,_
       AddTab:pAddTab,_
       DeleteTab:pDeleteTab,_
       ActivateTab:pActivateTab,_
       SetActivateAlt:pSetActivateAlt


Estos artículos parecen útiles para tus propositos:
ImagenEntrá a la wiki en OpenShift
Colofox!!!!
ErikH
 
Mensajes: 151
Registrado: Jue Nov 29, 2007 11:24 pm
Ubicación: Algún lugar de México

Re: ¿Como crear Interfaces?

Notapor PowerDeath » Vie Jul 03, 2015 9:26 pm

ErikH Ya leí el articulo, pero no he logrado crear una interface funcional, aunque CoCreateInstance no me provoque errores.

Tal vez te guste ver el código y me señales (si es que lo sabes) cuales son los errores.

Código: Seleccionar todo
Importar "Macros.prp"
Importar "Utiles.prp"
Importar "Matrices.prp"

Prototipo pQueryInterface(:Entero,:GUID,Referencia:Entero):Entero
Prototipo pAddRef(:Entero):Entero
Prototipo pRelease(:Entero):Entero

Prototipo pHrInit
Prototipo pAddTab(:Entero)
Prototipo pDeleteTab(:Entero)
Prototipo pActivateTab(:Entero)
Prototipo pSetActivateAlt(:Entero)

'Prototipo pQueryInterface(,:Entero):Entero
'Prototipo pAddRef(:Entero):Entero
'Prototipo pRelease(:Entero):Entero
Prototipo pRealloc(:Entero):Entero
Prototipo pAlloc(:Entero):Entero
Prototipo pDidAlloc(,:Entero):Entero
Prototipo pFree(,:Entero)
Prototipo pGetSize(,:Entero):Entero
Prototipo pHeapMinimize(,:Entero)

Estruc vTableIMALLOC,_
       QueryInterface:pQueryInterface,_
       AddRef:pAddRef,_
       Release:pRelease,_
       Alloc:pAlloc,_
       ReAlloc:pRealloc,_
       Free:pFree,_
       GetSize:pGetSize,_
       DidAlloc:pDidAlloc,_
       HeapMinimize:pHeapMinimize

Estruc IMALLOC,@Ptr:vTableIMALLOC

'Estruc IUnknown,_
'       QueryInterface:pQueryInterface,_
'       AddRef:pAddRef,_
'       Release:pRelease

Estruc vTableITaskbarList,_
       QueryInterface:pQueryInterface,_
       AddRef:pAddRef,_
       Release:pRelease,_
       HrInit:pHrInit,_
       AddTab:pAddTab,_
       DeleteTab:pDeleteTab,_
       ActivateTab:pActivateTab,_
       SetActivateAlt:pSetActivateAlt

Estruc ITaskbarList,@Ptr:vTableITaskbarList

Const E_ABORT = &80004004               ' Operación abortada
Const E_ACCESSDENIED = &80070005         ' Acceso general denegado error
Const E_FAIL = &80004005               ' Fallo inespecificado
Const E_HANDLE = &80070006               ' Identificador que no es valido
Const E_INVALIDARG = &80070057         ' Uno o mas argumentos no son validos
Const E_NOINTERFACE = &80004002         ' Interface no soportada
Const E_NOTIMPL = &80004001            ' No implementado
Const E_OUTOFMEMORY = &8007000E         ' Fallo al alojar la memoria nececaria
Const E_POINTER = &80004003            ' Puntero que no es valido
Const E_UNEXPECTED = &8000FFFF         ' Fallo inesperado
Const CLASS_E_NOAGGREGATION = &80040110

Const CLSCTX_INPROC_SERVER = &1
Const CLSCTX_INPROC_HANDLER = &2
Const CLSCTX_LOCAL_SERVER = &4
Const CLSCTX_INPROC_SERVER16 = &8
Const CLSCTX_REMOTE_SERVER = &10
Const CLSCTX_INPROC_HANDLER16 = &20
Const CLSCTX_RESERVED1 = &40
Const CLSCTX_RESERVED2 = &80
Const CLSCTX_RESERVED3 = &100
Const CLSCTX_RESERVED4 = &200
Const CLSCTX_NO_CODE_DOWNLOAD = &400
Const CLSCTX_RESERVED5 = &800
Const CLSCTX_NO_CUSTOM_MARSHAL = &1000
Const CLSCTX_ENABLE_CODE_DOWNLOAD = &2000
Const CLSCTX_NO_FAILURE_LOG = &4000
Const CLSCTX_DISABLE_AAA = &8000
Const CLSCTX_ENABLE_AAA = &10000
Const CLSCTX_FROM_DEFAULT_CONTEXT = &20000
Const CLSCTX_ACTIVATE_32_BIT_SERVER = &40000
Const CLSCTX_ACTIVATE_64_BIT_SERVER = &80000
Const CLSCTX_ENABLE_CLOAKING = &100000
Const CLSCTX_APPCONTAINER = &400000
Const CLSCTX_ACTIVATE_AAA_AS_IU = &800000
Const CLSCTX_PS_DLL = &80000000
Const CLSCTX_ALL = CLSCTX_INPROC_SERVER Or CLSCTX_INPROC_HANDLER Or CLSCTX_LOCAL_SERVER Or CLSCTX_REMOTE_SERVER

Proc CoCreateInstance(rclsid:GUID,pUnkOuter,dwClsContext:Entero,riid:GUID,Referencia IUnknown:Entero):Entero, "Ole32.dll"
Proc CLSIDFromString(GUID:Entero,Referencia Str:GUID):Entero, "Ole32.dll"
Proc CLSIDFromProgID(lpszProgID:Entero,Referencia lpclsid:GUID):Entero, "Ole32.dll"
Proc CoCreateGuid(Referencia riid:GUID):Entero, "Ole32.dll"
Proc StringFromGUID2(GUID:GUID,Referencia Str:Cadena,Len:Entero):Entero, "Ole32.dll"
Proc CoTaskMemFree(Opcional pv:Entero = 0), "Ole32.dll"
Proc ProgIDFromCLSID(clsid:Cadena,Referencia lplpszProgID:Cadena):Entero, "Ole32.dll"

'Const S_OK = &00000000
Const REGDB_E_CLASSNOTREG = &80040154
Const REGDB_E_READREGDB = &80040150
Const CO_E_CLASSSTRING = &800401F3

Proc MostrarGUID(Referencia GUID:GUID,Opcional Hex,Rellenar:Booleano,Opcional Título:Cadena = "Pauscal",Opcional Bandera:Entero)
   Si Hex Entonces
      Mensaje("Data1 = " + EntHex(GUID.Data1,Rellenar) + CrLf + _
              "Data2 = " + EntHex(GUID.Data2,Rellenar) + CrLf + _
              "Data3 = " + EntHex(GUID.Data3,Rellenar) + CrLf + _
              "Data4[0] = " + EntHex(GUID.Data4[0],Rellenar) + CrLf + _
              "Data4[1] = " + EntHex(GUID.Data4[1],Rellenar) + CrLf + _
              "Data4[2] = " + EntHex(GUID.Data4[2],Rellenar) + CrLf + _
              "Data4[3] = " + EntHex(GUID.Data4[3],Rellenar) + CrLf + _
              "Data4[4] = " + EntHex(GUID.Data4[4],Rellenar) + CrLf + _
              "Data4[5] = " + EntHex(GUID.Data4[5],Rellenar) + CrLf + _
              "Data4[6] = " + EntHex(GUID.Data4[6],Rellenar) + CrLf + _
              "Data4[7] = " + EntHex(GUID.Data4[7],Rellenar) + CrLf + _
              "GUID = " + GUIDCad(GUID),Título,Bandera)
   SiNo
      Mensaje("Data1 = " + EntCad(GUID.Data1) + CrLf + _
              "Data2 = " + EntCad(GUID.Data2) + CrLf + _
              "Data3 = " + EntCad(GUID.Data3) + CrLf + _
              "Data4[0] = " + EntCad(GUID.Data4[0]) + CrLf + _
              "Data4[1] = " + EntCad(GUID.Data4[1]) + CrLf + _
              "Data4[2] = " + EntCad(GUID.Data4[2]) + CrLf + _
              "Data4[3] = " + EntCad(GUID.Data4[3]) + CrLf + _
              "Data4[4] = " + EntCad(GUID.Data4[4]) + CrLf + _
              "Data4[5] = " + EntCad(GUID.Data4[5]) + CrLf + _
              "Data4[6] = " + EntCad(GUID.Data4[6]) + CrLf + _
              "Data4[7] = " + EntCad(GUID.Data4[7]) + CrLf + _
              "GUID = " + GUIDCad(GUID),Título,Bandera)
   FinSi
FinProc

Proc GenerarGUID:Cadena
   Var GUID:GUID
   Si CoCreateGuid(GUID) = 0 Entonces Resultado = GUIDCad(GUID)
FinProc

Proc GUIDCad(GUID:GUID):Cadena
   Resultado = Espacio(80)
   Si StringFromGUID2(GUID,Resultado,80) = 0 Entonces Resultado = "" ; Salir
   Resultado = UnicodeACad(Resultado)
FinProc

Proc CadGuid(Referencia Str:Cadena):GUID
   Var Caracteres[]:Cadena
   Caracteres = [Izquierda(Str,1),Derecha(Str,1),Parte(Str,2,CadLong(Str) - 1)]
   Si (Caracteres[0] <> "{") Y (Caracteres[1] <> "}") Entonces Salir
   Si CLSIDFromString(CadPtr(CadaUnicode(Str)),Resultado) <> 0 Entonces Salir
FinProc

Proc GUIDDeProgID(Referencia Str:Cadena):GUID
   Si CLSIDFromProgID(CadPtr(CadAUnicode(Str)),Resultado) <> S_OK Entonces Salir
FinProc

Proc COM_Iniciar
   CoInitialize
FinProc

Proc COM_CrearInstancia(Referencia GUID,IID:Cadena,Opcional Referencia Ptr:Entero):Entero
   Seleccionar CoCreateInstance(CadGUID(GUID),&0,CLSCTX_ALL,CadGUID(IID),>Ptr@?Ptr@:Resultado@)
      Caso 0
         Devolver Resultado@
      Caso REGDB_E_CLASSNOTREG
         GenerarError 1, "Una clase especificada no está registrada en la base de datos de registro."
      Caso CLASS_E_NOAGGREGATION
         GenerarError 2, "Esta clase no puede ser creado como parte de un agregado."
      Caso E_NOINTERFACE
         GenerarError 3, "La clase especificada no implementa la interfaz requerida, o el control de IUnknown no expone la interfaz solicitada."
      Caso E_POINTER
         GenerarError 4, "El parámetro ppv es NULO."
   FinSeleccionar
FinProc

Proc COM_Terminar
   CoUninitialize
FinProc


Const IID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
Const CLSID_TaskbarList = "{56FDF344-FD6D-11D0-958A-006097C9A090}"
Const IID_ITaskbarList = "{56FDF342-FD6D-11D0-958A-006097C9A090}"

Proc MostrarPtrs(PtrInit,Longt:Entero)
   Var i,@Ptr:Entero,Str:Cadena
   Ptr@ = PtrInit
   Mientras i <= (Longt\4)
      Ptr@ = Ptr@ + (4 * i)
      AdmErr
      Str = Str + "Metodo[" + EntCad(i) + "]: " + EntCad(Ptr) + CrLf
      Controlar
      
      FinAdmErr
      i = i + 1
   FinMientras
   Mensaje(Str)
FinProc

Proc A(B:Entero,C:GUID,Referencia D:Entero):Entero
   Mensaje(EntCad(B))
   MostrarGUID(C)
   D = B
FinProc

'Var @IUnknown:ITaskbarList,Ptr:Entero,L:GUID
'Ptr = IUnknown@
'Com_Iniciar
'   COM_CrearInstancia(CLSID_TaskbarList,IID_ITaskbarList,Ptr@)
'   'MostrarPtrs(IUnknown@,Long(IUnknown))
'   Eval IUnknown
'   AdmErr
'      .Ptr.QueryInterface(IUnknown@,CADGuid(CLSID_TaskbarList),Ptr)
'      Mensaje("Funciono!")
'   Controlar
'      Fin
'   FinAdmErr
'   FinEval
'   'Mensaje(EntCad(IUnknown.AddRef@))
'Com_Terminar


Estoy un toque desesperado xd
Al menos aprendí a simular Clases con estructuras y prototipos :lol:
Imagen
PowerDeath
 
Mensajes: 160
Registrado: Sab Ago 11, 2012 5:29 am

Re: ¿Como crear Interfaces?

Notapor PowerDeath » Dom Jul 05, 2015 7:55 pm

Por fin pude lograr que el código funcione!
Con esta libreria podemos implementar la tecnologia COM en Pauscal! Dios... Tanto estudio y pruebas rindio frutos :D
Imagen
PowerDeath
 
Mensajes: 160
Registrado: Sab Ago 11, 2012 5:29 am

Re: ¿Como crear Interfaces?

Notapor ErikH » Dom Jul 05, 2015 11:19 pm

:alabanza: ¡Felicidades! no pude pasar de REGDB_E_CLASSNOTREG con mi código de prueba.


Código: Seleccionar todo
'Archivo generado por Visual Pauscal
'El código de los eventos y demás procedimientos
'se encuentra al final de este archivo

$ADV-

Importar "PauscalW.prp"
'ITaskbarList3={EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}
'ITaskbarList={56FDF342-FD6D-11D0-958A-006097C9A090}


Const CLSCTX_INPROC_SERVER = &1
Const CLSCTX_INPROC_HANDLER = &2
Const CLSCTX_LOCAL_SERVER = &4
Const CLSCTX_INPROC_SERVER16 = &8
Const CLSCTX_REMOTE_SERVER = &10
Const CLSCTX_INPROC_HANDLER16 = &20
Const CLSCTX_RESERVED1 = &40
Const CLSCTX_RESERVED2 = &80
Const CLSCTX_RESERVED3 = &100
Const CLSCTX_RESERVED4 = &200
Const CLSCTX_NO_CODE_DOWNLOAD = &400
Const CLSCTX_RESERVED5 = &800
Const CLSCTX_NO_CUSTOM_MARSHAL = &1000
Const CLSCTX_ENABLE_CODE_DOWNLOAD = &2000
Const CLSCTX_NO_FAILURE_LOG = &4000
Const CLSCTX_DISABLE_AAA = &8000
Const CLSCTX_ENABLE_AAA = &10000
Const CLSCTX_FROM_DEFAULT_CONTEXT = &20000
Const CLSCTX_ACTIVATE_32_BIT_SERVER = &40000
Const CLSCTX_ACTIVATE_64_BIT_SERVER = &80000
Const CLSCTX_ENABLE_CLOAKING = &100000
Const CLSCTX_APPCONTAINER = &400000
Const CLSCTX_ACTIVATE_AAA_AS_IU = &800000
Const CLSCTX_PS_DLL = &80000000
Const CLSCTX_ALL = CLSCTX_INPROC_SERVER Or CLSCTX_INPROC_HANDLER Or CLSCTX_LOCAL_SERVER Or CLSCTX_REMOTE_SERVER

Prototipo pQueryInterface(:Entero,:GUID,Referencia:Entero):Entero
Prototipo pAddRef(:Entero):Entero
Prototipo pRelease(:Entero):Entero

Prototipo pHrInit
Prototipo pAddTab(:Entero)
Prototipo pDeleteTab(:Entero)
Prototipo pActivateTab(:Entero)
Prototipo pSetActivateAlt(:Entero)


Estruc GUID _
 ,Data1:Entero _
 ,Data2:Word _
 ,Data3:Word _
 ,Data4[8]:Byte

Estruc vTableITaskbarList,_
       QueryInterface:pQueryInterface,_
       AddRef:pAddRef,_
       Release:pRelease,_
       HrInit:pHrInit,_
       AddTab:pAddTab,_
       DeleteTab:pDeleteTab,_
       ActivateTab:pActivateTab,_
       SetActivateAlt:pSetActivateAlt
       
       
Estruc ITaskbarList,@Ptr:vTableITaskbarList

Proc CoCreateInstance(rclsid:Entero,pUnkOuter:Entero,dwClsContext:Entero,riid:Entero,IUnknown:Entero):Entero, "Ole32.dll"
Proc CoInitialize(:Entero):Entero, "Ole32.dll"
Proc CoUninitialize(), "Ole32.dll"


Proc RellenarGUID(Referencia n:GUID,l:Entero,w1:Word,w2:Word,b1,b2,b3,b4,b5,b6,b7,b8:Byte):GUID
  n.Data1=l
  n.Data2=w1
  n.Data3=w2
  n.Data4[0]=b1
  n.Data4[1]=b2
  n.Data4[2]=b3
  n.Data4[3]=b4
  n.Data4[4]=b5
  n.Data4[5]=b6
  n.Data4[6]=b7
  n.Data4[7]=b8
FinProc


Clase c_Form(pscForm)
Público:

  ClaseVar _
    Boton:pscBoton

Privado:
  Proc Init
    X=0
    Y=0
    Ancho=313
    Alto=85
    Texto="Formulario"
    Visible=Verd
    Habilitado=Verd
    PuedeCambiarDeTamaño=Verd
    BotonMaximizar=Verd
    BotonMinimizar=Verd
    MenuSistema=Verd
    Borde=Verd
    Eval Eventos
    FinEval
    CrearForm
    Crear Boton
    Eval Boton
      .Padre = EsteObjeto
      .X=8
      .Y=8
      .Ancho=168
      .Alto=25
      .Texto="Quitar de barra de tareas"
      .Visible=Verd
      .Habilitado=Verd
      Eval .Eventos
        .AlCliquear@=f0_Boton_AlCliquear@
      FinEval
    FinEval
  FinProc
Público:
  Proc CargarForm
    Si (hWnd=0)
      Init
      Boton.CargarBoton(hWnd)
      FormCargado
    FinSi
  FinProc
  Proc Mostrar(Opcional EsModal:Booleano)
    CargarForm
    Si (EsModal) MostrarModalInt; SiNo; MostrarInt
  FinProc

'Eventos

  Proc Boton_AlCliquear() Adelantado

FinClase

'Alias

Proc f0_Boton_AlCliquear()
  Form.Boton_AlCliquear()
FinProc


Var Form:c_Form

Proc CicloPrincipal
  CoInitialize(0)
  Crear Form
  Form.CargarForm
  Form.Mostrar
  Programa.Ejecutar
  CoUninitialize()
FinProc


'**************************************************

'Código de eventos y procedimientos
'definidos por el usuario

Proc c_Form.Boton_AlCliquear()
'
Var ITaskbarListGUID:GUID
Var objeto:Entero
Var hres:Entero
'Var hwnd:Entero
Var @TaskbarList:ITaskbarList
RellenarGUID(ITaskbarListGUID,&56fdf342,&fd6d,&11d0,&95,&8a,&00,&60,&97,&c9,&a0,&90)
hres = CoCreateInstance(ITaskbarListGUID@,0,CLSCTX_ALL,ITaskbarListGUID@,objeto@)
Si hres <> 0 Entonces GenerarError 1, "Fallo Create:"+EntHex(hres)
Si objeto = 0 Entonces GenerarError 1,"Fallo objeto"
TaskbarList@ = objeto
Si TaskbarList.Ptr@ = 0 Entonces GenerarError 1,"Fallo Ptr"
TaskbarList.Ptr.DeleteTab(hwnd)
FinProc


CicloPrincipal
Fin
ImagenEntrá a la wiki en OpenShift
Colofox!!!!
ErikH
 
Mensajes: 151
Registrado: Jue Nov 29, 2007 11:24 pm
Ubicación: Algún lugar de México

Re: ¿Como crear Interfaces?

Notapor PowerDeath » Lun Jul 06, 2015 1:15 am

Ni hablar, no puedo creer que por fin pude hacer andar estas venditas interfaces, en un ratico subo el código al repositorio, ahora estoy escribiendo un tutorial en mi blog sobre como crear Interfaces funcionales. Gracias por tratar de hacer funcionar la libreria :mrgreen:

Ahora la nueva tarea es crear interfaces COM para usar :grindance:
Imagen
PowerDeath
 
Mensajes: 160
Registrado: Sab Ago 11, 2012 5:29 am


Volver a Dudas, Preguntas y Respuestas

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 2 invitados

cron