1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
| #Region " IMPORTS "
Imports System
Imports System.Data
Imports System.Configuration
Imports System.Data.SqlClient
Imports System.Data.OleDb
Imports System.Data.Odbc
Imports System.Data.Sql
Imports Microsoft.VisualBasic.FileIO.SearchOption
Imports System.IO.Path
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Data.SqlDbType
Imports System.Data.SqlTypes
#End Region
Public Class ContenuSQL
Dim strServer As String = Nothing
Dim strBase As String = Nothing
Dim strLogin As String = Nothing
Dim StrPassword As String = Nothing
Dim blserveur As Boolean = False
#Region "Form"
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
BtListTable.Enabled = False
'Autre Manière mais ne retourne pas tout les serveurs
'CboServersSQL.DataSource = Get_Server()
'CboServersSQL.DisplayMember = "ServerName"
'CboServersSQL.ValueMember = "ServerName"
End Sub
Private Sub CboServersSQLEXPRESS2005_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CboServersSQLEXPRESS2005.SelectedIndexChanged
If Not Me.Created Then Exit Sub
strServer = CboServersSQLEXPRESS2005.Text
If strLogin <> "" And StrPassword <> "" Then RempliComboBaseSQL(CboServersSQLEXPRESS2005.Text)
End Sub
Private Sub CboServersSQL_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CboServersSQL.SelectedIndexChanged
If Not Me.Created Then Exit Sub
strServer = CboServersSQL.Text
If strLogin <> "" And StrPassword <> "" Then RempliComboBaseSQL(CboServersSQL.Text)
End Sub
Private Sub CboBases_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CboBases.SelectedIndexChanged
If Not Me.Created Then Exit Sub
strBase = CboBases.Text
End Sub
Private Sub CboTables_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CboTables.SelectedIndexChanged
If CboTables.Text = "System.Data.DataRowView" Then Exit Sub
CboChamps.DataSource = Get_NomColonneWithTable(strServer, strBase, CboTables.Text)
CboChamps.DisplayMember = "COLUMN_NAME"
CboChamps.ValueMember = "COLUMN_NAME"
End Sub
Private Sub TbServer_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TbServer.TextChanged
strServer = TbServer.Text
End Sub
Private Sub TbBase_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TbBase.TextChanged
strBase = TbBase.Text
End Sub
Private Sub TbLogin_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TbLogin.TextChanged
strLogin = TbLogin.Text
End Sub
Private Sub TbPassword_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TbPassword.TextChanged
StrPassword = TbPassword.Text
End Sub
Private Sub BtListServeur_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtListServeur.Click
blserveur = True
btnListerSrv()
BtListTable.Enabled = True
End Sub
Private Sub BtListTable_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtListTable.Click
If Not blserveur Then Exit Sub
CboTables.DataSource = Get_TablesSQL(strServer, strBase)
CboTables.DisplayMember = "TABLE_NAME"
CboTables.ValueMember = "TABLE_NAME"
End Sub
#End Region
#Region " Fonction Divers de Remplissage "
Public Function Get_Server() As DataTable
Dim dt As DataTable = Nothing
Dim factory As Common.DbProviderFactory = Common.DbProviderFactories.GetFactory("System.Data.SqlClient")
If (factory.CanCreateDataSourceEnumerator) Then
Dim dataSourceEnumerator As Common.DbDataSourceEnumerator = factory.CreateDataSourceEnumerator()
If Not IsNothing(dataSourceEnumerator) Then
' Voici la liste de Serveurs de SQL
dt = dataSourceEnumerator.GetDataSources()
End If
End If
' dt = SqlDataSourceEnumerator.Instance.GetDataSources()
Return dt
End Function
Public Function Get_TablesSQL(ByVal SERVEUR As String, ByVal BaseSQL As String) As DataTable
Dim factory As Common.DbProviderFactory = Common.DbProviderFactories.GetFactory("System.Data.SqlClient")
Dim tables As DataTable = Nothing
Dim connection As Common.DbConnection = factory.CreateConnection()
Using connection
connection.ConnectionString = "Data Source=" & SERVEUR & ";Initial Catalog=" & BaseSQL & ";user=" & strLogin & ";pwd=" & StrPassword & ";" & "Integrated Security=True"
Dim restrictions() As String = New String() {Nothing, Nothing, Nothing, Nothing}
' Catalogue
restrictions(0) = BaseSQL
' Propriétaire
restrictions(1) = "dbo"
restrictions(2) = Nothing
' Type de Table - Seulement les tables et pas les vues
restrictions(3) = "BASE TABLE"
connection.Open()
' La liste des tables
tables = connection.GetSchema("Tables", restrictions)
End Using
Return tables
End Function
Public Function Get_BaseSQL(ByVal SERVEUR As String) As DataTable()
Dim factory As Common.DbProviderFactory = Common.DbProviderFactories.GetFactory("System.Data.SqlClient")
Dim tabless(1) As DataTable
Dim connection As Common.DbConnection = factory.CreateConnection()
Dim strReq As String = "SELECT name AS DBName, dbid as DBId, SUSER_SNAME(sid) AS Owner, crdate as CreationDate, cmptlevel AS CompatibilityLevel FROM master.dbo.sysdatabases"
'Liste les Procédures Stocké
Dim sReqStk As String = "SELECT * FROM INFORMATION_SCHEMA.ROUTINES"
Dim adapter As Object = Nothing
Dim commandBuilder As Object
Dim strBase As String = Nothing
connection.ConnectionString = "Server=" & SERVEUR & ";Database=;user=" & strLogin & ";pwd=" & StrPassword & ";"
Try
Using connection
tabless(0) = New DataTable
adapter = New SqlClient.SqlDataAdapter(strReq, connection.ConnectionString)
commandBuilder = New SqlClient.SqlCommandBuilder(adapter)
adapter.Fill(tabless(0))
tabless(1) = New DataTable
adapter = New SqlClient.SqlDataAdapter(sReqStk, connection.ConnectionString)
commandBuilder = New SqlClient.SqlCommandBuilder(adapter)
adapter.Fill(tabless(1))
End Using
For Each base As DataColumn In tabless(1).Columns
Console.WriteLine(base.ColumnName)
Next
'Bug sur l'affichage du contenu des proc stocké
'Console.WriteLine("*********************")
'For Each base As DataRow In tabless(1).Rows
' strBase = String.Empty
' For i As Integer = 0 To tabless(1).Rows.Count - 1
' strBase &= base.Item(i) & " - "
' Next
' Console.WriteLine(strBase)
'Next
Catch ex As SqlClient.SqlException
MessageBox.Show("Erreur lors de la connection au serveur : " & ex.Message, "Impossible", MessageBoxButtons.OK)
Return Nothing
End Try
Return tabless
End Function
Public Function Get_NomColonneWithTable(ByVal SERVEUR As String, ByVal BaseSQL As String, ByVal Table As String) As DataTable
Dim factory As Common.DbProviderFactory = Common.DbProviderFactories.GetFactory("System.Data.SqlClient")
Dim tables As New DataTable
Dim connection As Common.DbConnection = factory.CreateConnection()
Dim strReq As String = "SELECT COLUMN_NAME, ORDINAL_POSITION FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME='" & Table & "'"
Dim adapter As Object = Nothing
Dim commandBuilder As Object
Dim strBase As String = Nothing
connection.ConnectionString = "Server=" & SERVEUR & ";Database=" & BaseSQL & ";user=" & strLogin & ";pwd=" & StrPassword & ";"
Try
Using connection
adapter = New SqlClient.SqlDataAdapter(strReq, connection.ConnectionString)
commandBuilder = New SqlClient.SqlCommandBuilder(adapter)
adapter.Fill(tables)
End Using
Catch ex As Exception
End Try
Return tables
End Function
Public Sub RempliComboBaseSQL(ByVal strServeur As String)
Dim DataTables() As DataTable = Get_BaseSQL(strServeur)
If IsNothing(DataTables) Then Exit Sub
CboBases.DataSource = Nothing
CboBases.DataSource = DataTables(0)
CboBases.DisplayMember = "DBName"
CboBases.ValueMember = "DBName"
cbListeProcStock.DataSource = Nothing
cbListeProcStock.DataSource = DataTables(1)
cbListeProcStock.DisplayMember = "ROUTINE_NAME"
cbListeProcStock.ValueMember = "ROUTINE_NAME"
End Sub
'***************************** Recherche des Serveurs SQL *************************************
#Region " Listing des Serveurs SQL "
#Region " DLL Imports "
Public Enum SQL_RETURN_CODE As Integer
SQL_ERROR = -1
SQL_INVALID_HANDLE = -2
SQL_SUCCESS = 0
SQL_SUCCESS_WITH_INFO = 1
SQL_STILL_EXECUTING = 2
SQL_NEED_DATA = 99
SQL_NO_DATA = 100
End Enum
<DllImport("ODBCCP32.dll", CharSet:=CharSet.Unicode)> _
Shared Function SQLGetInstalledDrivers(ByVal driverList As Char(), ByVal maxBuffer As Integer, ByRef longlist As Integer) As Boolean
End Function
<DllImport("odbccp32", CharSet:=CharSet.Auto)> _
Public Shared Function SQLInstallerError(ByVal iError As Integer, ByRef pfErrorCode As Integer, ByVal lpszErrorMsg As StringBuilder, ByVal cbErrorMsgMax As Integer, ByRef pcbErrorMsg As Integer) As SQL_RETURN_CODE
End Function
<DllImport("odbc32.dll")> _
Private Shared Function SQLAllocHandle(ByVal hType As Short, ByVal inputHandle As IntPtr, <Out()> ByRef outputHandle As IntPtr) As Short
End Function
<DllImport("odbc32.dll", CharSet:=CharSet.Ansi)> _
Private Shared Function SQLBrowseConnect(ByVal hconn As IntPtr, ByVal inString As StringBuilder, ByVal inStringLength As Short, ByVal outString As StringBuilder, ByVal outStringLength As Short, <Out()> ByRef outLengthNeeded As Short) As Short
End Function
<DllImport("odbc32.dll")> _
Private Shared Function SQLFreeHandle(ByVal hType As Short, ByVal handle As IntPtr) As Short
End Function
<DllImport("odbc32.dll")> _
Private Shared Function SQLSetEnvAttr(ByVal henv As IntPtr, ByVal attribute As Integer, ByVal valuePtr As IntPtr, ByVal strLength As Integer) As Short
End Function
#End Region
#Region " Constantes "
Private Const SQL_ATTR_ODBC_VERSION As Integer = 200
Private Const SQL_DRIVER_STR As String = "DRIVER=SQL SERVER"
Private Const SQL_HANDLE_DBC As Short = 2
Private Const SQL_HANDLE_ENV As Short = 1
Private Const SQL_NEED_DATA As Short = 99
Private Const SQL_OV_ODBC3 As Integer = 3
Private Const SQL_SUCCESS As Short = 0
Private Const DEFAULT_RESULT_SIZE As Short = 1024
#End Region
Private Function btnListerSrv() As Boolean
Dim liste_serveur As String() = Nothing
Dim txt As String = String.Empty
Dim henv As IntPtr = IntPtr.Zero
Dim hconn As IntPtr = IntPtr.Zero
Dim inString As StringBuilder
Dim outString As StringBuilder
Dim inStringLength As Short = 0
Dim lenNeeded As Short = 0
'On récupère la liste des serveurs SQL Serveurs
For i As Integer = 1 To 3
liste_serveur = Nothing
txt = String.Empty
henv = IntPtr.Zero
hconn = IntPtr.Zero
outString = New StringBuilder(1024)
inStringLength = 0
lenNeeded = 0
inString = Nothing
If i = 1 Then
inString = New StringBuilder("DRIVER=SQL SERVER")
inStringLength = CType(inString.Length, Short)
ElseIf i = 2 Then
inString = New StringBuilder("DRIVER=SQL Native Client")
inStringLength = CType(inString.Length, Short)
ElseIf i = 3 Then
inString = New StringBuilder("DRIVER=Microsoft Access Driver (*.mdb)")
inStringLength = CType(inString.Length, Short)
End If
Try
If (((SQLAllocHandle(SQL_HANDLE_ENV, henv, henv) = SQL_SUCCESS) AndAlso (SQLSetEnvAttr(henv, SQL_ATTR_ODBC_VERSION, CType(SQL_OV_ODBC3, IntPtr), 0) = SQL_SUCCESS)) AndAlso ((SQLAllocHandle(SQL_HANDLE_DBC, henv, hconn) = SQL_SUCCESS) AndAlso (SQL_NEED_DATA = SQLBrowseConnect(hconn, inString, inStringLength, outString, DEFAULT_RESULT_SIZE, lenNeeded)))) Then
If (DEFAULT_RESULT_SIZE < lenNeeded) Then
outString.Capacity = lenNeeded
If (SQL_NEED_DATA <> SQLBrowseConnect(hconn, inString, inStringLength, outString, lenNeeded, lenNeeded)) Then
Throw New ApplicationException("Unabled to aquire SQL Servers from ODBC driver.")
End If
End If
'On récupère le nom des serveurs SQL (sans les parenthèses)
txt = outString.ToString
Dim start As Integer = (txt.IndexOf("{") + 1)
Dim len As Integer = (txt.IndexOf("}") - start)
If ((start > 0) AndAlso (len > 0)) Then
txt = txt.Substring(start, len)
Else
txt = String.Empty
End If
End If
Catch except As Exception
MessageBox.Show(except.Message)
txt = String.Empty
Finally
If (hconn <> IntPtr.Zero) Then
SQLFreeHandle(SQL_HANDLE_DBC, hconn)
End If
If (henv <> IntPtr.Zero) Then
SQLFreeHandle(SQL_HANDLE_ENV, hconn)
End If
End Try
'On stocke, dans un tableau la liste des noms de serveurs
If (txt.Length > 0) Then
liste_serveur = txt.Split(",".ToCharArray)
End If
'Stocke resultat dans les Combos
If i = 1 Then
' Pour chaque élément du tableau
CboServersSQL.Items.Clear()
For Each serveurSQL As String In liste_serveur
' On l'affiche dans le Combo
CboServersSQL.Items.Add(serveurSQL)
Next
ElseIf i = 2 Then
CboServersSQLEXPRESS2005.Items.Clear()
For Each serveurNative As String In liste_serveur
' On l'affiche dans le Combo
CboServersSQLEXPRESS2005.Items.Add(serveurNative)
Next
End If
Next
Return True
End Function
#End Region
'***************************** Fin Recherche des Serveurs SQL *********************************
#End Region
End Class |
