Option Strict Off
Option Explicit On
Imports System.Linq
Imports System.Collections.Generic
Namespace FMStocks_DB
   Public Class DBHelper
   Private Const m_modName As String = "FMStocks_DB.DBHelper"
   Dim m_DBServer As String = ""
   Dim m_ConnectionString As String = ""
   Private Sub IObjectConstruct_Construct(ByVal pCtorObj As Object)
      'eval construction string and find out what the admin wants us to do
      Dim arrParams As String() = Array.Empty(Of String)()
      Dim x As Integer = 0
      Dim strHints As String = ""

      Try
         gmRTL.Core.GlobalException.ClearErrorObject()
         strHints = Convert.ToString(Interaction.CallByName(pCtorObj,"ConstructString",CallType.Get,Nothing))
         arrParams = Strings.Split(strHints,",",-1,CompareMethod.Binary)
         For x = LBound(arrParams,1) To UBound(arrParams,1) Step 1
            Select Case Strings.UCase(Helpers.GetKey(arrParams(x)))
               Case "CONNECTIONSTRING"
                  m_ConnectionString = Helpers.GetValue(arrParams(x))
               Case "SERVER"
                  m_DBServer = Helpers.GetValue(arrParams(x))
            End Select
         Next

         Exit Sub

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         Helpers.RaiseError(m_modName & "(IObjectConstruct Interface)","Construct(" & strHints & ")",,,True)
      End Try
   End Sub
   Function GetConnectionString() As String
      GetConnectionString = ""
      Try
         gmRTL.Core.GlobalException.ClearErrorObject()

         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 = "MultipleActiveResultSets=True;Data Source=" & m_DBServer & ";User Id=stocks_login;Password=password;Connect Timeout=3;network library=dbmssocn;"
            Else
               'GetConnectionString = "MultipleActiveResultSets=True;Data Source=localhost;User Id=stocks_login;Password=password;Connect Timeout=3;network library=dbmssocn;"
               GetConnectionString = "MultipleActiveResultSets=True;Data Source=(local);User Id=stocks_login;Password=password;Connect Timeout=3;network library=dbmssocn;"
            End If
         End If

         Exit Function

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         Helpers.RaiseError(m_modName,"GetConnectionString()",,,True)
      End Try
   End Function
   Function RunSPReturnRS(ByVal strSP As String,Optional ByVal params As Object = Nothing,Optional ByVal strConn As String = "") As gmRTL.DataLib.SqlClient.Recordset
      RunSPReturnRS = Nothing
      ' Create the ADO objects
      Dim rs As gmRTL.DataLib.SqlClient.Recordset = Nothing
      Dim cmd As System.Data.SqlClient.SqlCommand = Nothing
      Try
         gmRTL.Core.GlobalException.ClearErrorObject()

         rs = New gmRTL.DataLib.SqlClient.Recordset
         cmd = New System.Data.SqlClient.SqlCommand

         ' Init the ADO objects  & the stored proc parameters
         If (strConn = "") Then
            cmd.Connection = new System.Data.SqlClient.SqlConnection(GetConnectionString())
         Else
            cmd.Connection = new System.Data.SqlClient.SqlConnection(strConn)
         End If
         cmd.CommandText = strSP
         cmd.CommandType = System.Data.CommandType.StoredProcedure

         collectParams(cmd,params)

         ' Execute the query for readonly
         rs.CursorLocation = gmRTL.DataLib.CursorLocationEnum.adUseClient
         rs.Open(cmd, Nothing, gmRTL.DataLib.CursorTypeEnum.adOpenStatic, gmRTL.DataLib.LockTypeEnum.adLockReadOnly)

         ' Disconnect the recordset
         cmd.Connection = Nothing
         cmd = Nothing
         rs.ActiveConnection = Nothing

         ' Return the resultant recordset
         RunSPReturnRS = rs
         Exit Function

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         rs = Nothing
         cmd = Nothing
         Helpers.RaiseError(m_modName,"RunSPReturnRS(" & strSP & ", ...)")
      End Try
   End Function
   ' RunSQLReturnRS differs from RunSPReturnRS only on the line that
   ' sets the cmd.CommandType = adCmdText vs. adCmdStoredProc
   Function RunSQLReturnRS(ByVal strSQL As String,ByVal params As Object,Optional ByVal strConn As String = "") As gmRTL.DataLib.SqlClient.Recordset
      RunSQLReturnRS = Nothing
      ' Set up Command and Connection objects
      Dim rs As gmRTL.DataLib.SqlClient.Recordset = Nothing
      Dim cmd As System.Data.SqlClient.SqlCommand = Nothing
      Try
         gmRTL.Core.GlobalException.ClearErrorObject()

         rs = New gmRTL.DataLib.SqlClient.Recordset
         cmd = New System.Data.SqlClient.SqlCommand

         'Run the procedure
         If (strConn = "") Then
            cmd.Connection = new System.Data.SqlClient.SqlConnection(GetConnectionString())
         Else
            cmd.Connection = new System.Data.SqlClient.SqlConnection(strConn)
         End If
         cmd.CommandText = strSQL
         cmd.CommandType = System.Data.CommandType.Text

         collectParams(cmd,params)

         rs.CursorLocation = gmRTL.DataLib.CursorLocationEnum.adUseClient
         rs.Open(cmd, Nothing, gmRTL.DataLib.CursorTypeEnum.adOpenStatic, gmRTL.DataLib.LockTypeEnum.adLockReadOnly)

         ' Disconnect the recordsets and cleanup
         cmd.Connection = Nothing
         cmd = Nothing
         rs.ActiveConnection = Nothing

         RunSQLReturnRS = rs
         Exit Function

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         rs = Nothing
         cmd = Nothing
         Helpers.RaiseError(m_modName,"RunSQLReturnRS(" & Strings.Left(strSQL,10) & ", ...)")
      End Try
   End Function
   Function RunSPReturnRS_RW(ByVal strSP As String,ByVal params As Object,Optional ByVal strConn As String = "") As gmRTL.DataLib.SqlClient.Recordset
      RunSPReturnRS_RW = Nothing
      ' Create the ADO objects
      Dim rs As gmRTL.DataLib.SqlClient.Recordset = Nothing
      Dim cmd As System.Data.SqlClient.SqlCommand = Nothing
      Try
         gmRTL.Core.GlobalException.ClearErrorObject()

         rs = New gmRTL.DataLib.SqlClient.Recordset
         cmd = New System.Data.SqlClient.SqlCommand

         ' Init the ADO objects & the stored proc parameters
         If (strConn = "") Then
            cmd.Connection = new System.Data.SqlClient.SqlConnection(GetConnectionString())
         Else
            cmd.Connection = new System.Data.SqlClient.SqlConnection(strConn)
         End If
         cmd.CommandText = strSP
         cmd.CommandType = System.Data.CommandType.StoredProcedure
         collectParams(cmd,params)
         rs.CursorLocation = gmRTL.DataLib.CursorLocationEnum.adUseClient

         ' Execute the query as an updatable recordset and stay connected
         rs.Open(cmd, Nothing, gmRTL.DataLib.CursorTypeEnum.adOpenDynamic, gmRTL.DataLib.LockTypeEnum.adLockBatchOptimistic)
         cmd = Nothing

         ' Return and quit
         RunSPReturnRS_RW = rs
         Exit Function

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         rs = Nothing
         cmd = Nothing
         Helpers.RaiseError(m_modName,"RunSPReturnRS_RW(" & strSP & ", ...)")
      End Try
   End Function
   Function RunSQLReturnRS_RW(ByVal strSQL As String,ByVal params As Object,Optional ByVal strConn As String = "") As gmRTL.DataLib.SqlClient.Recordset
      RunSQLReturnRS_RW = Nothing
      ' Create the ADO objects
      Dim rs As gmRTL.DataLib.SqlClient.Recordset = Nothing
      Dim cmd As System.Data.SqlClient.SqlCommand = Nothing
      Try
         gmRTL.Core.GlobalException.ClearErrorObject()

         rs = New gmRTL.DataLib.SqlClient.Recordset
         cmd = New System.Data.SqlClient.SqlCommand

         ' Init the ADO objects & the stored proc parameters
         If (strConn = "") Then
            cmd.Connection = new System.Data.SqlClient.SqlConnection(GetConnectionString())
         Else
            cmd.Connection = new System.Data.SqlClient.SqlConnection(strConn)
         End If
         cmd.CommandText = strSQL
         cmd.CommandType = System.Data.CommandType.Text
         collectParams(cmd,params)
         rs.CursorLocation = gmRTL.DataLib.CursorLocationEnum.adUseClient

         ' Execute the query as an updatable recordset and stay connected
         rs.Open(cmd, Nothing, gmRTL.DataLib.CursorTypeEnum.adOpenDynamic, gmRTL.DataLib.LockTypeEnum.adLockBatchOptimistic)
         cmd = Nothing

         ' Return and quit
         RunSQLReturnRS_RW = rs
         Exit Function

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         rs = Nothing
         cmd = Nothing
         Helpers.RaiseError(m_modName,"RunSQLReturnRS_RW(" & strSQL & ", ...)")
      End Try
   End Function
   Function RunSP(ByVal strSP As String,ByVal params As Object,Optional ByVal strConn As String = "") As Object
      RunSP = Nothing
      ' Create the ADO objects
      Dim cmd As System.Data.SqlClient.SqlCommand = Nothing
      Try
         gmRTL.Core.GlobalException.ClearErrorObject()

         cmd = New System.Data.SqlClient.SqlCommand

         ' Init the ADO objects & the stored proc parameters
         If (strConn = "") Then
            cmd.Connection = new System.Data.SqlClient.SqlConnection(GetConnectionString())
         Else
            cmd.Connection = new System.Data.SqlClient.SqlConnection(strConn)
         End If
         cmd.CommandText = strSP
         cmd.CommandType = System.Data.CommandType.StoredProcedure
         collectParams(cmd,params)

         ' Execute the query without returning a recordset
         cmd.Connection.Open()
         cmd.ExecuteNonQuery()
         cmd.Connection.Close()

         ' Disconnect the command and clean up
         cmd.Connection = Nothing
         cmd = Nothing

         Exit Function

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         cmd = Nothing
         Helpers.RaiseError(m_modName,"RunSP(" & strSP & ", ...)")
      End Try
   End Function
   Sub RunSQL(ByVal strSQL As String,ByVal params As Object,Optional ByVal strConn As String = "")
      ' Create the ADO objects
      Dim cmd As System.Data.SqlClient.SqlCommand = Nothing
      Try
         gmRTL.Core.GlobalException.ClearErrorObject()

         cmd = New System.Data.SqlClient.SqlCommand

         ' Init the ADO objects & the stored proc parameters
         If (strConn = "") Then
            cmd.Connection = new System.Data.SqlClient.SqlConnection(GetConnectionString())
         Else
            cmd.Connection = new System.Data.SqlClient.SqlConnection(strConn)
         End If
         cmd.CommandText = strSQL
         cmd.CommandType = System.Data.CommandType.Text
         collectParams(cmd,params)

         ' Execute the query without returning a recordset
         cmd.Connection.Open()
         cmd.ExecuteNonQuery()
         cmd.Connection.Close()

         ' Cleanup
         cmd.Connection = Nothing
         cmd = Nothing

         Exit Sub

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         cmd = Nothing
         Helpers.RaiseError(m_modName,"RunSQL(" & Strings.Left(strSQL,10) & ", ...)")
      End Try
   End Sub
   Function RunSPReturnInteger(ByVal strSP As String,ByVal params As Object,Optional ByVal strConn As String = "") As Integer
      RunSPReturnInteger = 0
      ' Create the ADO objects
      Dim cmd As System.Data.SqlClient.SqlCommand = Nothing
      Try
         gmRTL.Core.GlobalException.ClearErrorObject()

         cmd = New System.Data.SqlClient.SqlCommand

         ' Init the ADO objects & the stored proc parameters
         If (strConn = "") Then
            cmd.Connection = new System.Data.SqlClient.SqlConnection(GetConnectionString())
         Else
            cmd.Connection = new System.Data.SqlClient.SqlConnection(strConn)
         End If
         cmd.CommandText = strSP
         cmd.CommandType = System.Data.CommandType.StoredProcedure
         collectParams(cmd,params)

         ' Assume the last parameter is outgoing
         cmd.Parameters.Add(gmRTL.DataLib.SqlClient.SqlCommandExtensions.CreateParameter(cmd,"@retval",System.Data.SqlDbType.Int,System.Data.ParameterDirection.Output,4,Nothing))

         ' Execute without a resulting recordset and pull out the "return value" parameter
         cmd.Connection.Open()
         cmd.ExecuteNonQuery()
         cmd.Connection.Close()
         RunSPReturnInteger = CInt(cmd.Parameters("@retval").Value)

         ' Disconnect the command, and clean up
         cmd.Connection = Nothing
         cmd = Nothing

         Exit Function

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         cmd = Nothing
         Helpers.RaiseError(m_modName,"RunSPReturnInteger(" & strSP & ", ...)")
      End Try
   End Function
   Function RunSQLReturnInteger(ByVal strSQL As String,ByVal params As Object,Optional ByVal strConn As String = "") As Integer
      RunSQLReturnInteger = 0
      ' Create the ADO objects
      Dim cmd As System.Data.SqlClient.SqlCommand = Nothing
      Try
         gmRTL.Core.GlobalException.ClearErrorObject()

         cmd = New System.Data.SqlClient.SqlCommand

         ' Init the ADO objects & the stored proc parameters
         If (strConn = "") Then
            cmd.Connection = new System.Data.SqlClient.SqlConnection(GetConnectionString())
         Else
            cmd.Connection = new System.Data.SqlClient.SqlConnection(strConn)
         End If
         cmd.CommandText = strSQL
         cmd.CommandType = System.Data.CommandType.Text

         ' Assume the first parameter is outgoing
         cmd.Parameters.Add(gmRTL.DataLib.SqlClient.SqlCommandExtensions.CreateParameter(cmd,"@retval",System.Data.SqlDbType.Int,System.Data.ParameterDirection.Output,4,Nothing))

         collectParams(cmd,params)

         '
         ' Execute without a resulting recordset and pull out the "return value" parameter
         cmd.Connection.Open()
         cmd.ExecuteNonQuery()
         cmd.Connection.Close()
         RunSQLReturnInteger = CInt(cmd.Parameters("@retval").Value)

         ' Disconnect the command, and clean up
         cmd.Connection = Nothing
         cmd = Nothing

         Exit Function

      Catch exc As System.Exception
         gmRTL.Core.GlobalException.SetErrorObject(exc)
         cmd = Nothing
         Helpers.RaiseError(m_modName,"RunSQLReturnInteger(" & Strings.Left(strSQL,10) & ", ...)")
      End Try
   End Function
   Private Sub collectParams(ByVal cmd As System.Data.SqlClient.SqlCommand,ByVal argparams As Object)
      Dim params As Object = Nothing
      Dim v As Object = Nothing
      Dim i As Integer = 0
      Dim l As Integer = 0
      Dim u As Integer = 0
      'if argparams is empty

      If (Not IsArray(argparams)) Then
         Exit Sub
      End If

      params = New Object(UBound(DirectCast(argparams, Object()), 1))() {}
      Array.Copy(DirectCast(argparams, Object()), params, UBound(DirectCast(argparams, Object()), 1) + 1)
      For i = LBound(CType(params,System.Array),1) To UBound(CType(params,System.Array),1) Step 1
         l = LBound(CType(params(i),System.Array),1)
         u = UBound(CType(params(i),System.Array),1)
         ' Check for nulls.
         If (u - l = 3) Then
            If (VarType(params(i)(3)) = VariantType.String) Then
               v = IIf(params(i)(3) = "",DBNull.Value,params(i)(3))
            Else
               v = params(i)(3)
            End If
            cmd.Parameters.Add(gmRTL.DataLib.SqlClient.SqlCommandExtensions.CreateParameter(cmd,params(i)(0),CType(params(i)(1),System.Data.SqlDbType),System.Data.ParameterDirection.Input,params(i)(2),v))
         Else
            Helpers.RaiseError(m_modName,"collectParams(...): incorrect # of parameters",,,True)
         End If
      Next
   End Sub
   Public Sub New()
      MyBase.New()
      Class_Initialize()
   End Sub
   Private Sub Class_Initialize()
      m_DBServer = Helpers.GetComputerName()
      ' to simplify the demo, I will assume the SQL server is accessible through the local machine name
   End Sub
   End Class
End Namespace
