0/5 (4 avis)
Vue 9 291 fois - Téléchargée 1 046 fois
Imports system.Data Imports System.Data.SqlClient Imports System.Data.OleDb ' Classe d'accès au base de données SQL et OLEDB. ' Olivier Blondel 04/2006 Public Class DbAccess Enum SqlSecurityType Windows UserPassWord End Enum Enum DataBaseType OleDb SQLServer End Enum #Region "défintion des variables" 'Variables générales à la classe Private DbTypeValue As DataBaseType = DataBaseType.OleDb, ConnectedValue As Boolean = False Private U_ID As String = "ID", IdSeeked As Long = 0, WantedValue As String, ReturnValue Private LookFor() As String, NbConstraint As Long = 0, SqlSecType As SqlSecurityType = SqlSecurityType.Windows Private DbRecordset() As OleDb.OleDbDataReader 'variable pour le type de DB Access Private DbPathValue As String, C_DbOleCnn As ADODB.Connection 'System.Data.OleDb.OleDbConnection 'variable pour le type de DB SQL Private DbServerValue As String, DbNameValue As String, DbUserValue As String, DbUserPassWordValue As String Private C_DbSQlCnn As SqlClient.SqlConnection #End Region #Region "Propiété de la classe" 'propriété générales Public Property DbType() As DataBaseType 'Sélectioon du type de base de donnée Get Return DbTypeValue End Get Set(ByVal value As DataBaseType) DbTypeValue = UCase(value) End Set End Property ReadOnly Property Connected() As Boolean 'Statut de la base Get Return ConnectedValue End Get End Property Public Property Unique_Identifier() 'Nom du champ identifiant unique (LONG) Get Return U_ID End Get Set(ByVal value) U_ID = value End Set End Property ReadOnly Property Seeked() 'Retour de l'identifant U_ID trouve par la recherche Get Return IdSeeked End Get End Property Public Property AltValueSeeked() 'Valeur optionnele recherchée Get Return WantedValue End Get Set(ByVal value) WantedValue = value End Set End Property ReadOnly Property SeekedAlt() 'Retour de la valeur optionnelle trouvée Get Return ReturnValue End Get End Property 'propriété access Public Property DbPath() As String 'Chemin de la base Get Return DbPathValue End Get Set(ByVal value As String) DbPathValue = value End Set End Property 'propriété SQL Public Property SqlServerName() 'Nom du serveur SQL Get Return DbServerValue End Get Set(ByVal value) DbServerValue = value End Set End Property Public Property SqlServerDataBase() 'BDD SQL Get Return DbNameValue End Get Set(ByVal value) DbNameValue = value End Set End Property Public Property SQLUser() 'Utilisateur SQl Get Return DbUserValue End Get Set(ByVal value) DbUserValue = value End Set End Property Public Property SQlPassword() 'Password SQl Get Return DbUserPassWordValue End Get Set(ByVal value) DbUserPassWordValue = value End Set End Property Public Property SQLSecurity() As SqlSecurityType 'Type d'authentification SQL Get Return SqlSecType End Get Set(ByVal value As SqlSecurityType) SqlSecType = value End Set End Property #End Region #Region "Subs de la classe" #Region "Connexion/Deconnexion" Public Sub DisconnectDb() 'Déconnexion de la base Select Case DbTypeValue Case DataBaseType.OleDb 'Access C_DbOleCnn.Close() Case DataBaseType.SQLServer 'SQL C_DbSQlCnn.Close() C_DbSQlCnn.Dispose() End Select ConnectedValue = False End Sub Public Sub Connect_Db() 'Procédure de connexion générale If ConnectedValue Then Exit Sub Select Case DbTypeValue Case DataBaseType.SQLServer SQLConnect() Case DataBaseType.OleDb If DbPathValue = "" Then MsgBox("Source de donnée non identifiée !", MsgBoxStyle.Critical) ConnectedValue = False Exit Sub End If OleDbConnect() End Select End Sub Private Sub OleDbConnect() 'Procédure de connexion OleDB (Access) Try C_DbOleCnn = New ADODB.Connection C_DbOleCnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & DbPathValue & ";" & "Persist Security Info=False" C_DbOleCnn.Open() ConnectedValue = True Catch ex As OleDb.OleDbException MsgBox(ex.Message) ConnectedValue = False End Try End Sub Private Sub SQLConnect() 'Procédure de connexion SQL Server Dim TestVar As String Try TestVar = "workstation id=" & (My.Computer.Name) & ";packet size=4096" If SqlSecType = SqlSecurityType.UserPassWord Then TestVar &= ";User ID=" & DbUserValue & ";Password=;" & DbUserPassWordValue & "" Else TestVar &= ";integrated security=SSPI" End If TestVar &= ";data source=" & DbServerValue TestVar &= ";Initial Catalog=" & DbNameValue C_DbSQlCnn = New SqlClient.SqlConnection(TestVar) C_DbSQlCnn.Open() ConnectedValue = True Catch ex As Exception MessageBox.Show(ex.Message) ConnectedValue = False End Try End Sub #End Region #Region "Recherche" Public Sub AddConstraint(ByVal ConstraintStr As String) ReDim Preserve LookFor(NbConstraint) LookFor(NbConstraint) = ConstraintStr NbConstraint = NbConstraint + 1 End Sub Public Sub RazConstraint() IdSeeked = 0 NbConstraint = 0 ReDim LookFor(0) End Sub Public Sub SeekIt(ByVal Table As String) Select Case DbTypeValue Case DataBaseType.OleDb OledbSeekIt(Table) Case DataBaseType.SQLServer SQlSeekIt(Table) End Select End Sub Private Function PrepareQuery(ByVal TblTo As String) As String Dim NQ As Long, MyString As String, TmpStr MyString = "Select " & U_ID '& " From " & TblTo & " Where " If WantedValue <> "" Then MyString &= "," & WantedValue End If MyString = MyString & " From " & TblTo & " Where " For NQ = 0 To NbConstraint - 1 TmpStr = Split(LookFor(NQ), "|") MyString = MyString & TmpStr(1) Select Case UCase(TmpStr(0)) Case "S" MyString = MyString & "='" & TmpStr(2) & "' AND " Case "N" MyString = MyString & "=" & TmpStr(2) & " AND " Case "D" If DbTypeValue = "OLEDB" Then MyString = MyString & "=#" & TmpStr(2) & "# AND " Else MyString = MyString & "='" & TmpStr(2) & "' AND" End If End Select Next NQ MyString = Mid(MyString, 1, Len(MyString) - 5) Return MyString End Function Private Sub OledbSeekIt(ByVal TableToSeek As String) Dim SeekSql As String, SeekRst As ADODB.Recordset SeekSql = PrepareQuery(TableToSeek) Try SeekRst = New ADODB.Recordset SeekRst.ActiveConnection = C_DbOleCnn SeekRst.Open(SeekSql, C_DbOleCnn) If SeekRst.EOF Then IdSeeked = 0 ReturnValue = 0 Else IdSeeked = SeekRst.Fields(U_ID).Value If WantedValue <> "" Then ReturnValue = SeekRst.Fields(WantedValue).Value End If End If SeekRst.Close() SeekRst = Nothing Catch ex As Exception MessageBox.Show(ex.Message) IdSeeked = 0 ReturnValue = "" End Try End Sub Private Sub SQlSeekIt(ByVal TableToseek As String) Dim SQlRdr As SqlClient.SqlDataReader, SQlCmd As SqlClient.SqlCommand, SeekSql As String SeekSql = PrepareQuery(TableToseek) Try SQlCmd = New SqlCommand(SeekSql, C_DbSQlCnn) SQlRdr = SQlCmd.ExecuteReader SQlRdr.Read() If SQlRdr.IsDBNull(0) Then IdSeeked = 0 ReturnValue = 0 Else IdSeeked = SQlRdr(U_ID).ToString If WantedValue <> "" Then ReturnValue = SQlRdr(WantedValue).ToString End If End If SQlRdr.Close() Catch ex As Exception MessageBox.Show(ex.Message) IdSeeked = 0 ReturnValue = "" End Try End Sub #End Region #End Region #Region "Sous-classes" #Region "Recordset" Public Class Recordset 'Variables Private FieldName() As String, NbField As Long, TableName As String Private RstOleCnn As ADODB.Connection, RstSqlCnn As SqlClient.SqlConnection Private RdrSQl As SqlClient.SqlDataReader, CmdSQl As SqlClient.SqlCommand Dim RstOleDb As ADODB.Recordset, EofState As Boolean = True Private CnnDbType As DataBaseType, RecordOpen As Boolean = False, RstQuery As String #Region "subs génériques" 'Constructeur Sub New(ByVal Query As String, ByRef RefDb As DbAccess) CnnDbType = RefDb.DbTypeValue RstQuery = Query Select Case CnnDbType Case DataBaseType.OleDb RstOleCnn = RefDb.C_DbOleCnn Case DataBaseType.SQLServer RstSqlCnn = RefDb.C_DbSQlCnn End Select 'IdentTable() End Sub Sub New(ByRef refdb As DbAccess) CnnDbType = refdb.DbTypeValue End Sub 'Subs propre au recordset Public Sub Open() If RecordOpen Then End If Select Case CnnDbType Case DataBaseType.OleDb OpenOlDb_New() Case DataBaseType.SQLServer OpenSQl() End Select End Sub Public Sub Open(ByVal ToQuery As String) RstQuery = ToQuery Select Case CnnDbType Case DataBaseType.OleDb OpenOlDb_New() Case DataBaseType.SQLServer OpenSQl() End Select End Sub Public Sub Close() Select Case CnnDbType Case DataBaseType.OleDb OleDbClose() Case DataBaseType.SQLServer 'RdrSQl.Close() RdrSQl.Close() RdrSQl = Nothing CmdSQl = Nothing End Select End Sub Public Sub ToDataSet(ByVal QueryDS As String, ByRef DataTo As DataSet) DataTo.Clear() Select Case CnnDbType Case DataBaseType.OleDb ToDataSetOleDb(QueryDS, DataTo) Case DataBaseType.SQLServer ToDataSetSQL(QueryDS, DataTo) End Select End Sub Private Sub FieldColumns(ByVal db_table_name As String) Dim Z As Long Dim MyRows As DataRow, Str As String Dim dt As DataTable dt = RstOleCnn.GetOleDbSchemaTable(OleDbSchemaGuid.Columns, New Object() {Nothing, Nothing, TableName}) NbField = dt.Rows.Count ReDim FieldName(NbField) For Each MyRows In dt.Rows Z = (MyRows.Item(6)) Str = MyRows.Item(3) FieldName(Z) = MyRows.Item(3) Next dt = Nothing End Sub Private Sub IdentTable() Dim TmpTableStr As String TmpTableStr = RstQuery If InStr(UCase(RstQuery), "FROM") <> 0 Then TmpTableStr = Mid(TmpTableStr, InStr(UCase(RstQuery), "FROM") + 5) If InStr(UCase(TmpTableStr), "WHERE") <> 0 Then TmpTableStr = Mid(TmpTableStr, 1, InStr(UCase(TmpTableStr), "WHERE") - 2) TableName = TmpTableStr 'FieldColumns(TableName) ElseIf InStr(UCase(TmpTableStr), "ORDER") <> 0 Then TableName = Mid(TmpTableStr, 1, InStr(UCase(TmpTableStr), "ORDER") - 2) 'FieldColumns(TableName) Else TableName = TmpTableStr End If 'FieldColumns(TableName) Else MsgBox("Table non identifiée !", MsgBoxStyle.Critical) Exit Sub End If End Sub Sub Movenext() If Not RecordOpen Or EofState Then Exit Sub Select Case CnnDbType Case DataBaseType.OleDb RstOleDb.MoveNext() EofState = RstOleDb.EOF Case DataBaseType.SQLServer RdrSQl.Read() Try EofState = RdrSQl.IsDBNull(0) Catch ex As Exception EofState = True End Try End Select End Sub #End Region #Region "propriété" Property RecordSource() As String Get Return RstQuery End Get Set(ByVal value As String) RstQuery = value End Set End Property ReadOnly Property Eof() Get Return EofState End Get End Property #End Region #Region "Functions génériques" Private Function ColumnId(ByVal FieldStr As String) As Long Dim z As Long For z = 0 To NbField If UCase(FieldName(z)) = UCase(FieldStr) Then Return (z - 1) : Exit Function Next Return 0 End Function Function Valeur(ByVal Champ As String) Select Case CnnDbType Case DataBaseType.OleDb Return OleDbValue_New(Champ) Case DataBaseType.SQLServer Return SqlValue(Champ) Case Else Return Nothing End Select End Function #End Region #Region "OleDb Sub/Function" Private Sub OpenOlDb_New() If Left(UCase(RstQuery), 6) = "SELECT" Then Try RstOleDb = New ADODB.Recordset() RstOleDb.ActiveConnection = RstOleCnn RstOleDb.Open(RstQuery, RstOleCnn) RecordOpen = True EofState = RstOleDb.EOF Catch ex As Exception MessageBox.Show(ex.Message) End Try Else Try RstOleDb = New ADODB.Recordset() RstOleDb.ActiveConnection = RstOleCnn RstOleDb.Open(RstQuery, RstOleCnn) EofState = True RecordOpen = False Catch ex As Exception MessageBox.Show(ex.Message) End Try End If End Sub Private Function OleDbValue_New(ByVal FieldWanted As String) Try Return (RstOleDb.Fields(FieldWanted).Value) Catch ex As Exception MsgBox(ex.Message) Return Nothing End Try End Function Private Sub ToDataSetOleDb(ByVal DataQuery As String, ByVal DataDest As DataSet) DataDest.Clear() End Sub Private Sub OleDbClose() RstOleDb.Close() End Sub #End Region #Region "SQL Sub/Function" Private Sub OpenSQl() 'Execution de la requète SQL If Left(UCase(RstQuery), 6) = "SELECT" Then Try CmdSQl = New SqlCommand(RstQuery, RstSqlCnn) RdrSQl = CmdSQl.ExecuteReader RdrSQl.Read() EofState = RdrSQl.IsDBNull(0) RecordOpen = True Catch ex As Exception RecordOpen = True EofState = True End Try Else Try CmdSQl = New SqlCommand(RstQuery, RstSqlCnn) CmdSQl.ExecuteNonQuery() RecordOpen = False CmdSQl.Dispose() Catch ex As Exception MessageBox.Show(ex.Message) EofState = True RecordOpen = False End Try End If End Sub Private Sub ToDataSetSQL(ByVal DataQuery As String, ByVal DataDest As DataSet) End Sub Private Function SqlValue(ByVal Champ As String) 'Récupration de la valeur du CHamp Try Return RdrSQl(Champ).ToString Catch ex As Exception MessageBox.Show(ex.Message) Return Nothing End Try End Function #End Region End Class #End Region #End Region End Class
24 avril 2006 à 12:07
je vais voir.
24 avril 2006 à 08:57
http://ditch.developpez.com/dotnet/factories/
24 avril 2006 à 08:19
mais cette librairie, laquelle est-ce ?
24 avril 2006 à 08:17
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.