Resource file is embedded into you compiled exe, dll, ocx etc. You can store Icon, Cursor, AVI, GIF, Bitmap word document or any thing you want. VB provides few function to access application resource but these functions (LoadResData, LoadResPicture and LoadResString) not enough if you want more flexibility with resource data and also these function are lomoted to your application resource file so you can not acceess other resource outside your application.
In this article I will show you how to use Win32 API to retrive various resource items. Here is the list of items what you gonna learn from this sample code
Before you start working with any resource you have to call LoadLibrary which takes one argument which point to the path of exising exe/dll/ocx containing the resource and when you done with resource call FreeLibrary. Now lets implement actual code to read and display various resource items.
Step-by-Step Example - Create a standard exe project - Add one picturebox control on the form1 - Add one resource file. To load Resource Editor click Addin->Add-In manager->VB6 resource Editor. - Now add one Icon,one cursor, one bitmap, few strings in string table starting with ID 101, Add one AVI file and change ID to 101 if its different than 101 then rename category from CUSTOM to MYAVI (to change category name right click on AVI item and change the category name), Add one WAVE file and change ID to 101 if its different than 101 then rename category from CUSTOM to MYWAV (to change category name right click on WAVE item and change the category name), - Add the following code in form1 |
Click here to copy the following block | Option Explicit
Private Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End Type
Private Const WM_SETICON = &H80 Private Const ICON_BIG = 1
Private Const SND_APPLICATION = &H80 Private Const SND_ALIAS = &H10000 Private Const SND_ALIAS_ID = &H110000 Private Const SND_ASYNC = &H1 Private Const SND_FILENAME = &H20000 Private Const SND_LOOP = &H8 Private Const SND_MEMORY = &H4 Private Const SND_NODEFAULT = &H2 Private Const SND_NOSTOP = &H10 Private Const SND_NOWAIT = &H2000 Private Const SND_PURGE = &H40 Private Const SND_RESOURCE = &H40004 Private Const SND_SYNC = &H0
Private Declare Function FindResource Lib "kernel32" Alias "FindResourceA" (ByVal hLib As Long, _ ByVal lpName As String, ByVal lpType As String) As Long
Private Declare Function FreeResource Lib "kernel32" (ByVal hResData As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLib As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( _ ByVal strFilePath As String) As Long
Private Declare Function LoadBitmap Lib "USER32" Alias "LoadBitmapA" (ByVal hInstance As Long, _ ByVal lngBitmapID As Long) As Long
Private Declare Function LoadCursor Lib "USER32" Alias "LoadCursorA" (ByVal hLib As Long, _ ByVal lngCursorID As Long) As Long
Private Declare Function LoadIcon Lib "USER32" Alias "LoadIconA" (ByVal hLib As Long, _ ByVal lngIconID As Long) As Long
Private Declare Function LoadString Lib "USER32" Alias "LoadStringA" (ByVal hLib As Long, _ ByVal ResourceID As Long, ByVal lpBuffer As String, ByVal nBufferSize As Long) As Long
Private Declare Function LoadResource Lib "kernel32" (ByVal hLib As Long, _ ByVal hRes As Long) As Long
Private Declare Function LockResource Lib "kernel32" (ByVal hRes As Long) As Long
Private Declare Function SizeofResource Lib "kernel32" (ByVal hModule As Long, _ ByVal hResInfo As Long) As Long
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByRef Sound As Any, _ ByVal hLib As Long, ByVal lngFlag As Long) As Long
Private Declare Function SendMessage Lib "USER32.DLL" Alias "SendMessageA" (ByVal hWnd As Long, _ ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SetCursor Lib "USER32.DLL" (ByVal hCursor As Long) As Long
Private Declare Function BitBlt Lib "GDI32" (ByVal hDC_Destination As Long, _ ByVal X_Dest As Long, ByVal Y_Dest As Long, ByVal Width_Dest As Long, _ ByVal Height_Dest As Long, ByVal hDC_Source As Long, ByVal X_Src As Long, _ ByVal Y_Src As Long, ByVal RasterOperation As Long) As Long
Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hGDIObj As Long) As Long
Private Declare Function DeleteObject Lib "GDI32" (ByVal hGDIObj As Long) As Long
Private Declare Function GetObjectAPI Lib "GDI32" Alias "GetObjectA" ( _ ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function ReleaseDC Lib "USER32" ( _ ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ pDst As Any, pSrc As Any, ByVal ByteLen As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" ( _ ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _ ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm" Alias _ "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _ ByVal uLength As Long) As Long
Private Sub Form_Load() Dim DataBuffer() As Byte Dim strFilePath As String Dim hLibrary As Long Dim hResource As Long Dim hData As Long Dim lpData As Long Dim lDataSize As Long Dim hIcon As Long Dim hCursor As Long Dim hBitmap As Long Dim strString As String Dim lngStringLen As Long Dim BitmapInfo As BITMAP Dim hDC_Screen As Long Dim hDC_Temp As Long Dim hBMP_Prev As Long Dim id As String
Me.Show Me.AutoRedraw = True
strFilePath = App.Path If Right(strFilePath, 1) <> "\" Then strFilePath = strFilePath & "\" strFilePath = strFilePath & App.EXEName & ".exe"
hLibrary = LoadLibrary(strFilePath) If hLibrary = 0 Then MsgBox "Failed to load the specified library with error code " & Err.LastDllError Exit Sub End If
hIcon = LoadIcon(hLibrary, 101) If hIcon <> 0 Then SendMessage Me.hWnd, WM_SETICON, ICON_BIG, ByVal hIcon
hCursor = LoadCursor(hLibrary, 101) If hCursor <> 0 Then SetCursor hCursor strString = String(256, Chr(0)) lngStringLen = LoadString(hLibrary, 101, strString, Len(strString)) If lngStringLen <> 0 Then Me.Caption = Left(strString, lngStringLen)
hBitmap = LoadBitmap(hLibrary, 101) If hBitmap <> 0 Then GetObjectAPI hBitmap, Len(BitmapInfo), BitmapInfo hDC_Screen = GetDC(0) hDC_Temp = CreateCompatibleDC(hDC_Screen) hBMP_Prev = SelectObject(hDC_Temp, hBitmap) BitBlt Me.hDC, 0, 0, BitmapInfo.bmWidth, BitmapInfo.bmHeight, hDC_Temp, 0, 0, vbSrcCopy Me.Refresh SelectObject hDC_Temp, hBMP_Prev DeleteDC hDC_Temp ReleaseDC 0, hDC_Screen End If
id = "#101" hResource = FindResource(hLibrary, id, "MYWAV") If hResource <> 0 Then hData = LoadResource(hLibrary, hResource) If hData <> 0 Then lpData = LockResource(hData) lDataSize = SizeofResource(hLibrary, hResource) If lpData <> 0 Then ReDim DataBuffer(lDataSize - 1) As Byte CopyMemory DataBuffer(0), ByVal lpData, lDataSize
If Dir(App.Path & "\extracted_wave.wav") <> "" Then Kill App.Path & "\extracted_wave.wav" End If SaveArrayToFile DataBuffer, App.Path & "\extracted_wave.wav" PlaySound ByVal lpData, 0, SND_SYNC Or SND_MEMORY Or SND_NODEFAULT End If End If FreeResource hData End If
id = "#101" hResource = FindResource(hLibrary, id, "MYAVI") If hResource <> 0 Then hData = LoadResource(hLibrary, hResource) If hData <> 0 Then lpData = LockResource(hData) lDataSize = SizeofResource(hLibrary, hResource) If lpData <> 0 Then ReDim DataBuffer(lDataSize - 1) As Byte CopyMemory DataBuffer(0), ByVal lpData, lDataSize
Call mciSendString("close myvideo", 0&, 0, 0) If Dir(App.Path & "\extracted_avi.avi") <> "" Then Kill App.Path & "\extracted_avi.avi" Call mciSendString("close all", 0&, 0, 0) End If SaveArrayToFile DataBuffer, App.Path & "\extracted_avi.avi"
PlayAVI App.Path & "\extracted_avi.avi", Picture1.hWnd End If FreeResource hData End If End If
FreeLibrary hLibrary End Sub
Private Sub SaveArrayToFile(DataArray() As Byte, sSaveFilePath As String) Dim FileNum As Long FileNum = FreeFile Open sSaveFilePath For Binary As #FileNum Put #FileNum, , DataArray() Close #FileNum End Sub
Public Function PlayAVI(sAviFilePath As String, hWndDisplay As Long) As Boolean Dim mciCmd As String Dim sReturn As String * 128 Dim nWidth As Long, nHeight As Long Dim lStart As Long, lPos As Long Dim picWidth As Long, picHeight As Long Dim ret As Long
mciCmd = "open """ & sAviFilePath & """ Type avivideo Alias myvideo parent " & hWndDisplay & " Style child" ret = mciSendString(mciCmd, 0&, 0, 0) If ret > 0 Then MsgBox GetMCIErrorString(ret), vbCritical: Exit Function
ret = mciSendString("play myvideo repeat", 0&, 0, 0) If ret > 0 Then MsgBox GetMCIErrorString(ret), vbCritical: Exit Function
PlayAVI = True End Function
Function GetMCIErrorString(ErrorCode As Long) As String Dim buffer As String * 256 mciGetErrorString ErrorCode, buffer, Len(buffer) GetMCIErrorString = Left$(buffer, InStr(buffer, vbNullChar) - 1) End Function
Private Sub Form_Unload(Cancel As Integer) Call mciSendString("close all", 0&, 0, 0) End Sub |
|