读取dll中的bmp,ico,wav文件(开源了)

来源:互联网 发布:剑灵人男捏脸数据邪气 编辑:程序博客网 时间:2024/06/05 05:52
大家一定为程序一些图片资源和声音资源加密而头疼把,有了资源型的dll,完全能解决这个问题。
新建一个Activex dll(当然标准的dll一样也可以),添加资源文件,可以把你想放的bmp(多大文件都可以例子中放了个6mb的图片),ico,wav
都可以放进去,记住一定要改名啊,不要用系统自动的名字。然后生成dll就可以了(demo.dll)。
接下来,我们新建一个标准exe,代码如下:
Option Explicit
Private Sub cmdSound_Click(Index As Integer)
Select Case Index
Case 0
load_sound ("S1")
Case 1
load_sound ("S2")
End Select
End Sub
Private Sub Command1_Click()
Dim a
Picture1.Picture = LoadPicture("")


Call load_pic(Picture1.hdc, "B2") '加载bmp

End Sub

Private Sub Command2_Click()
Picture1.Picture = LoadPicture("")


Call load_ico(Picture1.hdc, "I1") '加载ico

End Sub

Private Sub Command3_Click()
Picture1.Picture = LoadPicture("")


Call load_ico(Picture1.hdc, "I2") '加载ico
End Sub
再新建个模块代码如下:
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As String) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As BITMAP) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function FindResource Lib "kernel32" Alias "FindResourceA" (ByVal hInstance As Long, ByVal lpName As String, ByVal lpType As String) As Long
Public Declare Function LockResource Lib "kernel32" (ByVal hResData As Long) As Long
Public Declare Function LoadResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Public Declare Function CreateIcon Lib "user32" (ByVal hInstance As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Byte, ByVal nBitsPixel As Byte, lpANDbits As Byte, lpXORbits As Byte) As Long
Public Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long



Public Type ICONINFO
        fIcon As Long
        xHotspot As Long
        yHotspot As Long
        hbmMask As Long
        hbmColor As Long
End Type



Public Type BITMAP '14 bytes
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type


'光栅操作代码常量
Public Const SRCCOPY = &HCC0020
'声音播放状态常量
Public Const SND_SYNC = &H0
Public Const SND_MEMORY = &H4
Public Sub load_pic(pichdc As Long, picName As String)
Dim hDLL As Long
Dim hdcMemory, hLoadedbitmap, hOldBitmap As Long
Dim retVal As Long
Dim bmpInfo As BITMAP
'安装动态链接库DEMO.DLL
hDLL = LoadLibrary(App.Path & "/demo.dll")


hLoadedbitmap = LoadBitmap(hDLL, picName)
'获取位图信息
retVal = GetObject(hLoadedbitmap, Len(bmpInfo), bmpInfo)
'创建一个与图片框控件的设备描述表兼容的内存设备描述表
hdcMemory = CreateCompatibleDC(pichdc)
'将位图选入内存设备描述表
hOldBitmap = SelectObject(hdcMemory, hLoadedbitmap)
'将位图从内存设备描述表中拷入图片框控件的设备描述表中
retVal = BitBlt(pichdc, 0, 0, bmpInfo.bmWidth, bmpInfo.bmHeight, hdcMemory, 0, 0, SRCCOPY)
'将原始位图选入内存设备描述表
retVal = SelectObject(hdcMemory, hOldBitmap)
'删除加载的位图,释放其占用的所有系统资源
retVal = DeleteObject(hLoadedbitmap)
'删除内存设备描述表
retVal = DeleteDC(hdcMemory)
'释放动态链接库
FreeLibrary (hDLL)
End Sub
'调用声音资源子例程
Public Sub load_sound(wavName As String)
Dim hDLL As Integer
Dim hloadwave As Integer
Dim hwaveres As Integer
Dim hsound As Long
Dim hrelease As Integer
Dim resVal As Integer
hDLL = LoadLibrary(App.Path & "/DEMO.DLL")
'在动态链接库中查找资源类型为WAVE,资源名为wavName的资源
hwaveres = FindResource(hDLL, wavName, "WAVE")
'将该资源装入内存
hloadwave = LoadResource(hDLL, hwaveres)
'锁定该资源
hsound = LockResource(hloadwave)
'以同步方式播放内存中的声音资源
resVal = sndPlaySound(hsound, SND_SYNC + SND_MEMORY)
'释放该资源占用的内存
hrelease = GlobalUnlock(hloadwave)
FreeLibrary (hDLL)
End Sub

Public Function load_ico(pichdc As Long, picName As String)
Dim hDLL As Long
Dim hdcMemory, hLoadedbitmap, hOldBitmap As Long
Dim retVal As Long
Dim bmpInfo As ICONINFO
'安装动态链接库DEMO.DLL
hDLL = LoadLibrary(App.Path & "/demo.dll")

'根据资源名从动态链接库中加载相应的位图资源 LoadIcon
hLoadedbitmap = LoadIcon(hDLL, picName)

'载入ico
retVal = DrawIcon(pichdc, 0, 0, hLoadedbitmap)



'删除加载的位图,释放其占用的所有系统资源
retVal = DeleteObject(hLoadedbitmap)


'释放动态链接库
FreeLibrary (hDLL)
End Function

(部分源码来自网上)


 

 

 

-----------------------------------------------------------------------------

Option Explicit

Private Const IDS_STRING1     As Long = 1
Private Const IDS_STRING2     As Long = 2
Private Const IDS_STRING3     As Long = 3
Private Const IDI_ICON1       As Long = 101
Private Const IDB_BITMAP1     As Long = 102
Private Const IDB_BITMAP2     As Long = 103

Private Const DST_BITMAP = 4
Private Const OBJ_BITMAP = 7

'位图结构
Private Type BITMAPINFOHEADER '40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadString Lib "user32" Alias "LoadStringA" (ByVal hInstance As Long, ByVal wID As Long, ByVal lpBuffer As String, ByVal nBufferMax As Long) As Long
Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As Long) As Long
Private Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
Private Declare Function GetObjectType Lib "gdi32" (ByVal hgdiobj As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hDC As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub Form_Load()

    Combo1.ListIndex = 0

End Sub

Private Sub Combo1_Click()

    LoadRes

End Sub

Private Sub Picture1_Paint(Index As Integer)

    LoadRes

End Sub

Private Sub LoadRes()

    Dim hRes As Long
    Dim strData As String
    Dim hBmp As Long
    Dim hIcon As Long
    Dim bitBmp As BITMAPINFO

    '加载DLL
    hRes = LoadLibrary(Combo1.Text)

    '字符串
    strData = Space$(255)
    LoadString hRes, IDS_STRING1, strData, 255
    Label1(0).Caption = Trim$(strData)

    strData = Space$(255)
    LoadString hRes, IDS_STRING2, strData, 255
    Label1(1).Caption = Trim$(strData)

    strData = Space$(255)
    LoadString hRes, IDS_STRING3, strData, 255
    Label1(2).Caption = Trim$(strData)

    '位图
    hBmp = LoadBitmap(hRes, IDB_BITMAP1)

    If GetObjectType(hBmp) = OBJ_BITMAP Then

        GetObject hBmp, Len(bitBmp), bitBmp

        DrawState Picture1(0).hDC, 0, ByVal 0, hBmp, 0, 0, 0, bitBmp.bmiHeader.biWidth, bitBmp.bmiHeader.biHeight, DST_BITMAP  'DST_BITMAP->lParam中的句柄

    End If

    '图标
    hIcon = LoadIcon(hRes, IDI_ICON1)
    DrawIcon Picture1(1).hDC, 0, 0, hIcon

    '释放资源
    DeleteObject hBmp
    DeleteObject hIcon

    '释放DLL
    FreeLibrary hRes

End Sub