Minkälainen mahtaisi olla koodi VB-2010:ssä, jolla lukisi ja kirjoittaisi access kantaan (MS access 2002), kuten VB6 DAO:lla tehtynä (recordset).
Pitäisi kerätä/päivittää tiedot valikoiduista Fields:stä (?)
kysyy: entinen VB6 koodaaja, nykyinen aloittelija VB2010
Moi erkki!
Ekaks: Olisit voinut laittaa kysymyksesi VB-osasatoon, mutta...
'HUOM! esimerkki väännetty SharpDevelop 4.2:lla
'Projektiin COM-referenssi:
'Microsoft DAO 3.6 Object Library
Imports dao
Public Partial Class MainForm
Private dbDao As dao.Database
Private dbEngine As dao.DBEngine = New dao.DBEngine
Private rsDao As Recordset = Nothing
Public Sub New()
Me.InitializeComponent()
End Sub
Sub MainFormLoad(sender As Object, e As EventArgs)
dbDao = dbEngine.OpenDatabase("C:\Tietokanta.mdb") 'esim.
rsDao = dbDao.OpenRecordset("TauluX") 'esim.
If rsDao.RecordCount > 0 Then
rsDao.MoveFirst
FillBoxes
End If
End Sub
Sub Button1Click(sender As Object, e As EventArgs)
'lisää uuden tietueen
For i As Integer = 1 To 8
If Me.Controls("textBox" + CStr(i)).Text = String.Empty Then
Me.Controls("textBox" + CStr(i)).Focus: Exit Sub
End If
Next
If rsDao.RecordCount > 0 Then
rsDao.MoveLast
End If
Try
rsDao.AddNew
SetValues
rsDao.Update
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Sub Button2Click(sender As Object, e As EventArgs)
'Päivittää tietueen tiedot
For i As Integer = 1 To 8
If Me.Controls("textBox" + CStr(i)).Text = String.Empty Then
Me.Controls("textBox" + CStr(i)).Focus: Exit Sub
End If
Next
If rsDao.RecordCount > 0 Then
rsDao.MoveFirst
Do While Not rsDao.EOF
Application.DoEvents
If rsDao.Fields("ID").Value.ToString = label1.Text Then
Try
rsDao.Edit
SetValues
rsDao.Update
Catch ex As Exception
MsgBox(ex.Message)
End Try
Exit Do
End If
rsDao.MoveNext
Loop
End If
End Sub
Sub Button3Click(sender As Object, e As EventArgs)
'Poistaa tietueen
If rsDao.RecordCount > 0 Then
rsDao.MoveFirst
Do While Not rsDao.EOF
Application.DoEvents
If rsDao.Fields("ID").Value.ToString = label1.Text Then
rsDao.Delete
If rsDao.RecordCount > 0 Then
rsDao.MoveFirst
FillBoxes
Else
ClearBoxes
End If
Exit Do
End If
rsDao.MoveNext
Loop
End If
End Sub
Sub Button4Click(sender As Object, e As EventArgs)
Try
rsDao.MoveFirst
FillBoxes
Catch ex As Exception
End Try
End Sub
Sub Button5Click(sender As Object, e As EventArgs)
Try
rsDao.MovePrevious
FillBoxes
Catch ex As Exception
End Try
End Sub
Sub Button6Click(sender As Object, e As EventArgs)
Try
rsDao.MoveNext
FillBoxes
Catch ex As Exception
End Try
End Sub
Sub Button7Click(sender As Object, e As EventArgs)
Try
rsDao.MoveLast
FillBoxes
Catch ex As Exception
End Try
End Sub
Sub FillBoxes()
With rsDao
label1.Text = .Fields("ID").Value.ToString 'laskuri
textBox1.Text = .Fields("Etunimi").Value.ToString
textBox2.Text = .Fields("Sukunimi").Value.ToString
textBox3.Text = .Fields("Osoite").Value.ToString
textBox4.Text = .Fields("Postinumero").Value.ToString
textBox5.Text = .Fields("Postitoimipaikka").Value.ToString
textBox6.Text = .Fields("Puhelin").Value.ToString
textBox7.Text = .Fields("Sähköposti").Value.ToString
textBox8.Text = .Fields("Merkinnät").Value.ToString
End With
'sama asia...
'With rsDao
'label1.Text = .Fields(0).Value.ToString 'laskuri
'For i As Integer = 1 To 8
'Me.Controls("textBox" + CStr(i)).Text = _
'.Fields(i).Value.ToString
'Next
'End With
End Sub
Sub SetValues()
With rsDao
'Esimerkin datatyypi on joko TEKST tai MEMO
'lukuunottamatta tietenkin laskuria (ID -kenttä)
'joten tekstiruutujen arvojen suhteen joutuu
'tekemään muutoksia päivitettäessä esim. päivämääriä
.Fields("Etunimi").Value = textBox1.Text
.Fields("Sukunimi").Value = textBox2.Text
.Fields("Osoite").Value = textBox3.Text
.Fields("Postinumero").Value = textBox4.Text
.Fields("Postitoimipaikka").Value = textBox5.Text
.Fields("Puhelin").Value = textBox6.Text
.Fields("Sähköposti").Value = textBox7.Text
.Fields("Merkinnät").Value = textBox8.Text
End With
'sama asia...
'With rsDao
'For i As Integer = 1 To 8
'.Fields(i).Value = Me.Controls("textBox" + CStr(i)).Text
'Next
'End With
End Sub
Sub ClearBoxes()
label1.Text = String.Empty
For i As Integer = 1 To 8
Me.Controls("textBox" + CStr(i)).Text = String.Empty
Next
End Sub
Sub MainFormFormClosing(sender As Object, e As FormClosingEventArgs)
rsDao.Close: rsDao = Nothing
dbDao.Close: dbDao = Nothing
dbEngine = Nothing
End Sub
End Classhalutessaan valmiin +esimerkkiprojektin voi ladata täältä
Samaa paskaa datasetillä...
'HUOM! esimerkki väännetty SharpDevelop 4.2:lla
Imports System.Data
Imports System.Data.OleDb
Public Partial Class MainForm
Private conn As OleDbConnection = Nothing
Private ds As DataSet = Nothing
Private sql As String = String.Empty
Public Sub New()
Me.InitializeComponent()
End Sub
Sub MainFormLoad(sender As Object, e As EventArgs)
conn = New OleDbConnection( _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Tietokanta.mdb;")
conn.Open
sql = "SELECT * FROM TauluX"
Dim da As OleDbDataAdapter = New OleDbDataAdapter(sql, conn)
ds = New DataSet
da.Fill(ds,"TauluX")
If ds.Tables("TauluX").Rows.Count > 0 Then
For i As Integer = 0 To ds.Tables("TauluX").Columns.Count -1
If i = 0 Then
label1.Text = CStr(i + 1) _
+ "/" + CStr(ds.Tables("TauluX").Rows.Count)
Else
Controls("textBox" + CStr(i)).Text = _
ds.Tables("TauluX").Rows(0)(i).ToString
End If
Next
End If
End Sub
Sub Button1Click(sender As Object, e As EventArgs)
If ds.Tables("TauluX").Rows.Count > 0 Then
For i As Integer = 0 To ds.Tables("TauluX").Columns.Count -1
If i = 0 Then
label1.Text = CStr(i + 1) _
+ "/" + CStr(ds.Tables("TauluX").Rows.Count)
Else
Controls("textBox" + CStr(i)).Text = _
ds.Tables("TauluX").Rows(0)(i).ToString
End If
Next
End If
End Sub
Sub Button2Click(sender As Object, e As EventArgs)
If ds.Tables("TauluX").Rows.Count > 0 Then
Dim strcount() As String
strcount = label1.Text.Split(CType("/",Char))
Dim cnt As Integer = CType(strcount(0),Integer) - 1
If cnt > 0 Then
For i As Integer = 0 To ds.Tables("TauluX").Columns.Count -1
If i = 0 Then
label1.Text = CStr(cnt) _
+ "/" + CStr(ds.Tables("TauluX").Rows.Count)
Else
Controls("textBox" + CStr(i)).Text = _
ds.Tables("TauluX").Rows(cnt-1)(i).ToString
End If
Next
End If
End If
End Sub
Sub Button3Click(sender As Object, e As EventArgs)
If ds.Tables("TauluX").Rows.Count > 0 Then
Dim strcount() As String
strcount = label1.Text.Split(CType("/",Char))
Dim cnt As Integer = CType(strcount(0),Integer) + 1
If cnt <= ds.Tables("TauluX").Rows.Count Then
For i As Integer = 0 To ds.Tables("TauluX").Columns.Count -1
If i = 0 Then
label1.Text = CStr(cnt) _
+ "/" + CStr(ds.Tables("TauluX").Rows.Count)
Else
Controls("textBox" + CStr(i)).Text = _
ds.Tables("TauluX").Rows(cnt - 1)(i).ToString
End If
Next
End If
End If
End Sub
Sub Button4Click(sender As Object, e As EventArgs)
If ds.Tables("TauluX").Rows.Count > 0 Then
For i As Integer = 0 To ds.Tables("TauluX").Columns.Count -1
If i = 0 Then
label1.Text = CStr(ds.Tables("TauluX").Rows.Count) _
+ "/" + CStr(ds.Tables("TauluX").Rows.Count)
Else
Controls("textBox" + CStr(i)).Text = _
ds.Tables("TauluX").Rows(ds.Tables("TauluX").Rows.Count - 1)(i).ToString
End If
Next
End If
End Sub
Sub Button5Click(sender As Object, e As EventArgs)
'Lisää uuden tietueen
If button5.Text = "Lisää tietue" Then
For i As Integer = 1 To 7
If i = 5 Then
Me.Controls("button" + CStr(i)).Text = "Jatka"
End If
If i <> 5 Then
Me.Controls("button" + CStr(i)).Enabled = False
End If
Next
label1.Text = String.Empty
For i As Integer = 1 To 8
Me.Controls("textBox" + CStr(i)).Text = String.Empty
Next
textBox1.Focus: Exit Sub
ElseIf button5.Text = "Jatka" Then
For i As Integer = 1 To 8
If Me.Controls("textBox" + CStr(i)).Text = String.Empty Then
Me.Controls("textBox" + CStr(i)).Focus: Exit Sub
End If
Next
Dim drow As DataRow = ds.Tables("TauluX").NewRow
ds.Tables("TauluX").Rows.Add(drow)
For i As Integer = 1 To ds.Tables("TauluX").Columns.Count -1
ds.Tables("TauluX").Rows(ds.Tables("TauluX").Rows.Count - 1)(i) _
= Controls("textBox" + CStr(i)).Text
Next
Dim da As OleDbDataAdapter = New OleDbDataAdapter(sql, conn)
Dim cb As OleDbCommandBuilder = New OleDbCommandBuilder(da)
da.Update(ds,"TauluX")
da.TableMappings.Clear
cb.Dispose: da.Dispose
drow = Nothing
If ds.Tables("TauluX").Rows.Count > 0 Then
For i As Integer = 0 To ds.Tables("TauluX").Columns.Count -1
If i = 0 Then
label1.Text = CStr(ds.Tables("TauluX").Rows.Count) _
+ "/" + CStr(ds.Tables("TauluX").Rows.Count)
Else
Controls("textBox" + CStr(i)).Text = _
ds.Tables("TauluX").Rows(ds.Tables("TauluX").Rows.Count - 1)(i).ToString
End If
Next
End If
For i As Integer = 1 To 7
If i = 5 Then
Me.Controls("button" + CStr(i)).Text = "Lisää tietue"
End If
If i <> 5 Then
Me.Controls("button" + CStr(i)).Enabled = True
End If
Next
End If
End Sub
Sub Button6Click(sender As Object, e As EventArgs)
'Päivittää tietueen
For i As Integer = 1 To 8
If Me.Controls("textBox" + CStr(i)).Text = String.Empty Then
Me.Controls("textBox" + CStr(i)).Focus: Exit Sub
End If
Next
Dim strcount() As String
strcount = label1.Text.Split(CType("/",Char))
Dim cnt As Integer = CType(strcount(0),Integer) - 1
For i As Integer = 1 To ds.Tables("TauluX").Columns.Count - 1
ds.Tables("TauluX").Rows(cnt)(i) = Me.Controls("textBox" + CStr(i)).Text
Next
Dim da As OleDbDataAdapter = New OleDbDataAdapter(sql, conn)
Dim cb As OleDbCommandBuilder = New OleDbCommandBuilder(da)
da.Update(ds,"TauluX")
da.TableMappings.Clear
cb.Dispose: da.Dispose
End Sub
Sub Button7Click(sender As Object, e As EventArgs)
'Poistaa tietueen
Dim strcount() As String
strcount = label1.Text.Split(CType("/",Char))
Dim cnt As Integer = CType(strcount(0),Integer) - 1
ds.Tables("TauluX").Rows(cnt).Delete
Dim da As OleDbDataAdapter = New OleDbDataAdapter(sql, conn)
Dim cb As OleDbCommandBuilder = New OleDbCommandBuilder(da)
da.Update(ds,"TauluX")
da.TableMappings.Clear
cb.Dispose: da.Dispose
If ds.Tables("TauluX").Rows.Count >= cnt Then
For i As Integer = 0 To ds.Tables("TauluX").Columns.Count -1
If i = 0 Then
label1.Text = CStr(cnt) + "/" + CStr(ds.Tables("TauluX").Rows.Count)
Else
Controls("textBox" + CStr(i)).Text = ds.Tables("TauluX").Rows(cnt - 1)(i).ToString
End If
Next
Exit Sub
End If
If ds.Tables("TauluX").Rows.Count > 0 And ds.Tables("TauluX").Rows.Count < cnt Then
For i As Integer = 0 To ds.Tables("TauluX").Columns.Count -1
If i = 0 Then
label1.Text = CStr(ds.Tables("TauluX").Rows.Count) _
+ "/" + CStr(ds.Tables("TauluX").Rows.Count)
Else
Controls("textBox" + CStr(i)).Text = _
ds.Tables("TauluX").Rows(ds.Tables("TauluX").Rows.Count - 1)(i).ToString
End If
Next
Exit Sub
End If
If ds.Tables("TauluX").Rows.Count = 0 Then
label1.Text = String.Empty
For i As Integer = 1 To 8
Me.Controls("textBox" + CStr(i)).Text = String.Empty
Next
End If
End Sub
Sub MainFormFormClosing(sender As Object, e As FormClosingEventArgs)
ds.Dispose: conn.Close: conn.Dispose
End Sub
End Classhalutessaan valmiin +esimerkkiprojektin voi ladata täältä
-Nea- :)
Nea
Kiitos, lähden tuosta työstämään
Voisinkohan kysyä miten selviän sotkusta, jonka sain aikaan "editoimalla" datasource/dataset/table linkkitietoja. Onnnistuin hävittämään yhden Formin controllit kun datsource ei toimi. Kun ajaa Run niin silloin controllit ovat näkösällä.
Nea
Luulen että teen luvallasi tästä sinun esimerkistä tuon dataset version. muuntelen textboxit ja lisään mitä tarvitsen.
Aihe on jo aika vanha, joten et voi enää vastata siihen.