Visual Basic Forum

elek´tronik · Tutorial Leser Anmeldedatum: 25.07.2008 Beiträge: 56

Ich hab hier ein Modul mit der man zu einem MSSQL Server verbinden kann und Querys verschicken kann:

Visual Basic: [code]
'========================================================================
'=== MSSQL-Modul by elek´tro:nik (2008)
'=== ----------------------------------
'=== [+] ConnectMSSQL(Host/IP, Username und Passwort)
'=== Verbindet mit dem angegeben MSSQL-Server.
'=== War die Verbindung erfolgreich wird True zurück gegeben,
'=== andernfall wird False zurück gegeben.
'===
'=== [+] DisconnectMSSQL()
'=== Trennt die aktuelle Verbindung.
'===
'=== [+] SendSQL(T-SQL Query)
'=== Sendet einen T-SQL Query an den Verbundenen Server.
'========================================================================
Option Explicit

Public Conn As ADODB.Connection
Public Recordset As New ADODB.Recordset

Public Function ConnectMSSQL(ByVal Host, _
User, _
Passwort) As Boolean

Set Conn = New ADODB.Connection
With Conn
' Datenbanktreiber
.Provider = "SQLOLEDB.1"
' Servername
.Properties("Data Source") = Trim(Host)
' User-ID
.Properties("User ID") = Trim(User)
' Userpasswort
.Properties("Password") = Trim(Passwort)
'Timeout
.ConnectionTimeout = 10
On Error GoTo ConnectErr
.Open
End With

GoTo Verbunden

ConnectErr:
ConnectMSSQL = False
Exit Function

Verbunden:
ConnectMSSQL = True
End Function

Public Function DisconnectMSSQL()
Conn.Close
End Function

Public Function SendSQL(ByVal iQuery)
On Error GoTo Err
Dim Error As ADODB.Error
Dim sSQL As String

sSQL = iQuery
Set Recordset = Query(sSQL, Conn)

While Not Recordset.EOF
SendSQL = SendSQL & Recordset.Fields(0).Value & vbCrLf
Recordset.MoveNext
Wend
Err:
If Conn.ErroPointer.Count > 0 Then
For Each Error In Conn.ErroPointer
SendSQL = Error.Description
Next
End If
End Function

'======================================
'=== Hilfsfunktionen
'======================================

Private Function Query(sSQL As String, _
ActiveConn As ADODB.Connection) _
As ADODB.Recordset

Dim AdoError As ADODB.Error
Dim Pointer As ADODB.Recordset

Set Pointer = New ADODB.Recordset

Pointer.CuPointerorLocation = adUseClient
Pointer.CuPointerorType = adOpenDynamic
Pointer.LockType = adLockOptimistic

Pointer.Source = sSQL
Set Pointer.ActiveConnection = ActiveConn
Pointer.Open
Set Query = Pointer
Set Pointer = Nothing
End Function

[/code]
_________________