標籤:des style blog http color io cti 代碼
原文摘自:http://heisetoufa.iteye.com/blog/504068
‘模組代碼Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As LongPrivate Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As LongPrivate Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any) As LongPrivate Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As LongPrivate Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As LongPrivate Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As LongPrivate 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 LongPublic Type GUID ‘ 16 bytes (128 bits)‘dwData1 As Long ‘ 4 bytes‘wData2 As Integer ‘ 2 bytes‘wData3 As Integer ‘ 2 bytesabData4(7) As Byte ‘ 8 bytes, zero basedEnd TypePublic 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