Ejemplos usando el Api de windows para Visual basic

160 - Obtener Recursos Avi de un archivo

<Volver> - Anterior - Siguiente

---

 

 

 

Contenido

• Ejemplo 1
• Ejemplo 2
• Relacionados

 

 

 

 

---

Ejemplo 1

Ejemplo enviado por Leandro Ascierto para poder acceder a los recursos en formato AVI de ficheros que los contengan, y reproducirlos en un control Picturebox

 

Nota: en este enalce se encuentra un control ocx que realiza lo visto en esta página : control animation resource

El mismo utiliza varias funciones del Api de windows, como FindResourceByNum, LoadLibraryEx, FindResource, LoadResource, EnumResourceNames, CopyMemory y algunas otras.

Desde el formulario hay una Sub llamada Call Obtener_AVI, a la cual se le debe enviar como parámetro la ruta y nombre del archivo, por ejemplo:

Call Obtener_AVI("c:\windows\System32\shell32.dll")

En este caso, al acceder al archivo Shell32.dll, se listan en un ListBox los recursos Avi en forma enumerada. Al hacer click en uno, se reproduce el Avi en un control Picturebox, llamando a la Sub PlayAviResourse.

Esta es una captura de algunos de los avi que contiene la librería dinámica de windows Shell32.dll

 

Probando todas las dll ubicadas en system32, encontré algunos otros archivos que contienen recursos de tipo avi, algunos ficheros son del sistema, otros posiblemente de alguna aplicación que tenga instalada y que haya copiado dichas dll o exe en dicho directorio

Estas son algunas de los que encontré:

Archivo hdwwiz.cpl

 

Archivo hnetwiz.dll

 

Archivo xpsp2res.dll

 

Algunos otros archivos del system32 de los cuales pude rescatar algunos son:

autodisc.dll, avtapi.dll, certmgr.dll, cmprops.dll, compatUL.dll, cscui.dll, dskquoui.dll, hdwwiz.cpl, hnetwiz.dll, ieakui.dll, inetcfg.dll, newdev.dll, roboex32.dll, rsnotify.exe, setupapi.dll, wiadefui.dll , xpsp2res.dll

 

Nota: en el momento que se selecciona un recurso Avi del ListBox para reproducirlo, se genera el avi en un archivo temporal en el c:\, al seleccionar otro, se elimina, y se vuelve a generar otro temporal con el que se va a reproducir. Por eso mismo tener esto en cuenta, si la intención es extraer dichos ficheros a disco

 

Controles

Colocar en un formulario un control ListBox, un PictureBox, un textBox, y Tres CommandButton y un módulo bas.

 

Código fuente en el módulo bas:

Option Explicit ' Funciones Api, constantes '--------------------------------------------------------------------- Private Declare Function FindResourceByNum Lib "kernel32" Alias "FindResourceA" ( _ ByVal hInstance As Long, _ ByVal lpName As String, _ ByVal lpType As Long) As Long Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" ( _ ByVal lpLibFileName As String, _ ByVal hFile As Long, _ ByVal dwFlags As Long) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function FindResource Lib "kernel32" Alias "FindResourceA" ( _ ByVal hInstance As Long, _ ByVal lpName As String, _ ByVal lpType As String) As Long Private Declare Function LoadResource Lib "kernel32" ( _ ByVal hInstance As Long, _ ByVal hResInfo As Long) As Long Private Declare Function LockResource Lib "kernel32" ( _ ByVal hResData As Long) As Long Private Declare Function SizeofResource Lib "kernel32" ( _ ByVal hInstance As Long, _ ByVal hResInfo As Long) As Long Private Declare Function FreeResource Lib "kernel32" ( _ ByVal hResData As Long) As Long Private Declare Function EnumResourceNames Lib "kernel32" Alias "EnumResourceNamesA" ( _ ByVal hModule As Long, _ ByVal lpType As String, _ ByVal lpEnumFunc As Long, _ ByVal lParam As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ Destination As Any, _ Source As Any, _ ByVal Length As Long) Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" ( _ ByVal dwExStyle As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String, _ ByVal dwStyle As Long, _ ByVal X As Long, _ ByVal Y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hWndParent As Long, _ ByVal hMenu As Long, _ ByVal hInstance As Long, _ lpParam As Any) As Long Private Declare Function DestroyWindow Lib "user32" ( _ ByVal hwnd As Long) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Const ANIMATE_CLASS = "SysAnimate32" Private Const WS_EX_TRANSPARENT = &H20& Private Const ACS_TRANSPARENT = &H2& Private Const ACS_AUTOPLAY = &H4& Private Const WM_USER = &H400& Private Const ACM_OPEN = WM_USER + 100 Private Const ACM_PLAY = WM_USER + 101 Private Const ACM_STOP = WM_USER + 102 Private Animacion As Long Private hModule As Long Private Const TEMP_FILE_NAME = "c:\tempfile.tmp" Public ResourceName() As String Public ResourceCount As Long ' Funciones y subRutinas '--------------------------------------------------------------------- Public Function ShowAVI(ByVal ResName As String, pb As PictureBox) As Boolean On Error GoTo Salir Dim arr() As Byte, nFile As Integer, Ret As Long If Dir(TEMP_FILE_NAME) <> "" Then DestroyWindow Animacion Kill TEMP_FILE_NAME End If arr = GetDataArray("AVI", "#" & ResName) nFile = FreeFile Open TEMP_FILE_NAME For Binary As #nFile Put #nFile, , arr Close #nFile Animacion = CreateWindowEx(WS_EX_TRANSPARENT, ANIMATE_CLASS, "", _ &H50000000 Or ACS_TRANSPARENT, pb.ScaleLeft, _ pb.ScaleTop, pb.ScaleWidth, pb.ScaleHeight, _ pb.hwnd, 0&, App.hInstance, ByVal 0&) Ret = SendMessage(Animacion, ACM_OPEN, 0&, ByVal TEMP_FILE_NAME) ShowAVI = Ret Exit Function Salir: End Function Private Function GetDataArray(ByVal ResType As String, _ ByVal ResName As String) As Variant Dim hRsrc As Long Dim hGlobal As Long Dim arrData() As Byte Dim lpData As Long Dim arrSize As Long If IsNumeric(ResType) Then hRsrc = FindResourceByNum(hModule, ResName, CLng(ResType)) End If If hRsrc = 0 Then hRsrc = FindResource(hModule, ResName, ResType) End If If hRsrc = 0 Then Exit Function hGlobal = LoadResource(hModule, hRsrc) lpData = LockResource(hGlobal) arrSize = SizeofResource(hModule, hRsrc) If arrSize = 0 Then Exit Function ReDim arrData(arrSize - 1) Call CopyMemory(arrData(0), ByVal lpData, arrSize) Call FreeResource(hGlobal) GetDataArray = arrData End Function Function ResNamesCallBack(ByVal hMod As Long, ByVal ResType As Long, _ ByVal ResId As Long, ByVal lParam As Long) As Long ResourceName(UBound(ResourceName)) = ResId ReDim Preserve ResourceName(UBound(ResourceName) + 1) ResNamesCallBack = True End Function Private Function GetAviResource() ReDim ResourceName(1) Dim Ret As Long Ret = EnumResourceNames(hModule, "AVI", AddressOf ResNamesCallBack, 0) ResourceCount = UBound(ResourceName) - 1 End Function Public Sub PlayAviResourse() Call SendMessage(Animacion, ACM_PLAY, -1, 0) End Sub Public Sub StopAviResourse() Call SendMessage(Animacion, ACM_STOP, -1, 0) End Sub Public Function InitResource(ByVal sLibName As String) As Boolean On Error Resume Next If hModule Then TerminateResource hModule = LoadLibraryEx(sLibName, 0, 1) ' hModule = LoadLibrary(sLibName) If hModule Then Call GetAviResource InitResource = (hModule <> 0) End Function Public Sub TerminateResource() If Dir(TEMP_FILE_NAME) <> "" Then DestroyWindow Animacion Kill TEMP_FILE_NAME End If If hModule Then FreeLibrary (hModule) End Sub

 

 

Código fuente en el formulario:

'Recibe el path del archivo a cargar, por ejemplo c:\windows\system32\shell32.dll Private Sub Obtener_AVI(path) Dim Ret As Long, i As Long Ret = InitResource(path) If Ret Then If ResourceCount > 0 Then For i = 1 To ResourceCount List1.AddItem ResourceName(i) Next Else MsgBox "No se han encontrado Recursos AVI", vbCritical TerminateResource End If Else MsgBox "Error al acceder a la libreria", vbCritical TerminateResource End If End Sub ' Botón que carga y enumera los recursos avi Private Sub Command3_Click() Call Obtener_AVI(Trim$(Text1.Text)) End Sub Private Sub Form_Load() Command1.Caption = " Play AVI " Command2.Caption = " STOP " Command3.Caption = " cargar y enumerar " Text1 = "c:\windows\system32\shell32.dll" End Sub 'ListBox con los recursos Private Sub List1_Click() Ret = ShowAVI(List1, Picture1) If Ret = 0 Then MsgBox "Error al acceder al recurso", vbCritical Exit Sub End If DoEvents Call PlayAviResourse End Sub Private Sub Form_Unload(Cancel As Integer) Call TerminateResource End Sub 'Botón Play Private Sub Command1_Click() Call PlayAviResourse End Sub 'Botón stop Private Sub Command2_Click() Call StopAviResourse End Sub

 

---

Ejemplo 2 - Res Avi Hacker

Programa con el código fuente enviado por Helmuth Campos, que está basado en el codigo anterior y permite ver y obtener recursos .avi desde una .dll, .exe, pero tiene algunas mejoras , ahora se puede seleccionar un .exe , .dll , .ocx y .res mediante un cuadro de diálogo entre otras opciones.

Descargar código fuente

Vista previa

 

---

Recursos visual basic 6

• LoadresData - archivos de recursos personalizados

 

---

Buscar en Recursos vb

---

Recursos visual basic - Buscar - Privacidad - Copyright © 2005 - 2009 - www.recursosvisualbasic.com.ar