Imports System.Diagnostics
Imports System.Linq
Public Module mdUtility
Dim sConn As string = ""
Dim sServer As string, sDatabase As string, sUserName As string, sPassword As string
Dim sLastSQLToRun As string = ""
Public Sub Setconnectionstring(connectionstringValue As string)
sConn = connectionstringValue
End Sub
Public Sub Setconnectionstring(Server As string, Database As string, UserName As string, Password As string)
If Server > "" And Database = "" Then
Throw New Exception("When server is specified then database name is required.")
End If
sServer = Server
sDatabase = Database
sUserName = UserName
sPassword = Password
End Sub
Private Sub Buildconnectionstring()
sConn = "Server=" & sServer & ";Initial Catalog=" & sDatabase & ";Persist Security Info=false;"
If sUserName <> "" Then
sConn = sConn & "User ID=" & sUserName & ";Password=" & sPassword & ";"
Else
sConn = sConn + "Trusted_Connection = true;"
End If
'sConn = sConn & "MultipleActiveResultSets =false;Encrypt=true;Connection Timeout=30;"
';TrustServerCertificate=false
End Sub
Public Function GetCommand(SprocName As string) As SqlCommand
Dim objCmd As SqlCommand = New SqlCommand(SprocName)
mdUtility.SetUpParameters(objCmd)
Return objCmd
End Function
Public Sub SetUpParameters(CommandObj As SqlCommand)
Buildconnectionstring()
Using objConn As SqlConnection = New SqlConnection(sConn)
CommandObj.Connection = objConn
CommandObj.CommandType = CommandType.StoredProcedure
objConn.Open()
SqlCommandBuilder.DeriveParameters(CommandObj)
For Each objP As SqlParameter In CommandObj.Parameters
With objP
If .Direction <> ParameterDirection.ReturnValue Then
objP.Value = DBNull.Value
End If
End With
Next
Try
objConn.Close()
Catch ex As Exception
End Try
End Using
End Sub
Public Sub UpdateAdapter(AdapterObj As SqlDataAdapter, TableObj As DataTable)
Dim bUpdate As Boolean = false
Dim bDelete As Boolean = false
Dim bInsert As Boolean = false
Buildconnectionstring()
If TableObj Is Nothing = false Then
With TableObj
If .Select("", "", DataViewRowState.Added).Count > 0 Then
bInsert = true
End If
If .Select("", "", DataViewRowState.Deleted).Count > 0 Then
bDelete = true
End If
If .Select("", "", DataViewRowState.ModIfiedCurrent).Count > 0 Then
bUpdate = true
End If
End With
End If
Dim objConn As SqlConnection = New SqlConnection(sConn)
With AdapterObj
If .UpdateCommand Is Nothing = false Then
.UpdateCommand.Connection = objConn
.UpdateCommand.CommandType = CommandType.StoredProcedure
SetUpParameterSources(.UpdateCommand, TableObj)
End If
If .InsertCommand Is Nothing = false Then
.InsertCommand.Connection = objConn
.InsertCommand.CommandType = CommandType.StoredProcedure
SetUpParameterSources(.InsertCommand, TableObj)
End If
If .DeleteCommand Is Nothing = false Then
.DeleteCommand.Connection = objConn
.DeleteCommand.CommandType = CommandType.StoredProcedure
SetUpParameterSources(.DeleteCommand, TableObj)
End If
End With
Using objConn
Try
objConn.Open()
Catch ex As Exception
Throw New CPUException("Invalid Connection. " & vbCrLf & "Technichal Info: " & ex.Message)
End Try
Try
With AdapterObj
.Update(TableObj)
If bUpdate = true And .UpdateCommand Is Nothing = false Then
CheckReturnValue(.UpdateCommand)
End If
If bInsert = true And .InsertCommand Is Nothing = false Then
CheckReturnValue(.InsertCommand)
End If
If bDelete = true And .DeleteCommand Is Nothing = false Then
CheckReturnValue(.DeleteCommand)
End If
End With
Catch ex As Exception When ex.Message.ToLower.Contains("u_")
Dim sMsg As string = ParseErrorMessage(ex.Message, "u_")
Throw New CPUException(sMsg, CPUException.ExceptionTypeEnum.Expected)
Catch ex As Exception When ex.Message.ToLower.Contains("ck_")
Dim sMsg As string = ParseErrorMessage(ex.Message, "ck_")
Throw New CPUException(sMsg, CPUException.ExceptionTypeEnum.Expected)
Catch ex As Exception When ex.Message.ToLower.Contains("f_")
Dim sMsg As string = ParseErrorMessage(ex.Message, "f_")
Throw New CPUException(sMsg, CPUException.ExceptionTypeEnum.Expected)
Catch ex As CPUException
Throw ex
Catch ex As Exception
Throw New CPUException("Invalid SQL. " & ex.Message)
Finally
With AdapterObj
If bUpdate = true And .UpdateCommand Is Nothing = false Then
Debug.Print(GetSQL(.UpdateCommand))
End If
If bInsert = true And .InsertCommand Is Nothing = false Then
Debug.Print(GetSQL(.InsertCommand))
End If
If bDelete = true And .DeleteCommand Is Nothing = false Then
Debug.Print(GetSQL(.DeleteCommand))
End If
End With
End Try
End Using
End Sub
Private Function DoExecuteSQL(CommandObj As SqlCommand, ReturnsDataTable As Boolean, Optional DatabaseName As string = "") As DataTable
Buildconnectionstring()
Dim objT As DataTable = New DataTable
Dim objConn As SqlConnection = New SqlConnection(sConn)
Dim objReader As SqlDataReader
If DatabaseName <> "" Then
sDatabase = DatabaseName
End If
With CommandObj
.Connection = objConn
.CommandType = CommandType.StoredProcedure
End With
Using objConn
Try
objConn.Open()
Catch ex As Exception
Throw New CPUException("Invalid Connection. " & vbCrLf & "Technichal Info: " & ex.Message)
End Try
Try
Debug.Print(GetSQL(CommandObj))
If ReturnsDataTable = false Then
CommandObj.ExecuteNonQuery()
Else
objReader = CommandObj.ExecuteReader
objT.Load(objReader)
objT.TableName = CommandObj.CommandText
SetAllowDBNull(objT)
End If
CheckReturnValue(CommandObj)
Catch ex As Exception When ex.Message.ToLower.Contains("u_")
Dim sMsg As string = ParseErrorMessage(ex.Message, "u_")
Throw New CPUException(sMsg, CPUException.ExceptionTypeEnum.Expected)
Catch ex As Exception When ex.Message.ToLower.Contains("ck_")
Dim sMsg As string = ParseErrorMessage(ex.Message, "ck_")
Throw New CPUException(sMsg, CPUException.ExceptionTypeEnum.Expected)
Catch ex As Exception When ex.Message.ToLower.Contains("f_")
Dim sMsg As string = ParseErrorMessage(ex.Message, "f_")
Throw New CPUException(sMsg, CPUException.ExceptionTypeEnum.Expected)
Catch ex As CPUException
Throw ex
Catch ex As Exception
Throw New CPUException("Invalid SQL. " & ex.Message)
End Try
End Using
Return objT
End Function
Public Function SetUpAdapter(TableName As string) As SqlDataAdapter
Dim objAdapter As SqlDataAdapter = New SqlDataAdapter
'Get Command
Dim objCmd As SqlCommand = mdUtility.GetCommand(TableName & "Get")
objAdapter.SelectCommand = objCmd
'Update and Insert Command
objCmd = mdUtility.GetCommand(TableName & "Update")
' objCmd.Parameters("iPartyId").SourceColumn = "iPartyId"
'objCmd.Parameters("vchPartyName").SourceColumn = "vchPartyName"
objAdapter.UpdateCommand = objCmd
objAdapter.InsertCommand = objCmd
'Delete Command
objCmd = mdUtility.GetCommand(TableName & "Delete")
'objCmd.Parameters("iPartyId").SourceColumn = "iPartyId"
objAdapter.DeleteCommand = objCmd
Return objAdapter
End Function
Private Sub SetUpParameterSources(CommandObj As SqlCommand, TableObj As DataTable)
For Each objColumn As DataColumn In TableObj.Columns
Dim sParName As string = "" & objColumn.ColumnName
With CommandObj
If .Parameters.Contains(sParName) Then
.Parameters(sParName).SourceColumn = objColumn.ColumnName
End If
End With
Next
End Sub
Public Function GetDataTable(CommandObj As SqlCommand, Optional DatabaseName As string = "") As DataTable
Dim objT As DataTable
objT = DoExecuteSQL(CommandObj, true, DatabaseName)
Return objT
End Function
Public Function ExecuteProc(CommandObj As SqlCommand, Optional DatabaseName As string = "") As DataTable
Dim objT As DataTable
objT = DoExecuteSQL(CommandObj, false, DatabaseName)
Return objT
End Function
Private Sub CheckReturnValue(CommandObj As SqlCommand)
Dim sMsgName As string = "vchMessage"
Dim sMessage As string = ""
Dim objReturnValueParam As SqlParameter = Nothing
For Each objP As SqlParameter In CommandObj.Parameters
With objP
If .Direction = ParameterDirection.ReturnValue Then
If .Value <> 0 Then
objReturnValueParam = objP
Exit For
End If
End If
End With
Next
If objReturnValueParam Is Nothing = false Then
If CommandObj.Parameters.Contains(sMsgName) = true Then
sMessage = CommandObj.Parameters(sMsgName).Value
End If
If sMessage = "" Then
sMessage = CommandObj.CommandText & " failed."
End If
Throw New CPUException(sMessage, CPUException.ExceptionTypeEnum.Expected)
End If
End Sub
Private Function GetSQL(CommandObj As SqlCommand) As string
Dim sSQL As string = ""
Dim sBody As string = ""
Dim sDeclare As string = "declare iResult int"
Dim sSelect As string = "Select iResult = iResult"
Dim sHeader As string = ""
Dim sParams As string = ""
With CommandObj
If .Connection Is Nothing = false Then
sHeader = sHeader & "--" & .Connection.connectionstring & vbCrLf & vbCrLf
sHeader = sHeader & "use " & .Connection.Database & vbCrLf & "go" & vbCrLf
End If
For Each objP As SqlParameter In .Parameters
With objP
Select Case .Direction
Case ParameterDirection.Output, ParameterDirection.InputOutput
sSQL = sSQL & .ParameterName & " " & .SqlDbType.Tostring & vbCrLf
End Select
End With
Next
sBody = "exec iResult = " & .CommandText & vbCrLf
For Each objP As SqlParameter In .Parameters
With objP
If .Direction <> ParameterDirection.ReturnValue Then
If sParams > "" Then
sParams = sParams & "," & vbCrLf
End If
sParams = sParams & .ParameterName & " = " & GetParamValueForSQL(objP)
Select Case .Direction
Case ParameterDirection.Output, ParameterDirection.InputOutput
sDeclare = sDeclare & ", " & .ParameterName & " " & .SqlDbType.Tostring
Dim sDimension As string = ""
Select Case .SqlDbType
Case SqlDbType.VarChar, SqlDbType.Char
sDimension = " (" & .Size & ")"
Case SqlDbType.Decimal
sDimension = " (" & .Precision & "," & .Scale & ")"
End Select
sDeclare = sDeclare & sDimension
sSelect = sSelect & ", " & .ParameterName.Replace("", "") & "-" & .ParameterName
End Select
End If
End With
Next
sBody = sBody & sParams
sSQL = sHeader & sDeclare & vbCrLf & sBody & vbCrLf & sSelect
End With
sLastSQLToRun = sSQL
Return sSQL
End Function
Public Function LastSQLToRun() As string
Return sLastSQLToRun
End Function
Private Function GetParamValueForSQL(ParamObj As SqlParameter) As string
Dim sValue As string = ""
With ParamObj
If .Direction = ParameterDirection.Output Or .Direction = ParameterDirection.InputOutput Then
sValue = .ParameterName & " output"
ElseIf .Value Is Nothing OrElse IsDBNull(.Value) = true Then
sValue = "null"
Else
Select Case .SqlDbType
Case SqlDbType.VarChar, SqlDbType.Char, SqlDbType.Date, SqlDbType.DateTime
sValue = "'" & .Value & "'"
Case Else
sValue = .Value
End Select
End If
End With
Return sValue
End Function
Public Function GetDataTable(SqlStatement As string, Optional DatabaseName As string = "") As DataTable
Buildconnectionstring()
Dim objT As DataTable = New DataTable
Dim objConn As SqlConnection = New SqlConnection(sConn)
Dim objReader As SqlDataReader
Dim objCmd As SqlCommand = New SqlCommand
If DatabaseName <> "" Then
sDatabase = DatabaseName
End If
With objCmd
.Connection = objConn
.CommandType = CommandType.Text
.CommandText = SqlStatement
End With
Using objConn
Try
objConn.Open()
Catch ex As Exception
Throw New CPUException("Invalid Connection. " & vbCrLf & "Technichal Info: " & ex.Message)
End Try
Try
objReader = objCmd.ExecuteReader
Catch ex As Exception When ex.Message.ToLower.Contains("u_")
Dim sMsg As string = ParseErrorMessage(ex.Message, "u_")
Throw New CPUException(sMsg)
Catch ex As Exception When ex.Message.ToLower.Contains("ck_")
Dim sMsg As string = ParseErrorMessage(ex.Message, "ck_")
Throw New CPUException(sMsg)
Catch ex As Exception When ex.Message.ToLower.Contains("f_")
Dim sMsg As string = ParseErrorMessage(ex.Message, "f_")
Throw New CPUException(sMsg)
Catch ex As Exception
Throw New CPUException("Invalid SQL. " & ex.Message)
End Try
objT.Load(objReader)
SetAllowDBNull(objT)
End Using
Return objT
End Function
Private Function ParseErrorMessage(ErrorMessage As string, ConstraintPrefix As string) As string
Dim sPart1Message As string = "Sorry, an error has occured!" & vbCrLf & "Technical Info:" & vbCrLf
Dim sMsg As string = ErrorMessage
Dim nPos As Integer = ErrorMessage.IndexOf(ConstraintPrefix)
If nPos > -1 Then
sMsg = sMsg.Substring(nPos)
sMsg = sMsg.Replace(ConstraintPrefix, "")
sMsg = sMsg.Replace("""", "'")
nPos = sMsg.IndexOf("'")
If nPos > -1 Then
sMsg = sMsg.Substring(0, nPos)
If ConstraintPrefix.ToLower = "f_" Then
Dim lstMsg As List(Of string) = sMsg.Split("_").ToList
If lstMsg.Count > 1 Then
sMsg = "Cannot delete " & lstMsg(0) & " because it has related records in " & lstMsg(1)
Else
sMsg = ErrorMessage
End If
Else
sMsg = sMsg.Replace("_", " ")
End If
End If
End If
sMsg = sPart1Message & sMsg
Return sMsg
End Function
Public Function IsFeildKey(FieldName As string) As Boolean
Dim b As Boolean = false
FieldName = FieldName.ToLower
If FieldName.StartsWith("i") And FieldName.EndsWith("id") Then
b = true
End If
Return b
End Function
Public Function GetFriEndlyColumnName(ColumnName As string) As string
Dim sName As string = ColumnName
If sName.ToLower.StartsWith("i") Then
sName = sName.Substring(1)
End If
If sName.ToLower.StartsWith("vch") Then
sName = sName.Substring(3)
End If
If sName.ToLower.StartsWith("dt") Then
sName = sName.Substring(2)
End If
If sName.ToLower.StartsWith("dc") Then
sName = sName.Substring(2)
End If
If sName.ToLower.StartsWith("m") Then
sName = sName.Substring(2)
End If
Dim lstLetters As List(Of Char) = sName.ToList()
sName = ""
lstLetters.ForEach(Sub(sLetter)
If sLetter <> LCase(sLetter) And sName > "" Then
sName = sName & " "
End If
sName = sName & sLetter
End Sub)
Return sName
End Function
Public Function GetTableAsstring(TableObj As DataTable, ColumnDelimiter As string, UseFriEndlyColumnName As Boolean) As string
Dim sValue As string = ""
For Each objColumn As DataColumn In TableObj.Columns
Dim sCol As string = objColumn.ColumnName
If UseFriEndlyColumnName = true Then
sCol = mdUtility.GetFriEndlyColumnName(sCol)
End If
sValue = sValue & sCol & ColumnDelimiter
Next
sValue = sValue & vbCrLf
For Each objRow As DataRow In TableObj.Rows
For Each objColumn As DataColumn In TableObj.Columns
Dim sItem As string = ""
If IsDBNull(objRow.Item(objColumn.ColumnName)) = true Then
sItem = "null"
Else
sItem = objRow.Item(objColumn.ColumnName)
End If
sValue = sValue & sItem & ColumnDelimiter
Next
sValue = sValue & vbCrLf
Next
Return sValue
End Function
Public Sub SaveTableToCSV(FileName As string, TableObj As DataTable, UseColumnFriEndlyName As Boolean)
Using objStream As IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(FileName, false)
Dim sData As string = GetTableAsstring(TableObj, ",", UseColumnFriEndlyName)
objStream.WriteLine(sData)
End Using
End Sub
Private Sub SetAllowDBNull(DataTableObj As DataTable)
For Each objC As DataColumn In DataTableObj.Columns
objC.AllowDBNull = true
Next
End Sub
Public Sub Login(Server As string, Database As string, UserName As string, Password As string)
Setconnectionstring(Server, Database, UserName, Password)
Buildconnectionstring()
Using objC As SqlConnection = New SqlConnection(sConn)
objC.Open()
End Using
End Sub
End Module