'模块代码
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Public Type GUID ' 16 bytes (128 bits)
'dwData1 As Long ' 4 bytes
'wData2 As Integer ' 2 bytes
'wData3 As Integer ' 2 bytes
abData4(7) As Byte ' 8 bytes, zero based
End Type
Public Function PictureFromByteStream(B() As Byte) As IPicture
Dim hMem As Long
Dim lpMem As Long
Dim LowerBound As Long
Dim ByteCount As Long
Dim IID_IPicture As GUID
Dim istm As stdole.IUnknown
LowerBound = LBound(B)
ByteCount = UBound(B) - LowerBound + 1
hMem = GlobalAlloc(&H2, ByteCount)
If hMem <> 0 Then
lpMem = GlobalLock(hMem)
If lpMem <> 0 Then
MoveMemory ByVal lpMem, B(LowerBound), ByteCount
GlobalUnlock hMem
If CreateStreamOnHGlobal(hMem, 1, istm) = 0 Then
If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture) = 0 Then
OleLoadPicture ByVal ObjPtr(istm), ByteCount, 0, IID_IPicture, PictureFromByteStream
End If
End If
End If
End If
End Function
Public Sub Combo1_Click()
Dim adoCnn As ADODB.Connection
Dim rstOra As ADODB.Recordset
Dim intI As Integer
Set adoCnn = New ADODB.Connection
Set rstOra = New ADODB.Recordset
adoCnn.ConnectionString = "Provider=OraOLEDB.Oracle;User ID=dzjc;password=zlkj;Data Source=dzjc_2005;" '读blob字段要用Provider=OraOLEDB.Oracle
adoCnn.CursorLocation = adUseClient
adoCnn.Open
rstOra.CursorLocation = adUseClient
rstOra.ActiveConnection = adoCnn
rstOra.Open "SELECT zp FROM dzjc.dzjc_wfzp WHERE xh = '5'"
'Set Image1.DataSource = rstOra
Set Image1.Picture = PictureFromByteStream(rstOra.Fields("zp").Value)
End Sub