MIGRACAO ADO PARA DAO?
Olá pessoal...
Estou querendo migrar de ADO para DAO... Como faço a migração?
E quais as linhas que devo mudar p/ DAO?
em anexo o código de exemplo:
---------------------------------------------------------------------------------------------------------------
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim TblAed As String
'----------------------------------------------
Private Sub cmdgravar_Click()
On Error GoTo ErrHandler
If TblAed = "" Then
TblAed = App.Path + "\imagem.bmp"
End If
inclui um registro
rs.AddNew
If txtNome.Text = "" Then
txtNome.Text = ""
End If
rs("Nome") = txtNome.Text
Call SalvaImagem(rs.Fields("Foto"), TblAed)
rs.Update
ActiveControles True
rs.MoveLast
cmdgravar.Visible = False
Exit Sub
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Sub
'----------------------------------------------
Private Sub cmdinclui_Click()
txtNome = ""
seleciona_imagem
txtNome.SetFocus
cmdgravar.Visible = True
End Sub
'----------------------------------------------
Private Sub cmdsai_Click()
Unload Me
End Sub
'----------------------------------------------
Private Sub cmdexclui_Click()
rs.Delete
If rs.RecordCount Then
rs.MoveLast
exibe_registros
Else
ActiveControles False, "cmdinclui"
End If
End Sub
'----------------------------------------------
Private Sub cmdMoveregistro_Click(Index As Integer)
picimagem.SetFocus
With rs
Select Case Index
Case 0 'primeiro
If .AbsolutePosition > 1 Then
.MoveFirst
exibe_registros
End If
Case 1 'anterior
If .AbsolutePosition > 1 Then
.MovePrevious
exibe_registros
End If
Case 2 'proximo
If .AbsolutePosition < .RecordCount Then
.MoveNext
exibe_registros
End If
Case 3 'ultimo
If .AbsolutePosition < .RecordCount Then
.MoveLast
exibe_registros
End If
End Select
End With
End Sub
Private Sub Form_Load()
'----------------------------------------------
'abre conexao e define o recordset
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\aed.mdb;"
rs.CursorLocation = adUseClient
rs.Open "Select * From TblAed", cnn, adOpenKeyset, adLockOptimistic, adCmdText
If rs.RecordCount = 0 Then
ActiveControles False, "cmdinclui"
End If
exibe_registros
End Sub
'----------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
cnn.Close
Set rs = Nothing
End Sub
Private Sub ActiveControles(Action As Boolean, ParamArray Exeptions() As Variant)
Dim v As Variant
Dim ctlName As String
Dim Use As Boolean
Dim ctl As Control
On Error Resume Next
For Each ctl In Controls
ctlName = ctl.Name
Use = True
For Each v In Exeptions
If ctlName = v Then
Use = False
Exit For
End If
Next
If Use Then
If Not ctl.Enabled = Action Then
ctl.Enabled = Action
End If
End If
Next
End Sub
'----------------------------------------------
Private Sub seleciona_imagem()
Dim filter As String
TblAed = ""
filter = "Arquivos bmp (*.bmp*) | *.bmp*"
CommonDialog1.filter = filter
'diretorio onde estao as imagens
CommonDialog1.InitDir = App.Path
CommonDialog1.DefaultExt = "*.*"
CommonDialog1.ShowOpen
TblAed = CommonDialog1.filename
If TblAed <> "" Then
picimagem.Picture = LoadPicture(TblAed)
Else
picimagem.Picture = LoadPicture("")
End If
End Sub
Private Sub exibe_registros()
Set Me.picimagem = ExibeImagensGrandes(rs.Fields("Foto"))
txtNome = rs.Fields("Nome")
End Sub
--------------------------------------------------------------------------
'Módulo:
Private Const nBUFFER As Long = 1024
'imagens normais
Public Sub SalvaImagem(f As ADODB.Field, File As String)
Dim b() As Byte
Dim ff As Long
Dim n As Long
On Error GoTo ErrHandler
ff = FreeFile
Open File For Binary Access Read As ff
n = LOF(ff)
If n Then
ReDim b(1 To n) As Byte
Get ff, , b()
End If
Close ff
f.Value = b()
Exit Sub
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Sub
Public Function RecuperaImagem(f As ADODB.Field) As StdPicture
Dim b() As Byte
Dim ff As Long
Dim File As String
On Error GoTo ErrHandler
Call GetRandomFileName(File)
ff = FreeFile
Open File For Binary Access Write As ff
b() = f.Value
Put ff, , b()
Close ff
Erase b
Set GetImageFromField = LoadPicture(File)
Kill File
Exit Function
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Function
'imagens grandes
Public Sub SalvaImagensGrandes(f As ADODB.Field, File As String)
Dim b() As Byte
Dim ff As Long
Dim i As Long
Dim FileLen As Long
Dim Blocks As Long
Dim LeftOver As Long
On Error GoTo ErrHandler
ff = FreeFile
Open File For Binary Access Read As ff
FileLen = LOF(ff)
Blocks = Int(FileLen / nBUFFER)
LeftOver = FileLen Mod nBUFFER
ReDim b(LeftOver)
Get ff, , b()
f.AppendChunk b()
ReDim b(nBUFFER)
For i = 1 To Blocks
Get ff, , b()
f.AppendChunk b()
Next
Close ff
Exit Sub
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Sub
Public Function ExibeImagensGrandes(f As ADODB.Field) As StdPicture
Dim b() As Byte
Dim ff As Long
Dim File As String
Dim i As Long
Dim FileLen As Long
Dim Blocks As Long
Dim LeftOver As Long
On Error GoTo ErrHandler
File = "imagem.bmp"
ff = FreeFile
Open File For Binary Access Write As ff
Blocks = Int(f.ActualSize / nBUFFER)
LeftOver = f.ActualSize Mod nBUFFER
b() = f.GetChunk(LeftOver)
Put ff, , b()
For i = 1 To Blocks
b() = f.GetChunk(nBUFFER)
Put ff, , b()
Next
Close ff
Erase b
Set ExibeImagensGrandes = LoadPicture(File)
Kill File
Exit Function
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Function
'--------------------------------------------------------------
Agradeço a quem puder me ajudar na migração....
Grato,
Estou querendo migrar de ADO para DAO... Como faço a migração?
E quais as linhas que devo mudar p/ DAO?
em anexo o código de exemplo:
---------------------------------------------------------------------------------------------------------------
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim TblAed As String
'----------------------------------------------
Private Sub cmdgravar_Click()
On Error GoTo ErrHandler
If TblAed = "" Then
TblAed = App.Path + "\imagem.bmp"
End If
inclui um registro
rs.AddNew
If txtNome.Text = "" Then
txtNome.Text = ""
End If
rs("Nome") = txtNome.Text
Call SalvaImagem(rs.Fields("Foto"), TblAed)
rs.Update
ActiveControles True
rs.MoveLast
cmdgravar.Visible = False
Exit Sub
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Sub
'----------------------------------------------
Private Sub cmdinclui_Click()
txtNome = ""
seleciona_imagem
txtNome.SetFocus
cmdgravar.Visible = True
End Sub
'----------------------------------------------
Private Sub cmdsai_Click()
Unload Me
End Sub
'----------------------------------------------
Private Sub cmdexclui_Click()
rs.Delete
If rs.RecordCount Then
rs.MoveLast
exibe_registros
Else
ActiveControles False, "cmdinclui"
End If
End Sub
'----------------------------------------------
Private Sub cmdMoveregistro_Click(Index As Integer)
picimagem.SetFocus
With rs
Select Case Index
Case 0 'primeiro
If .AbsolutePosition > 1 Then
.MoveFirst
exibe_registros
End If
Case 1 'anterior
If .AbsolutePosition > 1 Then
.MovePrevious
exibe_registros
End If
Case 2 'proximo
If .AbsolutePosition < .RecordCount Then
.MoveNext
exibe_registros
End If
Case 3 'ultimo
If .AbsolutePosition < .RecordCount Then
.MoveLast
exibe_registros
End If
End Select
End With
End Sub
Private Sub Form_Load()
'----------------------------------------------
'abre conexao e define o recordset
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\aed.mdb;"
rs.CursorLocation = adUseClient
rs.Open "Select * From TblAed", cnn, adOpenKeyset, adLockOptimistic, adCmdText
If rs.RecordCount = 0 Then
ActiveControles False, "cmdinclui"
End If
exibe_registros
End Sub
'----------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
cnn.Close
Set rs = Nothing
End Sub
Private Sub ActiveControles(Action As Boolean, ParamArray Exeptions() As Variant)
Dim v As Variant
Dim ctlName As String
Dim Use As Boolean
Dim ctl As Control
On Error Resume Next
For Each ctl In Controls
ctlName = ctl.Name
Use = True
For Each v In Exeptions
If ctlName = v Then
Use = False
Exit For
End If
Next
If Use Then
If Not ctl.Enabled = Action Then
ctl.Enabled = Action
End If
End If
Next
End Sub
'----------------------------------------------
Private Sub seleciona_imagem()
Dim filter As String
TblAed = ""
filter = "Arquivos bmp (*.bmp*) | *.bmp*"
CommonDialog1.filter = filter
'diretorio onde estao as imagens
CommonDialog1.InitDir = App.Path
CommonDialog1.DefaultExt = "*.*"
CommonDialog1.ShowOpen
TblAed = CommonDialog1.filename
If TblAed <> "" Then
picimagem.Picture = LoadPicture(TblAed)
Else
picimagem.Picture = LoadPicture("")
End If
End Sub
Private Sub exibe_registros()
Set Me.picimagem = ExibeImagensGrandes(rs.Fields("Foto"))
txtNome = rs.Fields("Nome")
End Sub
--------------------------------------------------------------------------
'Módulo:
Private Const nBUFFER As Long = 1024
'imagens normais
Public Sub SalvaImagem(f As ADODB.Field, File As String)
Dim b() As Byte
Dim ff As Long
Dim n As Long
On Error GoTo ErrHandler
ff = FreeFile
Open File For Binary Access Read As ff
n = LOF(ff)
If n Then
ReDim b(1 To n) As Byte
Get ff, , b()
End If
Close ff
f.Value = b()
Exit Sub
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Sub
Public Function RecuperaImagem(f As ADODB.Field) As StdPicture
Dim b() As Byte
Dim ff As Long
Dim File As String
On Error GoTo ErrHandler
Call GetRandomFileName(File)
ff = FreeFile
Open File For Binary Access Write As ff
b() = f.Value
Put ff, , b()
Close ff
Erase b
Set GetImageFromField = LoadPicture(File)
Kill File
Exit Function
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Function
'imagens grandes
Public Sub SalvaImagensGrandes(f As ADODB.Field, File As String)
Dim b() As Byte
Dim ff As Long
Dim i As Long
Dim FileLen As Long
Dim Blocks As Long
Dim LeftOver As Long
On Error GoTo ErrHandler
ff = FreeFile
Open File For Binary Access Read As ff
FileLen = LOF(ff)
Blocks = Int(FileLen / nBUFFER)
LeftOver = FileLen Mod nBUFFER
ReDim b(LeftOver)
Get ff, , b()
f.AppendChunk b()
ReDim b(nBUFFER)
For i = 1 To Blocks
Get ff, , b()
f.AppendChunk b()
Next
Close ff
Exit Sub
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Sub
Public Function ExibeImagensGrandes(f As ADODB.Field) As StdPicture
Dim b() As Byte
Dim ff As Long
Dim File As String
Dim i As Long
Dim FileLen As Long
Dim Blocks As Long
Dim LeftOver As Long
On Error GoTo ErrHandler
File = "imagem.bmp"
ff = FreeFile
Open File For Binary Access Write As ff
Blocks = Int(f.ActualSize / nBUFFER)
LeftOver = f.ActualSize Mod nBUFFER
b() = f.GetChunk(LeftOver)
Put ff, , b()
For i = 1 To Blocks
b() = f.GetChunk(nBUFFER)
Put ff, , b()
Next
Close ff
Erase b
Set ExibeImagensGrandes = LoadPicture(File)
Kill File
Exit Function
ErrHandler:
MsgBox "ERROR: " & Err.Description
End Function
'--------------------------------------------------------------
Agradeço a quem puder me ajudar na migração....
Grato,
Se não me engano, você tinha aberto um tópico anterior pergutando o porque da lentidão ao executar as rotinas, e agora quer migrar para DAO (Retroceder) provavelmente alguém lhe falou que DAO é mais rápido que ADO, em alguns pontos sim, DAO é LEVEMENTE (Não é algo tão robusto) mais rápido, mas com certeza terás algumas limitações, e com o tamanho do código e das instruções acima, vai contunar lento o processo...
Caro GERMANIR,
C/ certeza não foi eu que abrir o tópico a qual vc está citando...
Grato,
C/ certeza não foi eu que abrir o tópico a qual vc está citando...
Grato,
Um exemplo para te ajudar a mudar seu código:
Dim dbArq as database
Dim rsTabela as recordset
set dbarq = opendatabase("c: este este.mdb")
set rsTabela = dbarq.openrecordset("tabela1",dbopentable)
' para utilizar sintaxe SQL, set rsTabela = dbarq.openrecordset("SELECT * FROM TABELA1")
'NÃO SE ESQUEÇA DE VERIFICAR AS OPÇÕES NO HELP PARA OS PARÓ¡METROS DO OPENRECORDSET E DO OPENDATABASE. POR EXEMPLO:
'para abrir um snapshot que apenas apresenta os dados mas não permite edição e inclusão:
dbarq.openrecordset("SELECT * FROM TABELA1",dbopensnapshot) 'nao fiz isso no vb e posso estar errando a posição...
bom , abrindo sua tabela através do set rsTabela = dbarq.openrecordset("tabela1",dbopentable) , você poderá andar entre os registros através do rsTabela.MoveFirst, rsTabela.MoveLast, rsTabela.MoveNext, rsTabela.MovePrevious, de uma verificada no help.
Para verificar se vc está no inÃcio de sua tabela, ou seja, uma posição antes do primeiro registro, utilize if rsTabela.eof then...
Para verificar se vc está no final de sua tabela, ou seja, uma posição após o último registro, utilize if rsTabela.eof then...
Obs.: O primeiro e o último registro, depende do Ãndice que vc utilizou para ordenar a tabela ou da ordenação passada na cláusula SQL.
Para localizar uma informação no banco de dados, utilize o método Seek. Exemplo:
rsTabela.index = "idxNome" 'nome do Ãndice da coluna em que vc vai pesquisar
rsTabela.seek "=","Jose"
if rsTabela.noMatch then 'se nao encontrou o registro
msgbox "registro nao encontrado"
end if
Para verificar quantos registros existem em sua tabela, utilize:
rsTabela.movelast ' tem que mover para p último registro após a abertura dela, senão não dá certo
msgbox rsTabela.recordcount
para fechar seu recordset, utilize:
rsTabela.close
set rsTabela = nothing
faça o mesmo para fechar seu banco de dados:
dbArq.close
set dbArq = nothing
Dicas:
1. Utilizando a DAO, trabalhe sempre que possÃvel com recordsets do tipo dbOpenTable (se possÃvel, set rsTabela = dbarq.openrecordset("tabela1",dbopentable,,dbreadonly) e campos indexados para ganhar performance. Para retornar Recordsets do tipo Dynaset, por exemplo, demora um pouco.
2. Dê uma olhada no help sobre os métodos findfirst, etc... para recordsets tipoj dynaset.
3. Compacte constantemente seu banco de dados para ganhar performace.
4. Sempre abra o recordset, guarde o que vc precisa e feche-o.
Espero que tenha ajudado.
Dim dbArq as database
Dim rsTabela as recordset
set dbarq = opendatabase("c: este este.mdb")
set rsTabela = dbarq.openrecordset("tabela1",dbopentable)
' para utilizar sintaxe SQL, set rsTabela = dbarq.openrecordset("SELECT * FROM TABELA1")
'NÃO SE ESQUEÇA DE VERIFICAR AS OPÇÕES NO HELP PARA OS PARÓ¡METROS DO OPENRECORDSET E DO OPENDATABASE. POR EXEMPLO:
'para abrir um snapshot que apenas apresenta os dados mas não permite edição e inclusão:
dbarq.openrecordset("SELECT * FROM TABELA1",dbopensnapshot) 'nao fiz isso no vb e posso estar errando a posição...
bom , abrindo sua tabela através do set rsTabela = dbarq.openrecordset("tabela1",dbopentable) , você poderá andar entre os registros através do rsTabela.MoveFirst, rsTabela.MoveLast, rsTabela.MoveNext, rsTabela.MovePrevious, de uma verificada no help.
Para verificar se vc está no inÃcio de sua tabela, ou seja, uma posição antes do primeiro registro, utilize if rsTabela.eof then...
Para verificar se vc está no final de sua tabela, ou seja, uma posição após o último registro, utilize if rsTabela.eof then...
Obs.: O primeiro e o último registro, depende do Ãndice que vc utilizou para ordenar a tabela ou da ordenação passada na cláusula SQL.
Para localizar uma informação no banco de dados, utilize o método Seek. Exemplo:
rsTabela.index = "idxNome" 'nome do Ãndice da coluna em que vc vai pesquisar
rsTabela.seek "=","Jose"
if rsTabela.noMatch then 'se nao encontrou o registro
msgbox "registro nao encontrado"
end if
Para verificar quantos registros existem em sua tabela, utilize:
rsTabela.movelast ' tem que mover para p último registro após a abertura dela, senão não dá certo
msgbox rsTabela.recordcount
para fechar seu recordset, utilize:
rsTabela.close
set rsTabela = nothing
faça o mesmo para fechar seu banco de dados:
dbArq.close
set dbArq = nothing
Dicas:
1. Utilizando a DAO, trabalhe sempre que possÃvel com recordsets do tipo dbOpenTable (se possÃvel, set rsTabela = dbarq.openrecordset("tabela1",dbopentable,,dbreadonly) e campos indexados para ganhar performance. Para retornar Recordsets do tipo Dynaset, por exemplo, demora um pouco.
2. Dê uma olhada no help sobre os métodos findfirst, etc... para recordsets tipoj dynaset.
3. Compacte constantemente seu banco de dados para ganhar performace.
4. Sempre abra o recordset, guarde o que vc precisa e feche-o.
Espero que tenha ajudado.
Esse tópico me lembra um grupo americano de rock chamado DEVO (assim mesmo, em maiúsculas). Os componentes do grupo pregavam que a humanidade não tinha mais o que inventar, e que o futuro só tinha uma direção: para baixo. ViverÃamos então um irremediável retrocesso, uma involução (ou de-evolução, como eles batizaram o movimento.
Por conta disso faziam musiquinhas bem simplórias, tentando esconder o uso maciço do sintetizador. Enfim, ajudaram a formar o arcabouço do movimento New Wave que - bem ou mal - mudou a música nos anos 80 (eu acho que pra pior, bem pior).
Mas era tudo uma grande brincadeira, como tudo que se fez nos 80. Não era levado a sério, e nenhum componente do grupo esperava por isso.
O DAO é mais rápido que o ADO, com o MSAccess. Se bem utilizado, consegue trabalhar com uma boa margem de segurança e robustez em ambiente multi-usuário (já estou sentindo minha orelha ardendo; peguem leve nas crÃticas, por favor
). Tem muito projeto por aà rodando em rede com DAO, satisfatoriamente.
Mas sair do ADO pro DAO é praticar os ideais dos nossos amigos do DEVO. E as consequências serão sentidas mais à  frente, principalmente quando se pensar em um banco de dados "de verdade" ou quando a rede começar crescer.
Vi que você está armazenando imagens (grandes e pequenas). Isso come um tempo considerável. Acho que seria bom você checar esses tempos, que devem ser o verdadeiro motivo (pelo menos um dos motivos) para a perda de performance do seu projeto. Seria interessante comparar os tempos com conexão ADO e DAO. Mas a diferença teria que ser muito grande, e favorável ao DAO, para se pensar em involuir desse jeito.
Se quiserem saber mais sobre o DEVO, vejam aqui.
Por conta disso faziam musiquinhas bem simplórias, tentando esconder o uso maciço do sintetizador. Enfim, ajudaram a formar o arcabouço do movimento New Wave que - bem ou mal - mudou a música nos anos 80 (eu acho que pra pior, bem pior).
Mas era tudo uma grande brincadeira, como tudo que se fez nos 80. Não era levado a sério, e nenhum componente do grupo esperava por isso.
O DAO é mais rápido que o ADO, com o MSAccess. Se bem utilizado, consegue trabalhar com uma boa margem de segurança e robustez em ambiente multi-usuário (já estou sentindo minha orelha ardendo; peguem leve nas crÃticas, por favor
). Tem muito projeto por aà rodando em rede com DAO, satisfatoriamente.Mas sair do ADO pro DAO é praticar os ideais dos nossos amigos do DEVO. E as consequências serão sentidas mais à  frente, principalmente quando se pensar em um banco de dados "de verdade" ou quando a rede começar crescer.
Vi que você está armazenando imagens (grandes e pequenas). Isso come um tempo considerável. Acho que seria bom você checar esses tempos, que devem ser o verdadeiro motivo (pelo menos um dos motivos) para a perda de performance do seu projeto. Seria interessante comparar os tempos com conexão ADO e DAO. Mas a diferença teria que ser muito grande, e favorável ao DAO, para se pensar em involuir desse jeito.
Se quiserem saber mais sobre o DEVO, vejam aqui.
Obrigado pelo exemplo HAWK.
Tópico encerrado , respostas não são mais permitidas