Solved

Connecting to MS SQL database server?

Posted on 2000-04-16
2
282 Views
Last Modified: 2013-11-23
Hi,
my friend has MS SQL 7.0 evaluvation version running on his PC and we are connected by a LAN. How do I connect to the server running on his machine using VB?
0
Comment
Question by:joeDream
  • 2
2 Comments
 
LVL 2

Expert Comment

by:DanAvni
Comment Utility
give me your email. i will send you a class that does everything you need from SQL server.
0
 
LVL 2

Accepted Solution

by:
DanAvni earned 100 total points
Comment Utility
Use this class.
in the initialize enter the name of the sql server
you may also need to change the connection string to hold the database name,username,passwort you are connecting to.

Option Explicit

Dim m_DBServer As String
Dim m_ConnectionString As String

Private Sub Class_Initialize() 'used instead of the construct evemnt for now!
   m_DBServer = "MISGAV01"
End Sub

Function GetConnectionString() As String
    If m_ConnectionString <> "" Then
        GetConnectionString = m_ConnectionString
    Else
        'assume that we want to use a SQL Server connection through OLDEB
        If m_DBServer <> "" Then
            GetConnectionString = "Provider=SQLOLEDB.1;Password=OfficeCoreSQLServerLoginPassword;Persist Security Info=True;User ID=OfficeCoreSQLServerLoginID;Initial Catalog=OfficeCore;Data Source=" & m_DBServer & ";Locale Identifier=1037;Connect Timeout=15;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096"
        Else
            GetConnectionString = "Provider=SQLOLEDB.1;Password=OfficeCoreSQLServerLoginPassword;Persist Security Info=True;User ID=OfficeCoreSQLServerLoginID;Initial Catalog=OfficeCore;Data Source=localhost;Locale Identifier=1037;Connect Timeout=15;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096"
        End If
    End If
End Function

Function RunSPReturnRS(ByVal strSP As String, ParamArray params() As Variant) As ADODB.Recordset
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim rs As ADODB.Recordset, cmd As ADODB.Command
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command
   
    ' Init the ADO objects  & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdStoredProc
   
    collectParams cmd, params
   
    ' Execute the query for readonly
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
   
    ' Disconnect the recordset
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
    Set rs.ActiveConnection = Nothing

    ' Return the resultant recordset
    Set RunSPReturnRS = rs
    Exit Function
   
errorHandler:
    Set rs = Nothing
    Set cmd = Nothing
    'RaiseError m_modName, "RunSPReturnRS(" & strSP & ", ...)"
End Function

' RunSQLReturnRS differs from RunSPReturnRS only on the line that
' sets the cmd.CommandType = adCmdText vs. adCmdStoredProc

Function RunSQLReturnRS(ByVal strSP As String, ParamArray params() As Variant) As ADODB.Recordset
    On Error GoTo errorHandler
   
    ' Set up Command and Connection objects
    Dim rs As ADODB.Recordset, cmd As ADODB.Command
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command

    'Run the procedure
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdText
   
    collectParams cmd, params
   
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
   
    ' Disconnect the recordsets and cleanup
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
    Set rs.ActiveConnection = Nothing
   
    Set RunSQLReturnRS = rs
    Exit Function
   
errorHandler:
    Set rs = Nothing
    Set cmd = Nothing
    'RaiseError m_modName, "RunSQLReturnRS(" & strSP & ", ...)"
End Function

Function RunSPReturnRS_RW(ByVal strSP As String, ParamArray params() As Variant) As ADODB.Recordset
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim rs As ADODB.Recordset, cmd As ADODB.Command
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command
   
    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdStoredProc
    collectParams cmd, params
    rs.CursorLocation = adUseClient
   
    ' Execute the query as an updatable recordset and stay connected
    rs.Open cmd, , adOpenDynamic, adLockBatchOptimistic
    Set cmd = Nothing
   
    ' Return and quit
    Set RunSPReturnRS_RW = rs
    Exit Function
   
errorHandler:
    Set rs = Nothing
    Set cmd = Nothing
    'RaiseError m_modName, "RunSPReturnRS_RW(" & strSP & ", ...)"
End Function

Function RunSQLReturnRS_RW(ByVal strSP As String, ParamArray params() As Variant) As ADODB.Recordset
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim rs As ADODB.Recordset, cmd As ADODB.Command
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command
       
    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdText
    collectParams cmd, params
    rs.CursorLocation = adUseClient
   
    ' Execute the query as an updatable recordset and stay connected
    rs.Open cmd, , adOpenDynamic, adLockBatchOptimistic
    Set cmd = Nothing
   
    ' Return and quit
    Set RunSQLReturnRS_RW = rs
    Exit Function
   
errorHandler:
    Set rs = Nothing
    Set cmd = Nothing
    'RaiseError m_modName, "RunSQLReturnRS_RW(" & strSP & ", ...)"
End Function

Function RunSP(ByVal strSP As String, ParamArray params() As Variant)
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command
   
    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdStoredProc
    collectParams cmd, params
   
    ' Execute the query without returning a recordset
    cmd.Execute , , adExecuteNoRecords
   
    ' Disconnect the recordset and clean up
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
   
    Exit Function
   
errorHandler:
    Set cmd = Nothing
    'RaiseError m_modName, "RunSP(" & strSP & ", ...)"
End Function

Function RunSQL(ByVal strSP As String, ParamArray params() As Variant)
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command

    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdText
    collectParams cmd, params
   
    ' Execute the query without returning a recordset
    cmd.Execute , , adExecuteNoRecords
   
    ' Cleanup
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
   
    Exit Function
   
errorHandler:
    Set cmd = Nothing
    'RaiseError m_modName, "RunSQL(" & strSP & ", ...)"
End Function

Function RunSPReturnInteger(ByVal strSP As String, ParamArray params() As Variant) As Long 'adInterger is really a VB Long
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command
   
    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdStoredProc
    collectParams cmd, params
   
    ' Assume the last parameter is outgoing
    cmd.Parameters.Append cmd.CreateParameter("@retval", adInteger, adParamOutput, 4)
   
    ' Execute without a resulting recordset and pull out the "return value" parameter
    cmd.Execute , , adExecuteNoRecords
    RunSPReturnInteger = cmd.Parameters("@retval").Value
   
    ' Disconnect the recordset, and clean up
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
   
    Exit Function
   
errorHandler:
    Set cmd = Nothing
    'RaiseError m_modName, "RunSPReturnInteger(" & strSP & ", ...)"
End Function

Private Sub collectParams(ByRef cmd As ADODB.Command, ParamArray argparams() As Variant)
    Dim params As Variant, v As Variant
    Dim I As Integer, l As Integer, u As Integer
   
    params = argparams(0)
    For I = LBound(params) To UBound(params)
        l = LBound(params(I))
        u = UBound(params(I))
        ' Check for nulls.
        If u - l = 3 Then
            If VarType(params(I)(3)) = vbString Then
                v = IIf(params(I)(3) = "", Null, params(I)(3))
            Else
                v = params(I)(3)
            End If
            cmd.Parameters.Append cmd.CreateParameter(params(I)(0), params(I)(1), adParamInput, params(I)(2), v)
        Else
            'CtxRaiseError m_modName, "collectParams(...): incorrect # of parameters"
        End If
    Next I
End Sub

0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now