' ------------------------------------------------------------
' Code generated automatically by Code Architects' VB Migration Partner
' ------------------------------------------------------------

Option Strict Off      ' Code migrated from VB6 has Option Strict disabled by default

Imports VB = Microsoft.VisualBasic

<System.Runtime.InteropServices.ProgID("FMStocks_DB.DBHelper")> _ 
<Transaction(TransactionOption.Supported)> _
Public Class DBHelper
	Inherits ServicedComponent

	#Region "Constructor"
	
	'A public default constructor
	Public Sub New()
		' Add initialization code here
	End Sub
	
	#End Region
	
	#Region "Static constructor"
	
	' This static constructor ensures that the VB6 support library be initialized before using current class.
	Shared Sub New()
		EnsureVB6LibraryInitialization()
	End Sub
	
	#End Region
	
	Private Const m_modName As String = "FMStocks_DB.DBHelper"
	
	Private m_DBServer As String = ""
	Private m_ConnectionString As String = ""
	
	Protected Overrides Sub Construct(ByVal comPlusConstructString As String)
		Dim pCtorObj As New VB6ObjectConstruct(comPlusConstructString)
	
		'eval construction string and find out what the admin wants us to do
		Dim arrParams As Object = Nothing
		Dim x As Short
		Dim strHints As String = ""
		
		On Error GoTo errorHandler 
		strHints = pCtorObj.ConstructString
		arrParams = Split(strHints, ",")
		For x = LBound6(arrParams) To UBound6(arrParams)
			Select Case UCase(GetKey(arrParams(x)))
			Case UCase("ConnectionString")
				m_ConnectionString = GetValue(arrParams(x))
			Case UCase("Server")
				m_DBServer = GetValue(arrParams(x))
			End Select
		Next
		
		Exit Sub
		
errorHandler:
		RaiseError(m_modName & "(IObjectConstruct Interface)", "Construct(" & strHints & ")", bWriteToLog:=True)
	End Sub

	Public Function GetConnectionString() As String
		On Error GoTo errorHandler 
		
		If m_ConnectionString <> "" Then 
			Return m_ConnectionString
		Else
			'assume that we want to use a SQL Server connection through OLDEB
			If m_DBServer <> "" Then 
				Return "Provider=SQLOLEDB;Data Source=" & m_DBServer & ";User Id=stocks_login;Password=password;Connect Timeout=3;network library=dbmssocn;"
			Else
				Return "Provider=SQLOLEDB;Data Source=localhost;User Id=stocks_login;Password=password;Connect Timeout=3;network library=dbmssocn;"
			End If
		End If
		
		Exit Function
		
errorHandler:
		RaiseError(m_modName, "GetConnectionString()", bWriteToLog:=True)
	End Function

	Public Function RunSPReturnRS(ByVal strSP As String, Optional ByRef params As Object = VB6Missing, Optional ByRef strConn As String = "") As ADODB.Recordset
		On Error GoTo errorHandler 
		
		' Create the ADO objects
		Dim rs As ADODB.Recordset = Nothing
		Dim cmd As ADODB.Command = Nothing
		rs = New ADODB.Recordset()
		cmd = New ADODB.Command()
		
		' Init the ADO objects  & the stored proc parameters
		If strConn = "" Then 
			cmd.ActiveConnection.ConnectionString = GetConnectionString()
		Else
			cmd.ActiveConnection.ConnectionString = strConn
		End If
		cmd.CommandText = strSP
		cmd.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
		
		collectParams(cmd, params)
		
		' Execute the query for readonly
		rs.CursorLocation = ADODB.CursorLocationEnum.adUseClient
		rs.Open(cmd, , ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockReadOnly)
		
		' Disconnect the recordset
		cmd.ActiveConnection = Nothing
		cmd = Nothing
		rs.ActiveConnection = Nothing
		
		' Return the resultant recordset
		Return rs
		
errorHandler:
		rs = Nothing
		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
	
	Public Function RunSQLReturnRS(ByVal strSQL As String, ByRef params As Object, Optional ByRef strConn As String = "") As ADODB.Recordset
		On Error GoTo errorHandler 
		
		' Set up Command and Connection objects
		Dim rs As ADODB.Recordset = Nothing
		Dim cmd As ADODB.Command = Nothing
		rs = New ADODB.Recordset()
		cmd = New ADODB.Command()
		
		'Run the procedure
		If strConn = "" Then 
			cmd.ActiveConnection.ConnectionString = GetConnectionString()
		Else
			cmd.ActiveConnection.ConnectionString = strConn
		End If
		cmd.CommandText = strSQL
		cmd.CommandType = ADODB.CommandTypeEnum.adCmdText
		
		collectParams(cmd, params)
		
		rs.CursorLocation = ADODB.CursorLocationEnum.adUseClient
		rs.Open(cmd, , ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockReadOnly)
		
		' Disconnect the recordsets and cleanup
		cmd.ActiveConnection = Nothing
		cmd = Nothing
		rs.ActiveConnection = Nothing
		
		Return rs
		
errorHandler:
		rs = Nothing
		cmd = Nothing
		RaiseError(m_modName, "RunSQLReturnRS(" & VB.Left(strSQL, 10) & ", ...)")
	End Function

	Public Function RunSPReturnRS_RW(ByVal strSP As String, ByRef params As Object, Optional ByRef strConn As String = "") As ADODB.Recordset
		On Error GoTo errorHandler 
		
		' Create the ADO objects
		Dim rs As ADODB.Recordset = Nothing
		Dim cmd As ADODB.Command = Nothing
		rs = New ADODB.Recordset()
		cmd = New ADODB.Command()
		
		' Init the ADO objects & the stored proc parameters
		If strConn = "" Then 
			cmd.ActiveConnection.ConnectionString = GetConnectionString()
		Else
			cmd.ActiveConnection.ConnectionString = strConn
		End If
		cmd.CommandText = strSP
		cmd.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
		collectParams(cmd, params)
		rs.CursorLocation = ADODB.CursorLocationEnum.adUseClient
		
		' Execute the query as an updatable recordset and stay connected
		rs.Open(cmd, , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockBatchOptimistic)
		cmd = Nothing
		
		' Return and quit
		Return rs
		
errorHandler:
		rs = Nothing
		cmd = Nothing
		RaiseError(m_modName, "RunSPReturnRS_RW(" & strSP & ", ...)")
	End Function

	Public Function RunSQLReturnRS_RW(ByVal strSQL As String, ByRef params As Object, Optional ByRef strConn As String = "") As ADODB.Recordset
		On Error GoTo errorHandler 
		
		' Create the ADO objects
		Dim rs As ADODB.Recordset = Nothing
		Dim cmd As ADODB.Command = Nothing
		rs = New ADODB.Recordset()
		cmd = New ADODB.Command()
		
		' Init the ADO objects & the stored proc parameters
		If strConn = "" Then 
			cmd.ActiveConnection.ConnectionString = GetConnectionString()
		Else
			cmd.ActiveConnection.ConnectionString = strConn
		End If
		cmd.CommandText = strSQL
		cmd.CommandType = ADODB.CommandTypeEnum.adCmdText
		collectParams(cmd, params)
		rs.CursorLocation = ADODB.CursorLocationEnum.adUseClient
		
		' Execute the query as an updatable recordset and stay connected
		rs.Open(cmd, , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockBatchOptimistic)
		cmd = Nothing
		
		' Return and quit
		Return rs
		
errorHandler:
		rs = Nothing
		cmd = Nothing
		RaiseError(m_modName, "RunSQLReturnRS_RW(" & strSQL & ", ...)")
	End Function

	Public Function RunSP(ByVal strSP As String, ByRef params As Object, Optional ByRef strConn As String = "") As Object
		On Error GoTo errorHandler 
		
		' Create the ADO objects
		Dim cmd As ADODB.Command = New ADODB.Command()
		
		' Init the ADO objects & the stored proc parameters
		If strConn = "" Then 
			cmd.ActiveConnection.ConnectionString = GetConnectionString()
		Else
			cmd.ActiveConnection.ConnectionString = strConn
		End If
		cmd.CommandText = strSP
		cmd.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
		collectParams(cmd, params)
		
		' Execute the query without returning a recordset
		cmd.Execute(, , ADODB.ExecuteOptionEnum.adExecuteNoRecords)
		
		' Disconnect the command and clean up
		cmd.ActiveConnection = Nothing
		cmd = Nothing
		
		Exit Function
		
errorHandler:
		cmd = Nothing
		RaiseError(m_modName, "RunSP(" & strSP & ", ...)")
	End Function

	Public Function RunSQL(ByVal strSQL As String, ByRef params As Object, Optional ByRef strConn As String = "") As Object
		On Error GoTo errorHandler 
		
		' Create the ADO objects
		Dim cmd As ADODB.Command = New ADODB.Command()
		
		' Init the ADO objects & the stored proc parameters
		If strConn = "" Then 
			cmd.ActiveConnection.ConnectionString = GetConnectionString()
		Else
			cmd.ActiveConnection.ConnectionString = strConn
		End If
		cmd.CommandText = strSQL
		cmd.CommandType = ADODB.CommandTypeEnum.adCmdText
		collectParams(cmd, params)
		
		' Execute the query without returning a recordset
		cmd.Execute(, , ADODB.ExecuteOptionEnum.adExecuteNoRecords)
		
		' Cleanup
		cmd.ActiveConnection = Nothing
		cmd = Nothing
		
		Exit Function
		
errorHandler:
		cmd = Nothing
		RaiseError(m_modName, "RunSQL(" & VB.Left(strSQL, 10) & ", ...)")
	End Function

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

	Public Function RunSQLReturnInteger(ByVal strSQL As String, ByRef params As Object, Optional ByRef strConn As String = "") As Integer 'adInterger is really a VB Long
		On Error GoTo errorHandler 
		
		' Create the ADO objects
		Dim cmd As ADODB.Command = New ADODB.Command()
		
		' Init the ADO objects & the stored proc parameters
		If strConn = "" Then 
			cmd.ActiveConnection.ConnectionString = GetConnectionString()
		Else
			cmd.ActiveConnection.ConnectionString = strConn
		End If
		cmd.CommandText = strSQL
		cmd.CommandType = ADODB.CommandTypeEnum.adCmdText
		
		' Assume the first parameter is outgoing
		cmd.Parameters.Append(cmd.CreateParameter("@retval", ADODB.DataTypeEnum.adInteger, ADODB.ParameterDirectionEnum.adParamOutput, 4))
		
		collectParams(cmd, params)

		' Execute without a resulting recordset and pull out the "return value" parameter
		cmd.Execute(, , ADODB.ExecuteOptionEnum.adExecuteNoRecords)
		RunSQLReturnInteger = cmd.Parameters("@retval").Value
		
		' Disconnect the command, and clean up
		cmd.ActiveConnection = Nothing
		cmd = Nothing
		
		Exit Function
		
errorHandler:
		cmd = Nothing
		RaiseError(m_modName, "RunSQLReturnInteger(" & VB.Left(strSQL, 10) & ", ...)")
	End Function

	Private Sub collectParams(ByRef cmd As ADODB.Command, ByVal argparams As Object)
		Dim params As Object = Nothing
		Dim v As Object = Nothing
		Dim i As Short
		Dim l As Short
		Dim u As Short
		'if argparams is empty
		
		If Not IsArray6(argparams) Then  Exit Sub
		
		params = argparams
		For i = LBound6(params) To UBound6(params)
			l = LBound6(params(i))
			u = UBound6(params(i))
			' Check for nulls.
			If u - l = 3 Then 
				If VarType6(params(i, 3)) = VariantType.String Then 
					v = IIf(params(i, 3) = "", VB6Null, params(i, 3))
				Else
					v = params(i, 3)
				End If
				cmd.Parameters.Append(cmd.CreateParameter(params(i, 0), params(i, 1), ADODB.ParameterDirectionEnum.adParamInput, params(i, 2), v))
			Else
				RaiseError(m_modName, "collectParams(...): incorrect # of parameters", bWriteToLog:=True)
			End If
		Next
	End Sub

End Class
