目的:VB程序调用DLL取出DLL中的资源,如:swf、asp、png、jpg等。
问题:使用LoadResource、FindResource、LockResource后再读内存不好用,能得到内存资源的长度
信息但写到硬盘上的文件后是乱码。不知何故?Option Explicit
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) 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 Long, 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 LongPublic Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long'位图数据结构类型
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
'光栅操作代码常量
Public Const SRCCOPY = &HCC0020
'声音播放状态常量
Public Const SND_ASYNC = &H1
Public Const SND_NODEFAULT = &H2
Public Const SND_MEMORY = &H4
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const OPEN_EXISTING = 3
Const CREATE_ALWAYS = 2
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function SizeofResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
Public Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
'调用位图资源子例程
Sub load_pic(picName As Integer)
Dim hDLL As Long
Dim hdcMemory, hLoadedbitmap, hOldBitmap As Long
Dim retVal As Long
Dim bmpInfo As BITMAP
'安装动态链接库DEMO.DLL
hDLL = LoadLibrary(App.Path & "\resdll.DLL")
'根据资源名从动态链接库中加载相应的位图资源
hLoadedbitmap = LoadBitmap(hDLL, 102)
'获取位图信息
retVal = GetObject(hLoadedbitmap, Len(bmpInfo), bmpInfo)
'创建一个与图片框控件的设备描述表兼容的内存设备描述表
hdcMemory = CreateCompatibleDC(Form1.Picture1.hdc)
'将位图选入内存设备描述表
hOldBitmap = SelectObject(hdcMemory, hLoadedbitmap)
'将位图从内存设备描述表中拷入图片框控件的设备描述表中
retVal = BitBlt(Form1.Picture1.hdc, 0, 0, bmpInfo.bmWidth, bmpInfo.bmHeight, hdcMemory, 0, 0, SRCCOPY)
'将原始位图选入内存设备描述表
retVal = SelectObject(hdcMemory, hOldBitmap)
'删除加载的位图,释放其占用的所有系统资源
retVal = DeleteObject(hLoadedbitmap)
'删除内存设备描述表
retVal = DeleteDC(hdcMemory)
'释放动态链接库
FreeLibrary (hDLL)
End Sub'调用资源子例程
Sub load_sound(wavName As Integer)
Dim hDLL As Long
Dim hloadwave As Long
Dim hwaveres As Long
Dim hsound As Long
Dim hrelease As Long
Dim resVal As Long
Dim newSwf As Long
Dim Ret As Long
Dim nn As Long
hDLL = LoadLibrary(App.Path & "\resdll.DLL")
hwaveres = FindResource(hDLL, 117, "ASP")
hloadwave = LoadResource(hDLL, hwaveres)
hsound = LockResource(hloadwave)
newSwf = CreateFile("c:\hello.txt", GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_ALWAYS, 0, 0)
nn = WriteFile(newSwf, hsound, SizeofResource(hDLL, hwaveres), Ret, ByVal 0&)
FlushFileBuffers newSwf
CloseHandle newSwf
FreeLibrary (hDLL)
End Sub