CryptEnumOIDInfo y Callback a puro Fox

Fernando Mora

unread,

Sep 13, 2019, 11:18:06 PM9/13/19

to Comunidad de Visual Foxpro en Español

Saludos Foxeros!

Trabajando con CryptoApi, me tope con las funciones que usan punteros de función (callback), un gran obstáculo, ya que Fox no tiene una forma propia de usar callback. Busque en la web y todo apuntaba que obligatorio tenia que crear una fll en C++ o usar una de las que circulan en las redes, cosa que he venido evitando a toda costa, tener que usar fll o dll de otros lenguajes. Por suerte ya alguien creo una forma de sortear esto. Usando control de proceso y pasando datos binarios directos a este proceso y enlazándolo con Bindevent a la función que deseamos llamar se logra tener un puntero de llamada a función.

Comparto como usar Callback en Fox, en este ejemplo con la API CryptEnumOIDInfo, que enumera toda la información de OID que posee el sistema, para saber con que algoritmos contamos para actividades de criptografía .Al código original de Callback le hice algunos arreglos y quedó perfecto.

Saludos a todos y feliz día del programador.

Fernando Mora

Machala - Ecuador


CLEAR
*------ Determina la longitud de un puntero, sin el caracter null de finalización
DECLARE LONG lstrlenA IN Kernel32 AS GetStrLenA;
	LONG	lpString

DECLARE LONG lstrlenW IN Kernel32 AS GetStrLenW;
	LONG	lpString

*------ CyptoAPI
DECLARE LONG CryptEnumOIDInfo IN Crypt32;
	LONG	 dwGroupId,;
	LONG	 dwFlags,;
	LONG	@pvArg,;
	LONG	 pfnEnumOIDInfo

oCallBack = CREATEOBJECT("EnumOIDInfoCallback")
PUBLIC nItem
nItem = 0
dwGroupId = 0
dwFlags = 0
pvArg = 0
pfnEnumOIDInfo = oCallBack.ProcAddress
nResp = CryptEnumOIDInfo(dwGroupId, dwFlags, @pvArg, pfnEnumOIDInfo)
? nResp
? nItem

DEFINE CLASS EnumOIDInfoCallback AS Callback
	PROCEDURE Init()
		*----- La función PFN_CRYPT_ENUM_OID_INFO, tiene 2 parametros, pInfo y pvArg, de 4 bytes cada uno, 4x2=8
		RETURN DODEFAULT(8)
	ENDPROC
	
	PROCEDURE Callback()
		LPARAMETERS sParams AS String
		LOCAL pInfo AS Long, pvArg AS Long
		pInfo = CTOBIN(SUBSTR(sParams,1,4), "4RS")
		pvArg = CTOBIN(SUBSTR(sParams,5,4), "4RS")		
		nItem = nItem + 1
		IF pInfo>0
			*----- El puntero pInfo tiene una longitud de 36 bytes
			cOidVal = SYS(2600, pInfo, 36)
			cbSize = CTOBIN(SUBSTR(cOidVal, 1, 4), "4RS")
			pszOID = CTOBIN(SUBSTR(cOidVal, 5, 4), "4RS")		
			pwszName = CTOBIN(SUBSTR(cOidVal, 9, 4), "4RS")
			dwGroupId = CTOBIN(SUBSTR(cOidVal, 13, 4), "4RS")
			bUnion1 = CTOBIN(SUBSTR(cOidVal, 17, 4), "4RS")
			bUnion2 = CTOBIN(SUBSTR(cOidVal, 21, 4), "4RS")		
			pExtraInfo = CTOBIN(SUBSTR(cOidVal, 25, 4), "4RS")		
			pwszCNGAlgid = CTOBIN(SUBSTR(cOidVal, 29, 4), "4RS")
			pwszCNGExtraAlgid = CTOBIN(SUBSTR(cOidVal, 33, 4), "4RS")
			nwszCNGExtraAlgid = GetStrLenW(pwszCNGExtraAlgid)
			lcOID = SYS(2600, pszOID, GetStrLenA(pszOID))
			lcName = STRCONV(SYS(2600, pwszName, GetStrLenW(pwszName)*2),6)
			cExtraInfo = STRCONV(SYS(2600, pExtraInfo, GetStrLenW(pExtraInfo)*2),15)
			cCNGAlgID = STRCONV(SYS(2600, pwszCNGAlgid, GetStrLenW(pwszCNGAlgid)*2),6)
			cCNGExtraAlgid = STRCONV(SYS(2600, pwszCNGExtraAlgid, GetStrLenW(pwszCNGExtraAlgid)*2),6)
			ACTIVATE SCREEN
			? lcOID, lcName, cExtraInfo, cCNGAlgID, cCNGExtraAlgid 
		ENDIF
		RETURN  1
	ENDPROC
ENDDEFINE

DEFINE CLASS Callback AS Custom
	ProcAddress = 0 
	hHeap = 0
	hWindows = _SCREEN.HWnd
	#DEFINE WM_USERCALLBACK 		0x400+700
	#DEFINE HEAP_CREATE_ENABLE_EXECUTE	0x00040000
	#DEFINE HEAP_GENERATE_EXCEPTIONS	0x00000004
	PROCEDURE Init()
		LPARAMETERS tnParamSize AS Long
		THIS.SetDeclarationsAPI()
  		IF VARTYPE(tnParamSize)#"N"
  			tnParamSize = 0
  		ENDIF
  		LOCAL pfnSendMessage, hModule
  		hModule = GetModuleHandleA("user32.dll")
		pfnSendMessage = GetProcAddress(hModule, "SendMessageA")
		*----- Armamos una cadena binaria
		LOCAL sCode
		sCode = 0h + CHR(0x55)						&& push ebp
		sCode = sCode + CHR(0x89) + CHR(0xE5) 				&& mov ebp, esp
		*----- Lectura de datos para la cadena
		IF tnParamSize=0
			sCode = sCode + CHR(0x68) + BINTOC(0,"4RS")		&& push 0 : lParam - ptr to params
		ELSE
			sCode = sCode + CHR(0x89) + CHR(0xE8)			&& mov eax, ebp
			sCode = sCode + CHR(0x83) + CHR(0xC0) + CHR(0x08)	&& add eax,8
			sCode = sCode + CHR(0x50)				&& push eax : lParam - ptr to params
		ENDIF
		*----- Agregamos parámetos a la cadena
		sCode = sCode + CHR(0x68) + BINTOC(tnParamSize, "4RS")		&& push wParam - param size
		sCode = sCode + CHR(0x68) + BINTOC(WM_USERCALLBACK, "4RS")	&& push nMsg
		sCode = sCode + CHR(0x68) + BINTOC(THIS.hWindows, "4RS")	&& push hWnd
		*----- Agregamos el mensaje a enviar
		sCode = sCode + CHR(0xB8) + BINTOC(pfnSendMessage, "4RS")	&& move eax, procSendMessage
		sCode = sCode + CHR(0xFF) + CHR(0xD0)     			&& call eax
		*----- Región de respuesta
		sCode = sCode + CHR(0xC9)					&& leave
		IF tnParamSize = 0  
			sCode = sCode + CHR(0xC3)				&& ret
		ELSE 
			sCode = sCode + CHR(0xC2) + BINTOC(tnParamSize, "2RS")	&& ret tnParamSize
		ENDIF
		*----- Creamos una pila de memoria, del tamaño de un cluster.
		THIS.hHeap = HeapCreate(HEAP_CREATE_ENABLE_EXECUTE, 0, 4096)
		THIS.ProcAddress = HeapAlloc(THIS.hHeap, HEAP_GENERATE_EXCEPTIONS, LEN(sCode))
		*----- Cargamos la cadena binaria en el puntero de memoria
		RtlMoveMemory(THIS.ProcAddress, sCode, LEN(sCode))
		BINDEVENT(THIS.hWindows, WM_USERCALLBACK, THIS, "CallbackEvent")
	ENDPROC

	PROCEDURE CallbackEvent()
		LPARAMETERS hWnd, uMsg, wParam, lParam
		LOCAL sParamData
		IF wParam>0
			sParamData = SYS(2600, lParam, wParam)
		ELSE 
			sParamData = ""
		ENDIF 
		RETURN THIS.Callback(sParamData)
	ENDPROC

	PROCEDURE Callback()
		LPARAMETERS sParamData
	ENDPROC

	PROCEDURE SetDeclarationsAPI()
		DECLARE LONG GetModuleHandleA IN Kernel32;
			STRING	 lpModuleName
		
    	        DECLARE LONG GetProcAddress IN Kernel32;		
			        LONG	 hModule,;
    		        STRING	 procname
		
    	        DECLARE LONG HeapAlloc IN Kernel32;
    		        LONG	 hHeap,;
    		        LONG	 dwFlags,;
    		        LONG	 dwBytes
		
    	        DECLARE LONG HeapCreate IN Kernel32;
    		        LONG	 dwFlags,;
    		        LONG	 dwBytes,;
    		        LONG	 dwMaxBytes
		
    	        DECLARE LONG HeapDestroy IN Kernel32;
    		        LONG	 hHeap

		DECLARE RtlMoveMemory IN Kernel32;
			LONG	 Destination,;
			STRING	@Source,;
			LONG	 Length
	ENDPROC

	PROCEDURE Destroy()
		UNBINDEVENTS(THIS)
		TRY
			HeapFree(GetProcessHeap(), 0, THIS.ProcAddress)
		CATCH TO oError
			cMensaje = oError.Message
		ENDTRY
	ENDPROC
ENDDEFINE

ZeRoberto

unread,

Sep 13, 2019, 11:26:35 PM9/13/19

to publicesvfoxpro

Dale una ojeadita al control Ctl32 de Carlos Alloatti tal vez te pueda dar luz en lo que buscas

http://ctl32.blogspot.com/2018/07/c-lasses-for-visual-foxpro-9-tbz-easy.html

Saludos

Ze

VFP Unlimited - Canal de Youtube

https://www.youtube.com/channel/UCkUIcHDsOdMUIdhYNO985JQ

--
Has recibido este mensaje porque estás suscrito al grupo "Comunidad de Visual Foxpro en Español" de Grupos de Google.
Para cancelar la suscripción a este grupo y dejar de recibir sus mensajes, envía un correo electrónico a publicesvfoxp...@googlegroups.com.
Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/f4ae4e23-7a79-476e-b5ef-52e4dfaf2fee%40googlegroups.com.

Fernando Mora

unread,

Sep 13, 2019, 11:38:13 PM9/13/19

to Comunidad de Visual Foxpro en Español

Saludos ZeRoberto, el temas realmente ya esta resuelto, pero gracias por la recomendación de la web de C. Alloatti.

Aquí una captura del código ejecutándose y devolviendo datos. Podemos usar todo CriptoAPI desde Fox. Vital para facturación electrónica y criptografía.

Para cancelar la suscripción a este grupo y dejar de recibir sus mensajes, envía un correo electrónico a publice...@googlegroups.com.

ZeRoberto

unread,

Sep 13, 2019, 11:42:07 PM9/13/19

to publicesvfoxpro

Perdón, eso me pasa por no leer completo la nota, al final dice que lo solucionaste, bueno felicitaciones

Saludos

Ze

VFP Unlimited - Canal de Youtube

https://www.youtube.com/channel/UCkUIcHDsOdMUIdhYNO985JQ

Para cancelar la suscripción a este grupo y dejar de recibir sus mensajes, envía un correo electrónico a publicesvfoxp...@googlegroups.com.
Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/d051879f-169c-4742-a6f6-41b6f9645e12%40googlegroups.com.

Zarlu

unread,

Sep 14, 2019, 10:25:50 AM9/14/19

to Comunidad de Visual Foxpro en Español

Buenos días!

Gracias por el aporte Fernando Mora

Zarlu

Chetumal, Quintana Roo, México

Luis suescún

unread,

Sep 16, 2019, 7:21:58 AM9/16/19

to publice...@googlegroups.com

Fernando, específicamente en que es importante la clase en facturación electrónica, en la.generación del cufe?

Gracias

--
Has recibido este mensaje porque estás suscrito al grupo "Comunidad de Visual Foxpro en Español" de Grupos de Google.
Para cancelar la suscripción a este grupo y dejar de recibir sus mensajes, envía un correo electrónico a publicesvfoxp...@googlegroups.com.

Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/f4ae4e23-7a79-476e-b5ef-52e4dfaf2fee%40googlegroups.com.

Fernando Mora

unread,

Sep 16, 2019, 2:41:32 PM9/16/19

to Comunidad de Visual Foxpro en Español

Hola Luis.

La clase Callback lo que te permite es usar punteros de llamadas para poder usar ciertas API de Windows, lo que es vital para facturación electrónica es toda la librería de CryptoAPI de Windows, para crear hash, firmar hash, codificar certificados, decodificar certificados, y un largo etc. de cosas que se necesita para firmar Xml de facturación electrónica. Poder crear Xml en formato Xades-Bes, Xades-Epes, Xades-T, Xades-C, incluso se puede crear Cades y toda su gama de formato (aún no llego a Cades). Con CryptoApi podemos crear nuestras propias clases en Fox para firmar Xml y prescindir de las dll creadas en otros leguajes (cshap, c++, java, etc.).

Recordar que estamos hablando de una limitación del lenguaje Fox el no soportar puntero a Callback, pero con esta clase se supera esa limitación.

Saludos.

Para cancelar la suscripción a este grupo y dejar de recibir sus mensajes, envía un correo electrónico a publice...@googlegroups.com.

Roman Koltsov

unread,

Sep 21, 2019, 9:36:21 AM9/21/19

to Comunidad de Visual Foxpro en Español

Fernando, todas tus publicaciones son emocionantes. Los leí como una historia de detectives llena de acción. Antes de eso, conocía a una persona que posee magistralmente un montón de ensamblador WFT +. Esta es Leonid de Riga, Letonia.

Reply all

Reply to author

Forward