Connessione ODBC su database mdb presente su server web

Questa guida dimostra come accedere ad un database mdb presente su un server web (nel mio esempio Aruba) attraverso VB Express Edition 2005/2008. Per il momento il supporto è per:

• Esecuzione di query e restituzione DataTable corrispondente (EseguiQuery)

• Esecuzione di qualunque istruzione sql (update, insert, delete, ...) e di ottenere come risposta il corrispondente numero di righe modificate (EseguiCommand)

• Esecuzione di query con ritorno scalare attraverso il comando executeScalar il quale ritorna un Object (EseguiScalare)

Di seguito la classe per VB 2008:

Imports System.Xml

Public Class SqlHttpConnection

Private _SqlHttp As New SqlHttp()

Private NomeDb As String

Public Sub New(ByVal Sito As String, ByVal NomeDb As String)

_SqlHttp.Indirizzo = Sito.TrimEnd("/"c) & "/SqlHttp.asmx"

Me.NomeDb = NomeDb

End Sub

Public Function EseguiQuery(ByVal Sql As String) As DataTable

Dim richiesta As New SqlHttp.Richiesta()

richiesta.NomeDb = Me.NomeDb

richiesta.IstruzioneSql = Sql

richiesta.TipoIstruzione = SqlHttp.Richiesta.TIR.Table

Dim risposta As SqlHttp.Risposta = _SqlHttp.InvioRichiesta(richiesta)

If risposta.Risposta = SqlHttp.Risposta.RIS.Ok Then

Return risposta.Risultato

Else

MsgBox("Errore: " & risposta.Risultato.ToString)

Return Nothing

End If

End Function

Public Function EseguiCommand(ByVal Sql As String) As Integer

Dim richiesta As New SqlHttp.Richiesta()

richiesta.NomeDb = Me.NomeDb

richiesta.IstruzioneSql = Sql

richiesta.TipoIstruzione = SqlHttp.Richiesta.TIR.Command

Dim risposta As SqlHttp.Risposta = _SqlHttp.InvioRichiesta(richiesta)

If risposta.Risposta = SqlHttp.Risposta.RIS.Ok Then

Return risposta.Risultato

Else

MsgBox("Errore: " & risposta.Risultato.ToString)

Return Nothing

End If

End Function

Public Function EseguiScalare(ByVal Sql As String) As Object

Dim richiesta As New SqlHttp.Richiesta()

richiesta.NomeDb = Me.NomeDb

richiesta.IstruzioneSql = Sql

richiesta.TipoIstruzione = SqlHttp.Richiesta.TIR.Scalar

Dim risposta As SqlHttp.Risposta = _SqlHttp.InvioRichiesta(richiesta)

If risposta.Risposta = SqlHttp.Risposta.RIS.Ok Then

Return risposta.Risultato

Else

MsgBox("Errore: " & risposta.Risultato.ToString)

Return Nothing

End If

End Function

Public Class SqlHttp

Public Indirizzo As String = ""

Class Richiesta

Public NomeDb As String

Public TipoIstruzione As TIR

Public IstruzioneSql As String

Public Enum TIR

Table

Command 'Ritorno Integer (numero righe coinvolte)

Scalar 'Ritorno Object

End Enum

End Class

Class Risposta

Public Risposta As RIS

Public Risultato As Object

Public Enum RIS

Ok

Errore

End Enum

End Class

Public Function InvioRichiesta(ByVal Rich As Richiesta) As Risposta

Dim http As Net.HttpWebRequest

http = Net.HttpWebRequest.Create(Indirizzo)

http.ContentType = "text/xml"

Dim Xml As String = GeneraXmlRichiesta(Rich)

http.ContentLength = Xml.Length

http.Method = "POST"

http.Timeout = 10000

http.GetRequestStream.Write(System.Text.Encoding.ASCII.GetBytes(Xml), 0, Xml.Length)

'MsgBox(New IO.StreamReader(http.GetResponse().GetResponseStream).ReadToEnd())

'Ricezione Risposta

Dim rispostaStringa As String = New IO.StreamReader(http.GetResponse().GetResponseStream).ReadToEnd()

Dim risposta As Risposta = ElaboraXmlRisposta(rispostaStringa)

Return risposta

End Function

Private Function GeneraXmlRichiesta(ByVal Rich As Richiesta) As String

Dim Xml As New Xml.XmlDocument()

Dim NodoPadre As XmlNode = Xml.CreateElement("Richiesta")

Xml.AppendChild(NodoPadre)

'Nodo NomeDb

Dim NodoNomeDb As XmlNode = Xml.CreateElement("NomeDb")

NodoNomeDb.InnerText = Rich.NomeDb

NodoPadre.AppendChild(NodoNomeDb)

'Nodo TipoIstruzione

Dim NodoTipoIstruzione As XmlNode = Xml.CreateElement("TipoIstruzione")

NodoTipoIstruzione.InnerText = [Enum].GetName(GetType(Richiesta.TIR), Rich.TipoIstruzione)

NodoPadre.AppendChild(NodoTipoIstruzione)

'Nodo Istruzione Sql

Dim NodoIstruzione As XmlNode = Xml.CreateElement("IstruzioneSql")

NodoIstruzione.InnerText = Rich.IstruzioneSql

NodoPadre.AppendChild(NodoIstruzione)

'

Return Xml.InnerXml

End Function

Private Function ElaboraXmlRisposta(ByVal RispostaStringa As String) As Risposta

Dim risposta As New Risposta()

Dim Xml As New XmlDocument()

Xml.InnerXml = RispostaStringa

risposta.Risposta = [Enum].Parse(GetType(Risposta.RIS), Xml.SelectSingleNode("/Risposta/Risposta").InnerText)

Dim risultatoStringa As String = Xml.SelectSingleNode("/Risposta/Risultato").InnerText

Dim risultatoByte As Byte() = Convert.FromBase64String(risultatoStringa)

'Deserializza risultato

Dim Soap As New Runtime.Serialization.Formatters.Binary.BinaryFormatter

risposta.Risultato = Soap.Deserialize(New IO.MemoryStream(risultatoByte))

Return risposta

End Function

End Class

End Class

Di seguito invece le modifiche da applicare al sito web ASPX:

In “web.config” aggiungere la seguente sessione in <system.web> per gestire un nuovo handler con estensioni asmx:

<httpHandlers>

<add type="HandlerBin" verb="*" path="*.asmx" />

</httpHandlers>

A questo punto bisogna creare una nuova classe in App_Code ad esempio creando un nuovo file di nome: “HttpHandler.vb” con il seguente codice in esso:

Imports Microsoft.VisualBasic

Imports System.Web

Public Class HandlerBin

Implements IHttpHandler

Public Sub ProcessRequest(ByVal Context As HttpContext) Implements IHttpHandler.ProcessRequest

Dim a As New Regex("/(?<pagina>[^/]*)\.asmx")

Dim Richiesta As String = ""

Richiesta = a.Match(Context.Request.Path).Groups("pagina").Value 'Contiene la pagina richiesta senza il .bin

If Richiesta = "SqlHttp" Then

Dim SqlHttp As New SqlHttp(Context)

End If

End Sub

Public ReadOnly Property IsReusable() As Boolean Implements IHttpHandler.IsReusable

Get

Return False

End Get

End Property

End Class

Quindi creiamo una nuova classe che si occupa di gestire le chiamate SQLHTTP; creiamo quindi un nuovo file in “App_Code” dal nome “SqlHttp.vb” con il seguente contenuto:

Imports Microsoft.VisualBasic

Public Class SqlHttp

Private _context As HttpContext

Public Sub New(ByVal Context As HttpContext)

_context = Context

ElaboraRichiesta()

End Sub

Class Richiesta

Public NomeDb As String

Public TipoIstruzione As TIR

Public IstruzioneSql As String

Public Enum TIR

Table

Command 'Ritorno Integer (numero righe coinvolte)

Scalar 'Ritorno Object

End Enum

End Class

Class Risposta

Public Risposta As RIS

Public Risultato As Object

Public Enum RIS

Ok

Errore

End Enum

End Class

Private Sub ElaboraRichiesta()

Dim SR As New IO.StreamReader(_context.Request.InputStream)

Dim RichiestaStringa As String = SR.ReadToEnd()

Dim Richiesta As Richiesta = ElaboraXmlRichiesta(RichiestaStringa)

'MsgBox(Richiesta.NomeDb & Richiesta.TipoIstruzione & Richiesta.IstruzioneSql)

Dim risposta As Risposta = Nothing

Select Case Richiesta.TipoIstruzione

Case SqlHttp.Richiesta.TIR.Command

risposta = DbCommand(Richiesta)

Case SqlHttp.Richiesta.TIR.Table

risposta = DbTable(Richiesta)

Case SqlHttp.Richiesta.TIR.Scalar

risposta = DbScalare(Richiesta)

End Select

'Invio Risposta

Dim rispostaStringa As String = GeneraXmlRisposta(risposta)

_context.Response.Write(rispostaStringa)

End Sub

Private Function ElaboraXmlRichiesta(ByVal RichiestaStringa As String) As Richiesta

Dim Xml As New XmlDocument()

Xml.InnerXml = RichiestaStringa

Dim richiesta As New Richiesta()

richiesta.NomeDb = Xml.SelectSingleNode("/Richiesta/NomeDb").InnerText

richiesta.TipoIstruzione = [Enum].Parse(GetType(Richiesta.TIR), Xml.SelectSingleNode("/Richiesta/TipoIstruzione").InnerText)

richiesta.IstruzioneSql = Xml.SelectSingleNode("/Richiesta/IstruzioneSql").InnerText

Return richiesta

End Function

Private Function GeneraXmlRisposta(ByVal risposta As Risposta) As String

Dim Soap As New Runtime.Serialization.Formatters.Binary.BinaryFormatter

Dim StreamRisultato As IO.MemoryStream = New IO.MemoryStream()

Soap.Serialize(StreamRisultato, risposta.Risultato)

'Genera Risposta XML

Dim Xml As New XmlDocument()

Dim NodoPadre As XmlNode = Xml.CreateElement("Risposta")

Xml.AppendChild(NodoPadre)

'Nodo Risposta (Ok-Errore)

Dim NodoRisposta As XmlNode = Xml.CreateElement("Risposta")

NodoRisposta.InnerText = [Enum].GetName(GetType(Risposta.RIS), risposta.Risposta)

NodoPadre.AppendChild(NodoRisposta)

'Nodo Risultato

Dim NodoRisultato As XmlNode = Xml.CreateElement("Risultato")

NodoRisultato.InnerText = Convert.ToBase64String(StreamRisultato.GetBuffer)

NodoPadre.AppendChild(NodoRisultato)

'

Return Xml.InnerXml

End Function

Private Function DbCommand(ByVal richiesta As Richiesta) As Risposta

Dim risposta As New Risposta()

'Controllo esistenza DB

Dim FileDb As String = Generale.PercorsoFile("mdb-database") & "\" & richiesta.NomeDb

If IO.File.Exists(FileDb) = False Then

risposta.Risposta = SqlHttp.Risposta.RIS.Errore

risposta.Risultato = "File Database non trovato"

Return risposta

End If

'Esegue Command

Try

Dim Conn As OdbcConnection

Conn = New OdbcConnection("DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & FileDb)

Conn.Open()

Dim Cmd As New OdbcCommand(richiesta.IstruzioneSql, Conn)

risposta.Risposta = SqlHttp.Risposta.RIS.Ok

risposta.Risultato = Cmd.ExecuteNonQuery()

Conn.Close()

Catch ex As Exception

risposta.Risposta = SqlHttp.Risposta.RIS.Errore

risposta.Risultato = ex.Message

End Try

Return risposta

End Function

Private Function DbTable(ByVal richiesta As Richiesta) As Risposta

Dim risposta As New Risposta()

'Controllo esistenza DB

Dim FileDb As String = Generale.PercorsoFile("mdb-database") & "\" & richiesta.NomeDb

If IO.File.Exists(FileDb) = False Then

risposta.Risposta = SqlHttp.Risposta.RIS.Errore

risposta.Risultato = "File Database non trovato"

Return risposta

End If

'Esegue Command

Try

Dim Conn As OdbcConnection

Conn = New OdbcConnection("DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & FileDb)

Conn.Open()

Dim Adattatore As New OdbcDataAdapter(richiesta.IstruzioneSql, Conn)

Dim Table As New DataTable()

Adattatore.Fill(Table)

risposta.Risposta = SqlHttp.Risposta.RIS.Ok

risposta.Risultato = Table

Conn.Close()

Catch ex As Exception

risposta.Risposta = SqlHttp.Risposta.RIS.Errore

risposta.Risultato = ex.Message

End Try

Return risposta

End Function

Private Function DbScalare(ByVal richiesta As Richiesta) As Risposta

Dim risposta As New Risposta()

'Controllo esistenza DB

Dim FileDb As String = Generale.PercorsoFile("mdb-database") & "\" & richiesta.NomeDb

If IO.File.Exists(FileDb) = False Then

risposta.Risposta = SqlHttp.Risposta.RIS.Errore

risposta.Risultato = "File Database non trovato"

Return risposta

End If

'Esegue Command

Try

Dim Conn As OdbcConnection

Conn = New OdbcConnection("DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & FileDb)

Conn.Open()

Dim Cmd As New OdbcCommand(richiesta.IstruzioneSql, Conn)

risposta.Risposta = SqlHttp.Risposta.RIS.Ok

risposta.Risultato = Cmd.ExecuteScalar()

Conn.Close()

Catch ex As Exception

risposta.Risposta = SqlHttp.Risposta.RIS.Errore

risposta.Risultato = ex.Message

End Try

Return risposta

End Function

End Class

Importante: il database deve essere contenuto nella cartella mdb-database del server web.

A questo punto basta creare un nuovo programma in VB 2008 inserendoci la quasse “SqlHttpConnection” enunciata all'inizio del documento.

Passi:

• Chiamata del costruttore di SqlHttpConnection con i parametri di Sito (Es.: “www.pippo.it”) e NomeDb (Es.: “Database.mdb”) il quale deve essere presente sul server Web.

• Chiamando il metodo EseguiQuery (Sql as String) otterremo come risposta un DataTable o un bel Nothing con Msgbox dell'errore query.

• Chiamando il metodo EseguiCommand otterremo come risposta il numero delle righe coinvolte dal comando oppure un bel Nothing con Msgbox dell'errore del comando Sql.

• Chiamando EseguiScalare otterremo come risposta un Object generalizzato del valore di ritorno dal database.

Fine della guida. Se ti è stata utile aiutami cliccando sui banner affianco.