图片存取的示例有吗？请高手指教！

Question

VB+SQL SERVER
字段类型用什么？
希望能有示例！
[email protected]

Answer 1

'字段类型image
'-------------------
'读照片
Public Function GetPhone(ByVal lngId&) As Boolean
On Error GoTo errExit
    Dim rst As New Recordset
    Dim strSql$
    
    If myCnn.ConnectToServer Then   '连接函数
        strSql = "select * from USER_T where Id=" & lngId
        rst.Open strSql, myCnn.Cnn, adOpenStatic, adLockOptimistic
        If rst.RecordCount > 0 Then
            On Error Resume Next
            MkDir App.Path & "\temp"
            Err.Clear
            On Error GoTo errExit
            Dim byt() As Byte
            If rst.Fields("Photo").ActualSize = 0 Then
                Exit Function
            End If
            ReDim byt(rst.Fields("Photo").ActualSize)
            byt = rst.Fields("Photo").Value
            Open App.Path & "\temp\tmp.jpg" For Binary Access Write As #1
                Put #1, , byt
            Close #1
            GetPhone = True
        End If
    End If
    Set rst = Nothing
    Exit Function
errExit:
    MsgBox Err.Description, vbCritical, "图片读取错误"
End Function
'写照片
Public Function WritePhone(ByVal lngId&, ByVal strFile$) As Boolean
    Dim rst As New Recordset
    Dim strSql$
On Error GoTo errExit
    If myCnn.ConnectToServer Then    '连接函数
        strSql = "select * from USER_T where Id=" & lngId
        rst.Open strSql, myCnn.Cnn, adOpenStatic, adLockOptimistic
        If rst.RecordCount > 0 Then
            Dim lngFL&, byt() As Byte
            lngFL = FileLen(strFile)
            ReDim byt(lngFL)
            Open strFile For Binary Access Read As #1
                Get #1, , byt
            Close #1
            rst.Fields("Photo").Value = byt
            rst.Update
            WritePhone = True
        End If
    End If
    Set rst = Nothing
    Exit Function
errExit:
    MsgBox Err.Description, vbCritical, "图片写入错误"
End Function

Answer 2

使用Stream对象，可以实现对数据库的图像存取。
数据库中存放图像的字段类型image（Access为OLE类型）。
比如，如果用“CommonDialog”控件来选择你硬盘上的图像文件；
用“Picture”控件来显示图像，那么下面的代码供参考：
（已连接数据库，打开了相应的记录集rs）
    Dim StmPic As ADODB.Stream
    Dim StrPicTemp As String
　　......
　　'保存你所选择的图像
　　Set StmPic = New ADODB.Stream
    StmPic.Type = adTypeBinary    '指定流是二进制类型
    StmPic.Open　　　　　　　　　　 '将数据获取到Stream对象中
    StmPic.LoadFromFile (CommonDialog1.FileName) '将选择的图像加载到打开的StmPic中
    rs.AddNew
    rs.Fields(1).Value = StmPic.Read   '从StmPic对象中读取数据
    rs.Update
    StmPic.Close
　　......
　　'读取显示数据库中的图像
　　Set StmPic = New ADODB.Stream
    StrPicTemp = "c:\temp.tmp"    '临时文件,用来保存读出的图片
    With StmPic
　　　　.Type = adTypeBinary      
　　　　.Open                     
　　　　.Write rs.Fields(1)       '写入数据库中的数据至Stream中
　　　　.SaveToFile StrPicTemp, adSaveCreateOverWrite  '将Stream中数据写入临时文件中
　　　　.Close
　　End With
　　Picture1.Picture = LoadPicture(StrPicTemp)  '用Picture控件显示图像
　　......

Answer 3

谁在自己的机子上做一个，然后压缩一下发给我好吗？
[email protected]
解决问题的话我请他（她）吃饭

Answer 4

'物品管制系統
'img為保存圖片的字段，類型為image
Private conn As New ADODB.Connection
Private rs As New ADODB.Recordset
Private DBDT As New ADODB.RecordsetPrivate Sub OpenDB()
    With conn
        If .State = adStateOpen Then
            .Close
        End If
        .CursorLocation = adUseClient
        .CommandTimeout = 0
        .Mode = adModeReadWrite
        .Open connstr  'connstr 連接db的字符串
      End With
End SubPrivate Sub cmdOK_Click()
    Dim bteContent() As Byte
    Dim pName As String
    Dim SQL As String
    Dim m_YMD As String
    
    On Error Resume Next
    Text1.SetFocus
    With CommonDialog1
        .DialogTitle = "打開圖片"
        .Filter = "圖象文件|*.jpg;*.jpeg;*.bmp;*.gif|所有文件(*.*)|*.*"
        .ShowOpen
        pName = .FileName
    End With
'------------------------------保存圖片
    Open pName For Binary Access Read As #1
        bteContent = InputB(LOF(1), #1)
    Close #1    If rs.State = adStateOpen Then rs.Close
    SQL = "select * from control_card where flow_no='" & UCase(Text1.Text) & "'"
    rs.Open SQL, conn, adOpenDynamic, adLockPessimistic
    rs.Fields("img").AppendChunk bteContent
    rs.Update    Erase bteContent
    
---------------------------顯視圖片
    
    If rs.State = adStateOpen Then
        rs.Close
    End If    If Text1.Text = "" Then
        MsgBox "請輸入管制條碼!", vbInformation
        Exit Sub
    End If
    'SQL = "select * from control_card where flow_no='" & UCase(Text1.Text) & "'"
    SQL = "select emp_no,emp_name,datetime_flag ,emp_dept,img,DATEDIFF(dd,getdate(), DATETIME_FLAG) AS DATE_TIME from control_card " _
       & " where flow_no='" & UCase(Text1.Text) & "'"
    rs.Open SQL, conn, adOpenForwardOnly, adLockReadOnly    If rs.EOF = True Then
        Text1.Text = ""
        Label3.Font.Size = 40
        'Label3.Alignment = vbCenter
        Label3.Caption = "不予放行!"
        Picture1.Picture = LoadPicture()
        Label3.BackColor = RGB(255, 0, 0)
        Text1.SetFocus
        Exit Sub
    Else
        '---------是否過期的判斷
        Set DBDT = conn.Execute("SELECT GETDATE() AS DATE_TIME")
        If rs.Fields("DATE_TIME").Value < 0 Then
            MsgBox "期限已過，請跟資訊聯系!"
            Text1.Text = ""
            Label3.Font.Size = 40
            Label3.Caption = "不予放行!"
            Picture1.Picture = LoadPicture()
            Label3.BackColor = RGB(255, 0, 0)
            Text1.SetFocus
            Exit Sub
        End If
        '---------是否過期的判斷
        bteContent = rs.Fields("img").GetChunk(rs.Fields("img").ActualSize)
        If Len(Trim(CByte(bteContent))) > 0 Then
            Label3.Font.Size = 12
            Label3.Caption = "工號：" & rs.Fields("emp_no").Value & vbCrLf & vbCrLf & _
            "姓名：" & rs.Fields("emp_name").Value & vbCrLf & vbCrLf & _
            "部門：" & rs.Fields("emp_dept").Value & vbCrLf & vbCrLf & "請  給  予  放  行"
            Label3.BackColor = RGB(20, 150, 200)
            Text1.Text = ""
            Text1.SetFocus
            Open "c:\temp.jpg" For Binary Access Write As #1
                Put #1, , bteContent
            Close #1
            Picture1.Picture = LoadPicture("c:\temp.jpg")
        Else
            MsgBox "此物品沒有圖片，不予放行!", vbExclamation
            Picture1.Picture = LoadPicture()
            Text1.Text = ""
            Label3.Font.Size = 40
            Label3.Caption = "不予放行!"
            Picture1.Picture = LoadPicture()
            Label3.BackColor = RGB(255, 0, 0)
            Text1.SetFocus
            Exit Sub
        End If
    End If
    
End SubPrivate Sub Form_Load()
    Call OpenDB
End SubPrivate Sub Form_Unload(Cancel As Integer)
    Set conn = Nothing
    Set rs = Nothing
    
End SubPrivate Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        'cmdOK.SetFocus
        cmdOK_Click
    Else
        'cmdOK.Enabled = True
    End If
End SubPrivate Sub Timer1_Timer()
    Dim Index As Integer
    On Error Resume Next
    '---------------跑馬燈字串
    If Label2.Left <= 0 Then
       Label2.Left = 12000
    Else
       Label2.Move Label2.Left - 200
    End If
    Exit SubEnd Sub