Binaryworld - Working with Resource file ... [ VB -> Resource Files ]

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

Open/Close resource of any application.
Access resource item by name using FindResource API
Getting size of resource item using SizeofResource API
Retrive bitmap from resource using LoadBitmap API
Retrive string from resource using LoadString API
Retrive icon from resource using LoadIcon API
Retrive cursor from resource using LoadCursor API
Retrive custom resource item (i.e WAVE file, AVI file, Word document etc..) from resource using LoadResource in conjuction with FindResource, LockResource, SizeofResource and FreeResource APIs.
Load wave file from resource in memory and play wave file using PlaySound
Load AVI file from resource, save it on a disk and play it in the picturebox using mciSendString API
Save custom resource on a disk

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   'LONG
  bmWidth   As Long   'LONG
  bmHeight   As Long   'LONG
  bmWidthBytes As Long   'LONG
  bmPlanes   As Integer 'WORD
  bmBitsPixel As Integer 'WORD
  bmBits    As Long   'LPVOID
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  'BOOL

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  'BOOL

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

'//Note : This demo assumes that you have Resource ID=101 for first iteam for each resource type

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

  '//Get the path to the Resource DLL
  strFilePath = App.Path
  If Right(strFilePath, 1) <> "\" Then strFilePath = strFilePath & "\"
  strFilePath = strFilePath & App.EXEName & ".exe"  '//Load from own resource

  '//Load the Resource Dll/Exe
  hLibrary = LoadLibrary(strFilePath)
  If hLibrary = 0 Then
    MsgBox "Failed to load the specified library with error code " & Err.LastDllError
    Exit Sub
  End If

  '/////////////////////////////////////////////////////////////////////////////
  ' Get an icon from the Resource DLL/Exe
  '/////////////////////////////////////////////////////////////////////////////
  hIcon = LoadIcon(hLibrary, 101)
  If hIcon <> 0 Then SendMessage Me.hWnd, WM_SETICON, ICON_BIG, ByVal hIcon

  '/////////////////////////////////////////////////////////////////////////////
  ' Get a cursor from the Resource DLL/Exe
  '/////////////////////////////////////////////////////////////////////////////
  'Note: Cursor will go away once this procedure is executed so put play wave
  'file Synchronously so we can see the changed cursor
  hCursor = LoadCursor(hLibrary, 101)
  If hCursor <> 0 Then SetCursor hCursor

  '/////////////////////////////////////////////////////////////////////////////
  ' Get a string from the Resource DLL/Exe
  '/////////////////////////////////////////////////////////////////////////////
  strString = String(256, Chr(0))
  lngStringLen = LoadString(hLibrary, 101, strString, Len(strString))
  If lngStringLen <> 0 Then Me.Caption = Left(strString, lngStringLen)

  '/////////////////////////////////////////////////////////////////////////////
  ' Get a bitmap from the Resource DLL/Exe
  '/////////////////////////////////////////////////////////////////////////////
  hBitmap = LoadBitmap(hLibrary, 101)
  If hBitmap <> 0 Then
    '//Load bitmap attributes (i.e. height/width/colors... etc) into BitmapInfo
    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

  '/////////////////////////////////////////////////////////////////////////////
  ' Get a .WAV file from the Resource DLL/Exe
  '/////////////////////////////////////////////////////////////////////////////
  id = "#101"       '// format=> "#" + Id
  hResource = FindResource(hLibrary, id, "MYWAV")
  If hResource <> 0 Then
    hData = LoadResource(hLibrary, hResource)  'This gets a handle to the data
    If hData <> 0 Then
      lpData = LockResource(hData)  'This gets a POINTER to the data... which is what we need
      lDataSize = SizeofResource(hLibrary, hResource)
      If lpData <> 0 Then
        '//Save file on disk if u want
        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"
        '//Play Synchronously
        PlaySound ByVal lpData, 0, SND_SYNC Or SND_MEMORY Or SND_NODEFAULT
        '//Play asynchronously
        'PlaySound ByVal lpData, 0, SND_ASYNC Or SND_MEMORY Or SND_NODEFAULT
      End If
    End If
    FreeResource hData
  End If

  '/////////////////////////////////////////////////////////////////////////////
  ' Get a .AVI file from the Resource DLL/Exe
  '/////////////////////////////////////////////////////////////////////////////
  id = "#101"       '// format=> "#" + Id
  hResource = FindResource(hLibrary, id, "MYAVI")
  If hResource <> 0 Then
    hData = LoadResource(hLibrary, hResource)  'This gets a handle to the data
    If hData <> 0 Then
      lpData = LockResource(hData)  'This gets a POINTER to the data... which is what we need
      lDataSize = SizeofResource(hLibrary, hResource)
      If lpData <> 0 Then
        '//You must save file on disk before playing
        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"
          '//Close if already playing
          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

  ' Close the Resource DLL
  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

' Get the description of a MCI error.
' ErrorCode is the code of the error
' Return a string with the description of the error.

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)
  '//Close if already playing
  Call mciSendString("close all", 0&, 0, 0)
End Sub