Keskustelu: Ohjelmointikysymykset: VB.NET: Kuva Accesiin ja takas. VB2008

'Luokka: dbcreate (dbcreate.cls)
Option Explicit
Private Const DLL_PROCESS_DETACH = 0
Private Const DLL_PROCESS_ATTACH = 1
Private Const DLL_THREAD_ATTACH = 2
Private Const DLL_THREAD_DETACH = 3

Public Function DllMain(hInst As Long, _
fdwReason As Long, lpvReserved As Long) As Boolean
   Select Case fdwReason
      Case DLL_PROCESS_DETACH
      Case DLL_PROCESS_ATTACH
         DllMain = True
      Case DLL_THREAD_ATTACH
      Case DLL_THREAD_DETACH
   End Select
End Function

Public Sub dbCreate(ByRef FullPath As String)
  If Dir(FullPath) = "" Then
    Dim dbDao As DAO.Database
    Set dbDao = CreateDatabase(FullPath, dbLangGeneral)
  End If
End Sub

Imports System
Imports System.IO
Imports System.Data
Imports System.Data.OleDb
Imports MyDaoDbCreate 'ADOX jos käyttää ADO.NET-kamaa

'...

Sub MainFormLoad(sender As Object, e As EventArgs)

  Dim dbPath As String = Environment.GetFolderPath( _
  Environment.SpecialFolder.Personal) + "\PicBase"
  Try
    MkDir(dbPath)
  Catch ex As Exception
  End Try
  If Dir(dbPath + "\picbase.mdb") = "" Then
    '*** tähän tilalle ADOX jutskat mikäli
    Dim dbc As New MyDaoDbCreate.dbcreateClass()
    Try
      dbc.dbCreate(dbPath + "\picbase.mdb")
    Catch ex As Exception
    End Try
    ' ***
    If Dir(dbPath + "\picbase.mdb")<> "" Then
      Dim connstr As String = _
      "Provider=Microsoft.Jet.OLEDB.4.0; " + _
      "Ole DB Services=-4; Data Source=" + _
      dbPath + "\picbase.mdb"
      Dim conn As New OleDbConnection(connstr)
      Dim cmd As OleDbCommand = conn.CreateCommand()
      cmd.CommandText = "CREATE TABLE pictures (fname " _
      + "TEXT(50) PRIMARY KEY NOT NULL, picdata OleObject NOT NULL)"
      conn.Open
      cmd.ExecuteNonQuery()
      conn.Close()

    End If
  End If
End Sub

Sub Button1Click(sender As Object, e As EventArgs)

  OpenFileDialog1.InitialDirectory = _
  Environment.GetFolderPath( _
  Environment.SpecialFolder.MyPictures)
  OpenFileDialog1.Filter = _
  "Bitmap (*.bmp)|*.bmp|" + _
  "Compuserve (*.gif)|*.gif|" + _
  "Portable (*.png)|*.png|" + _
  "JPEG (*.jpg)|*.jpg"
  'jne...
   OpenFileDialog1.RestoreDirectory = True
   OpenFileDialog1.FileName = ""
   If openFileDialog1.ShowDialog() = _
   System.Windows.Forms.DialogResult.OK Then
     Dim fname As String = OpenFileDialog1.FileName
     Dim fsplit() As String = Split(fname,"\")
     Dim fstream As New FileStream( _
     fname, FileMode.Open, FileAccess.Read)
     Dim breader As New BinaryReader(fstream)
     Dim bytes() AS Byte = Nothing
     Dim i As Integer = 0
     For i = 0 to fstream.Length - 1
      Redim preserve bytes(i)
      bytes(i) = breader.ReadByte
     Next i
     breader.Close:breader = nothing
     fstream.Close:fstream = nothing

     Dim dbPath As String = _
     Environment.GetFolderPath( _
     Environment.SpecialFolder.Personal) + _
    "\PicBase"
     Dim connstr As String = _
     "Provider=Microsoft.Jet.OLEDB.4.0; " + _
     "Ole DB Services=-4; Data Source=" + _
     dbPath + "\picbase.mdb"
     Dim conn As OleDbConnection = _
     New OleDbConnection(connstr)
     Dim query As String = _
     "SELECT * FROM pictures WHERE fname = '" + _
     fsplit(fsplit.GetUpperBound(0)) + "'"
     Dim ds As DataSet = New DataSet
     conn.Open
     Dim da As OleDbDataAdapter = _
     New OleDbDataAdapter(query,conn)
     Dim cb As OleDbCommandBuilder = _
     New OleDbCommandBuilder(da)
     da.Fill(ds,"pictures")
     If ds.Tables("pictures").Rows.Count > 0 Then
     	Dim msgresult As Integer = _
     	Messagebox.Show("Tietokannassa on jo saman niminen kuva" _
          + Environment.NewLine + "Korvataanko kuva?", _
          "Tietokantailmoitus", _
          MessageBoxButtons.OKCancel,MessageBoxIcon.Information)
        If msgresult <> 1 Then
          GoTo ExitProc
        Else
          ds.Tables("pictures").Rows(0).Delete
          da.Update(ds,"pictures")
        End If
     End If

     query = "SELECT * From pictures"
     cb.RefreshSchema
     ds.Tables.Clear
     da.TableMappings.Clear
     da.SelectCommand = New OleDbCommand(query,conn)
     cb.DataAdapter = da
     da.Fill(ds,"pictures")
     Dim row As DataRow = _
     ds.Tables("pictures").NewRow()
     row("fname") = fsplit(fsplit.GetUpperBound(0))
     row("picdata") = bytes: bytes = Nothing
     ds.Tables("pictures").Rows.Add(row)
     da.Update(ds,"pictures")
       ExitProc:
     ds = Nothing: cb = Nothing
     da = Nothing: conn.Close
   End If

End Sub

Sub Button2Click(sender As Object, e As EventArgs)

  Dim basePath As String = Environment.GetFolderPath( _
  Environment.SpecialFolder.Desktop)
  Dim dbPath As String = _
  Environment.GetFolderPath( _
  Environment.SpecialFolder.Personal) _
  & "\PicBase"
  Dim connstr As String = _
     "Provider=Microsoft.Jet.OLEDB.4.0; " + _
     "Ole DB Services=-4; Data Source=" + _
     dbPath + "\picbase.mdb"

     Dim conn As OleDbConnection = _
     New OleDbConnection(connstr)
     Dim query As String = _
     "SELECT * FROM pictures"

     Dim ds As DataSet = New DataSet
     conn.Open
     Dim da As OleDbDataAdapter = _
     New OleDbDataAdapter(query,conn)
     da.Fill(ds,"pictures")
     If ds.Tables("pictures").Rows.Count > 0 Then
     Dim row As DataRow

     For Each row In ds.Tables("pictures").Rows
       Dim fname As String = (row)("fname").ToString

       Select Case fname.Substring(fname.Length -3, 3)
           Case "bmp"
             SaveFileDialog1.Filter = _
             "Bitmap (*.bmp)|*.bmp"
           Case "gif"
             SaveFileDialog1.Filter = _
             "Compuserve (*.gif)|*.gif"
           Case "png"
             SaveFileDialog1.Filter = _
             "Portaple (*.png)|*.png"
           Case "jpg"
             SaveFileDialog1.Filter = _
             "JPEG (*.jpg)|*.jpg"
           'jne...
       End Select

       SaveFileDialog1.RestoreDirectory = True
       SaveFileDialog1.FileName = basePath + "\" + (row)("fname")
        If SaveFileDialog1.ShowDialog()  = _
           System.Windows.Forms.DialogResult.OK Then
           If File.Exists(SaveFileDialog1.FileName) Then
             FileSystem.Kill(SaveFileDialog1.FileName)
           End If
           Dim fstream As New FileStream( _
           SaveFileDialog1.FileName, FileMode.CreateNew)
           Dim bwriter As New BinaryWriter(fstream)
           Dim bytes() As Byte
           bytes = (row)("picdata")
           Dim i As Integer = 0
           While i <= bytes.GetUpperBound(0)
           bwriter.Write(bytes(i))
           i += 1
           End While
           bwriter.Close: bwriter = Nothing
           fstream.Close: fstream = Nothing
           bytes = Nothing
        End If
    Next
  End If

End Sub