Delete Keyword Count VB.net - vb.net

I Have Problem About this count Keyword after that appear that stuff
Here Code
Public Sub searchayumiKn()
Dim myKeyWords() As String = TChat.Text.Split(" "c)
Dim mySQLQuery As String = "SELECT AIRes FROM T_GKnowledge WHERE "
Dim KeyWordCount As Integer
For KeyWordCount = 0 To myKeyWords.Length - 1
Dim strKeyParameter As String = String.Format("#Param{0}", KeyWordCount)
Dim strWhereClause As String
If KeyWordCount = 0 Then
strWhereClause = String.Format("Keyword LIKE {0}", strKeyParameter)
Else
strWhereClause = String.Format(" OR Keyword LIKE {0}", strKeyParameter)
End If
mySQLQuery &= strWhereClause
cmdhikari.Parameters.AddWithValue(strKeyParameter, String.Format("{0}{1}{0}", "%", myKeyWords(KeyWordCount)))
Next
With cmdhikari
.CommandText = mySQLQuery
.Connection = conayumi
End With
Try
dthikari = New DataTable
dahikari.Fill(dthikari)
answers.DataBindings.Add("text", dthikari, "AIRes", True)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Caution")
End Try
KeyWordCount = 0
TChat.Clear()
Return
End Sub
Got Error #param bla". can anyone delete this count?
i just need original of data record. Not Count every time. just not using count. so freely record

move out from for this declaration
Dim strKeyParameter As String = String.Format("#Param{0}", KeyWordCount)
Dim strWhereClause As String
it's make duplicate declaration the same parameter
hopefully could be useful
regards
Ade Nurhuda

Related

ManagementException was Caught: Invalid class

I have the following Function intended to identify the username of the user who started a specific process:
Private Function GetProcessAssociatedUserID(ByVal processName As String) As String
Dim user(1) As String
Try
Dim query As New SelectQuery(processName)
Dim searcher As New System.Management.ManagementObjectSearcher(query)
For Each process As ManagementObject In searcher.Get()
process.InvokeMethod("GetOwner", CType(user, Object()))
Next
Catch ex As Exception
End Try
Return user(0)
End Function
However somewhere in the ForEach initiation i'm getting this "ManagementException was Caught: Invalid class" exception thrown into my catch block. I've been in through debug but still cant work out what is. Any help would be much appreciated.
You can try it accomplishing this way
Private Function GetProcessAssociatedUserID(ByVal processName As String) As String
Dim query = "Select * from Win32_Process Where Name = """ + processName + """"
Dim searcher = New ManagementObjectSearcher(query)
Dim processList = searcher.Get()
For Each mObj As ManagementObject In processList
Dim argList As String() = {String.Empty, String.Empty}
Dim returnVal = Convert.ToInt32(mObj.InvokeMethod("GetOwner", argList))
If returnVal = 0 Then
Return argList(1) + "\\" + argList(0)
End If
Next
Return ""
End Function
This snippet works with .NET Framework 3.5 and above. For more details you may refer using-managementobjectsearcher-in-systemmanagement-is-getting-compiling-errors

Performance improvement on vb.net code

I need to write 50 million records with 72 columns into text file, the file size is growing as 9.7gb .
I need to check each and every column length need to format as according to the length as defined in XML file.
Reading records from oracle one by one and checking the format and writing into text file.
To write 5 crores records it is taking more than 24 hours. how to increase the performance in the below code.
Dim valString As String = Nothing
Dim valName As String = Nothing
Dim valLength As String = Nothing
Dim valDataType As String = Nothing
Dim validationsArray As ArrayList = GetValidations(Directory.GetCurrentDirectory() + "\ReportFormat.xml")
Console.WriteLine("passed xml")
Dim k As Integer = 1
Try
Console.WriteLine(System.DateTime.Now())
Dim selectSql As String = "select * from table where
" record_date >= To_Date('01-01-2014','DD-MM-YYYY') and record_date <= To_Date('31-12-2014','DD-MM-YYYY')"
Dim dataTable As New DataTable
Dim oracleAccess As New OracleConnection(System.Configuration.ConfigurationManager.AppSettings("OracleConnection"))
Dim cmd As New OracleCommand()
cmd.Connection = oracleAccess
cmd.CommandType = CommandType.Text
cmd.CommandText = selectSql
oracleAccess.Open()
Dim Tablecolumns As New DataTable()
Using oracleAccess
Using writer = New StreamWriter(Directory.GetCurrentDirectory() + "\FileName.txt")
Using odr As OracleDataReader = cmd.ExecuteReader()
Dim sbHeaderData As New StringBuilder
For i As Integer = 0 To odr.FieldCount - 1
sbHeaderData.Append(odr.GetName(i))
sbHeaderData.Append("|")
Next
writer.WriteLine(sbHeaderData)
While odr.Read()
Dim sbColumnData As New StringBuilder
Dim values(odr.FieldCount - 1) As Object
Dim fieldCount As Integer = odr.GetValues(values)
For i As Integer = 0 To fieldCount - 1
Dim vals As Array = validationsArray(i).ToString.ToUpper.Split("|")
valName = vals(0).trim
valDataType = vals(1).trim
valLength = vals(2).trim
Select Case valDataType
Case "VARCHAR2"
If values(i).ToString().Length = valLength Then
sbColumnData.Append(values(i).ToString())
'sbColumnData.Append("|")
ElseIf values(i).ToString().Length > valLength Then
sbColumnData.Append(values(i).ToString().Substring(0, valLength))
'sbColumnData.Append("|")
Else
sbColumnData.Append(values(i).ToString().PadRight(valLength))
'sbColumnData.Append("|")
End If
Case "NUMERIC"
valLength = valLength.Substring(0, valLength.IndexOf(","))
If values(i).ToString().Length = valLength Then
sbColumnData.Append(values(i).ToString())
'sbColumnData.Append("|")
Else
sbColumnData.Append(values(i).ToString().PadLeft(valLength, "0"c))
'sbColumnData.Append("|")
End If
'sbColumnData.Append((values(i).ToString()))
End Select
Next
writer.WriteLine(sbColumnData)
k = k + 1
Console.WriteLine(k)
End While
End Using
writer.WriteLine(System.DateTime.Now())
End Using
End Using
Console.WriteLine(System.DateTime.Now())
'Dim Adpt As New OracleDataAdapter(selectSql, oracleAccess)
'Adpt.Fill(dataTable)
Return Tablecolumns
Catch ex As Exception
Console.WriteLine(System.DateTime.Now())
Console.WriteLine("Error: " & ex.Message)
Console.ReadLine()
Return Nothing
End Try

VB.net Function that returns a populated object not working

I've been trying to create a function that returns an object of type. This function below is currently inside my dataclass and can be called from any object that inherits the dataclass. My problem is when I try and return my object. It populates just fine while I am inside the function. When I get back out to the calling object its all empty like it's a new object.
Here's the function....
Public Overloads Function GetClassFromDB(ByVal ID As Integer) As Object
Try
Dim BaseObject As New Object
Dim objDerived As Type = MyBase.GetType()
Dim TableName As String = String.Empty
Dim SQL As New LottoPayload.SQLiDataClass
Dim SQLString As String = String.Empty
Dim SQLCommand As SQLiteCommand = Nothing
Dim SQLConnection As SQLiteConnection = Nothing
Dim SQLiteDRObj As SQLiteDataReader = Nothing
Dim SQLResultsTable As New DataTable
'Create an instance of the base object
BaseObject = Activator.CreateInstance(objDerived)
'Get the tablename from the object
TableName = objDerived.GetProperty("TableName").GetValue(BaseObject, Nothing).ToString
SQLString = "SELECT * FROM " & TableName & " WHERE ID = '" & ID.ToString & "' LIMIT 1"
SQLConnection = SQL.GetSqlConnection()
SQLConnection.Open()
SQLCommand = New SQLiteCommand(SQLConnection)
SQLCommand.CommandText = SQLString
SQLiteDRObj = SQLCommand.ExecuteReader()
SQLResultsTable.Load(SQLiteDRObj)
If SQLResultsTable.Rows.Count > 0 Then
For Each Row As DataRow In SQLResultsTable.Rows
For Each Column As DataColumn In Row.Table.Columns
Dim ColumnName As String = Column.ColumnName.ToString
Console.WriteLine(Row.Item(ColumnName))
Dim ColumnValue As Object = Row.Item(ColumnName)
Console.WriteLine(Column.DataType.Name & " ")
Select Case Column.DataType.Name
Case "Int64"
Dim ConvertedValue As Integer
Integer.TryParse(ColumnValue.ToString, ConvertedValue)
objDerived.GetProperty(ColumnName).SetValue(BaseObject, ConvertedValue, Nothing)
Case "Double"
Dim ConvertedValue As Double
Double.TryParse(ColumnValue.ToString, ConvertedValue)
objDerived.GetProperty(ColumnName).SetValue(BaseObject, ConvertedValue, Nothing)
Case "String"
Dim ConvertedValue As String
ConvertedValue = ColumnValue.ToString
objDerived.GetProperty(ColumnName).SetValue(BaseObject, ConvertedValue, Nothing)
Case Else
Dim ConvertedValue As String
ConvertedValue = "NotSet"
objDerived.GetProperty(ColumnName).SetValue(BaseObject, ConvertedValue, Nothing)
End Select
Next
Next
End If
Return objDerived
SQLiteDRObj.Close()
SQLConnection.Close()
SQLConnection.Dispose()
'Return False
Catch ex As Exception
Return False
End Try
End Function
and this is how it would be called.
Dim objResults As New myapp.objResult
Dim ID As Integer = 3
objResults.GetClassFromDB(ID)
Question #1 - When I return the object from GetClassFromDB objResults is empty eventhough it had data up until the Return objDerived. Why is this the case?
Question #2 - Is there a way I can eliminate that Select Case area and consolidate the code by using reflection?
Thanks in advance for the help.
Shouldn't you be returning BaseObject rather than objDerived, given that objDerived is actually a Type object that represents the type of the object created rather than the object itself? Maybe it would be clearer if you didn't use appalling names like objDerived in the first place.
The problem is that your method returns an object, but you are not assigning it to a variable anywhere. You need to assign the return value of the method to a variable
Dim someVariable As Object = objResults.GetClassFromDB(ID)
Also, your method is strange in that it returns an object if the code runs successfully but a boolean if there is an exception, which you silently swallow (also a bad practice).
You are returning the wrong object. objDerived is a Type, not the object that you are setting. You need to return BaseObject. Also, realize that your code to close and dispose the SqlCommand and Connection won't be hit since it's after the return operator. It's best here to wrap the connection and command in Using clauses which will ensure they will be disposed once they go out of scope. See if the following works:
Public Overloads Function GetClassFromDB(ByVal ID As Integer) As Object
Try
Dim BaseObject As New Object
Dim objDerived As Type = MyBase.GetType()
Dim TableName As String = String.Empty
Dim SQL As New LottoPayload.SQLiDataClass
Dim SQLString As String = String.Empty
Using SQLConnection As SQLiteConnection = Nothing
Using SQLCommand As SQLiteCommand = Nothing
Dim SQLiteDRObj As SQLiteDataReader = Nothing
Dim SQLResultsTable As New DataTable
'Create an instance of the base object
BaseObject = Activator.CreateInstance(objDerived)
'Get the tablename from the object
TableName = objDerived.GetProperty("TableName").GetValue(BaseObject, Nothing).ToString
SQLString = "SELECT * FROM " & TableName & " WHERE ID = '" & ID.ToString & "' LIMIT 1"
SQLConnection = SQL.GetSqlConnection()
SQLConnection.Open()
SQLCommand = New SQLiteCommand(SQLConnection)
SQLCommand.CommandText = SQLString
SQLiteDRObj = SQLCommand.ExecuteReader()
SQLResultsTable.Load(SQLiteDRObj)
If SQLResultsTable.Rows.Count > 0 Then
For Each Row As DataRow In SQLResultsTable.Rows
For Each Column As DataColumn In Row.Table.Columns
Dim ColumnName As String = Column.ColumnName.ToString
Console.WriteLine(Row.Item(ColumnName))
Dim ColumnValue As Object = Row.Item(ColumnName)
Console.WriteLine(Column.DataType.Name & " ")
Select Case Column.DataType.Name
Case "Int64"
Dim ConvertedValue As Integer
Integer.TryParse(ColumnValue.ToString, ConvertedValue)
objDerived.GetProperty(ColumnName).SetValue(BaseObject, ConvertedValue, Nothing)
Case "Double"
Dim ConvertedValue As Double
Double.TryParse(ColumnValue.ToString, ConvertedValue)
objDerived.GetProperty(ColumnName).SetValue(BaseObject, ConvertedValue, Nothing)
Case "String"
Dim ConvertedValue As String
ConvertedValue = ColumnValue.ToString
objDerived.GetProperty(ColumnName).SetValue(BaseObject, ConvertedValue, Nothing)
Case Else
Dim ConvertedValue As String
ConvertedValue = "NotSet"
objDerived.GetProperty(ColumnName).SetValue(BaseObject, ConvertedValue, Nothing)
End Select
Next
Next
End If
End Using ' Sql Command
End Using ' Sql Connection
Return BaseObject
'Return False
Catch ex As Exception
Return False
End Try
End Function
End Class
From your second screen shot, you don't appear to be setting anything to the return of the GetClassFromDB(ID) method. It should probably be something like:
Dim result = objResults.GetClassFromDB(ID)
' Do something with result

Procedure or function 'p_xxx ' has too many arguments specified

I get the error at this line: sqlDataAdapDelProtocol.Fill(dsDelProtocol, "dsProtocols"), I dint understand why. The error states : Procedure or function p_GetLinkedProcuduresProtocol has too many arguments specified
Protected Sub btnDeletePTC_Click(ByVal sender As Object, ByVal e As EventArgs)
Dim sqlString As String = String.Empty
Dim PTC_ID As Integer
sqlString = "p_GetLinkedProcuduresProtocol"
Dim sqlConnDelProtocol As New SqlClient.SqlConnection(typicalConnectionString("MyConn").ConnectionString)
sqlConnDelProtocol.Open()
Dim sqlDataAdapDelProtocol As New SqlClient.SqlDataAdapter(sqlString, sqlConnDelProtocol)
sqlDataAdapDelProtocol.SelectCommand.CommandType = CommandType.StoredProcedure
Dim sqlParProtocolName As New SqlClient.SqlParameter("#PTC_ID", SqlDbType.Int, 255)
sqlDataAdapDelProtocol.SelectCommand.Parameters.Add(sqlParProtocolName)
Dim dsDelProtocol As New DataSet
Dim MessageAud = "Are you sure you want to delete this question, the question is linked to:"
Dim MessageNoAud = "Are you sure you want to delete this question"
sqlDataAdapDelProtocol.SelectCommand.Parameters.AddWithValue("PTC_ID", PTC_ID)
sqlDataAdapDelProtocol.Fill(dsDelProtocol, "dsProtocols")
If dsDelProtocol.Tables("dsProtocols").Rows.Count > 0 Then
lblMessageSure.Text = (CType(MessageAud, String))
For Each dr As DataRow In dsDelProtocol.Tables(0).Rows
lblAudits = (dr("dsProtocols"))
Next
Else
lblMessageSure.Text = (CType(MessageNoAud, String))
End If
Dim success As Boolean = False
Dim btnDelete As Button = TryCast(sender, Button)
Dim row As GridViewRow = DirectCast(btnDelete.NamingContainer, GridViewRow)
Dim cmdDelete As New SqlCommand("p_deleteProtocolStructure")
cmdDelete.CommandType = CommandType.StoredProcedure
cmdDelete.Parameters.AddWithValue("PTC_ID", PTC_ID)
Call DeleteProtocol(PTC_ID)
conn = NewSqlConnection(connString, EMP_ID)
cmdDelete.Connection = conn
If Not conn Is Nothing Then
If conn.State = ConnectionState.Open Then
Try
success = cmdDelete.ExecuteNonQuery()
Call UpdateProtocolNumbering(PTS_ID)
txtAddPTCNumber.Text = GetNextNumber(PTS_ID)
Page.ClientScript.RegisterClientScriptBlock(Me.GetType(), "TreeView", _
"<script language='javascript'>" & _
" parent.TreeView.location='TreeView.aspx?MainScreenURL=Protocols.aspx&PTS_ID=" & PTS_ID & "';" & _
"</script>")
conn.Close()
Catch ex As Exception
success = False
conn.Close()
Throw ex
End Try
End If
End If
If success = True Then
Call GenerateQuestionsGrid()
Call Message(Me, "pnlMessage", "Question successfully deleted.", Drawing.Color.Green)
Else
Call Message(Me, "pnlMessage", "Failed to delete Question.", Drawing.Color.Red)
End If
End Sub
You are adding the same parameter twice, once without a value, then with a value. Instead of adding it another time, set the value on the parameter that you already have.
Replace this:
sqlDataAdapDelProtocol.SelectCommand.Parameters.AddWithValue("PTC_ID", PTC_ID)
with this:
sqlParProtocolName.Vaue = PTC_ID
Side note: Always start parameter names for Sql Server with #. The parameter constructor will add it if it's not there so it will work without it, but this is an undocumented feature, so that could change in future versions.

Why do I get the error: System.Runtime.InteropServices.COMException?

I am using VB.NET to Create Labels in Microsoft. This is my code:
Public Sub CreateLabel(ByVal StrFilter As String, ByVal Path As String)
WordApp = CreateObject("Word.Application")
''Add a new document.
WordDoc = WordApp.Documents.Add()
Dim oConn As SqlConnection = New SqlConnection(connSTR)
oConn.Open()
Dim oCmd As SqlCommand
Dim oDR As SqlDataReader
oCmd = New SqlCommand(StrFilter, oConn)
oDR = oCmd.ExecuteReader
Dim intI As Integer
Dim FilePath As String = ""
With WordDoc.MailMerge
With .Fields
Do While oDR.Read
For intI = 0 To oDR.FieldCount - 1
.Add(WordApp.Selection.Range, oDR.Item(intI))
Next
Loop
End With
Dim objAutoText As Word.AutoTextEntry = WordApp.NormalTemplate.AutoTextEntries.Add("MyLabelLayout", WordDoc.Content)
WordDoc.Content.Delete()
.MainDocumentType = Word.WdMailMergeMainDocType.wdMailingLabels
FilePath = CreateSource(StrFilter)
.OpenDataSource(FilePath)
Dim NewLabel As Word.CustomLabel = WordApp.MailingLabel.CustomLabels.Add("MyLabel", False)
WordApp.MailingLabel.CreateNewDocument(Name:="MyLabel", Address:="", AutoText:="MyLabelLayout")
objAutoText.Delete()
.Destination = Word.WdMailMergeDestination.wdSendToNewDocument
WordApp.Visible = True
.Execute()
End With
oConn.Close()
WordDoc.Close()
End Sub
Private Function CreateSource(ByVal StrFilter As String) As String
Dim CnnUser As SqlConnection = New SqlConnection(connSTR)
Dim sw As StreamWriter = File.CreateText("C:\Mail.Txt")
Dim Path As String = "C:\Mail.Txt"
Dim StrHeader As String = ""
Try
Dim SelectCMD As SqlCommand = New SqlCommand(StrFilter, CnnUser)
Dim oDR As SqlDataReader
Dim IntI As Integer
SelectCMD.CommandType = CommandType.Text
CnnUser.Open()
oDR = SelectCMD.ExecuteReader
For IntI = 0 To oDR.FieldCount - 1
StrHeader &= oDR.GetName(IntI) & " ,"
Next
StrHeader = Mid(StrHeader, 1, Len(StrHeader) - 2)
sw.WriteLine(StrHeader)
sw.Flush()
sw.Close()
StrHeader = ""
Do While oDR.Read
For IntJ As Integer = 0 To oDR.FieldCount - 1
StrHeader &= oDR.GetString(IntJ) & " ,"
Next
Loop
StrHeader = Mid(StrHeader, 1, Len(StrHeader) - 2)
sw = File.AppendText(Path)
sw.WriteLine(StrHeader)
CnnUser.Close()
sw.Flush()
sw.Close()
Catch ex As Exception
MessageBox.Show(ex.Message, "TempID", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
Return Path
End Function
Now when I am running the program I am getting this error. I tried hard but not able to locate what could be the problem the error is:
System.Runtime.InteropServices.COMException -->Horizontal and vertical
pitch must be greater than or equal to the label width and height,
respectively.
Even though I tried to set the Horizontal and vertical pitch programatically it gives same error.
Make sure that you have a default printer set up for the user account that the application runs under. Might not be relevant but I have had various unusual problems following that omission.
Did you install the Office Primary Interop Assemblies? (Appropriately abbreviated to PIA)
Try this