Faster HTTPWEBREQUEST/WEBRESPONSE - Too Slow - vb.net

Is there any way to speed this up? It is going through a list of 2000 and going one by one. Please note, I have tried "service manager max connections/default connections etc. None of these have been valuable solutions.
'
' Created by SharpDevelop.
' User: merickson2
' Date: 3/22/2014
' Time: 5:59 PM
'
' To change this template use Tools | Options | Coding | Edit Standard Headers.
'
Imports System.Net
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions
Public Partial Class MainForm
Dim Fetch1 As Integer
Dim NewList1 As Integer
Dim SplitList() As String
Dim tempCookies As New CookieContainer
Dim encoding As New UTF8Encoding
Public Sub New()
' The Me.InitializeComponent call is required for Windows Forms designer support.
Me.InitializeComponent()
'
' TODO : Add constructor code after InitializeComponents
'
End Sub
Sub MainFormLoad(sender As Object, e As EventArgs)
'Do stuff
End Sub
Sub Button1Click(sender As Object, e As EventArgs)
Dim postData As String = "Login Data"
Dim byteData As Byte() = encoding.GetBytes(postData)
Dim postReq As HttpWebRequest = DirectCast(WebRequest.Create("http://Login"), HttpWebRequest)
postReq.Method = "POST"
postReq.KeepAlive = True
postReq.CookieContainer = tempCookies
postReq.ContentType = "application/x-www-form-urlencoded"
postReq.Referer = "http://login
postReq.UserAgent = "Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729)"
postReq.ContentLength = byteData.Length
Dim postreqstream As Stream = postReq.GetRequestStream()
postreqstream.Write(byteData, 0, byteData.Length)
postreqstream.Close
Dim postresponse As HttpWebResponse
postresponse = DirectCast(postReq.GetResponse(), HttpWebResponse)
tempCookies.Add(postresponse.Cookies)
Dim postreqreader As New StreamReader(postresponse.GetResponseStream())
Dim thepage As String = postreqreader.ReadToEnd
InitLeech()
End Sub
Public Sub InitLeech()
For x = 0 To Listbox2.Items.Count - 1
SplitList = Split(listBox2.Items(x), "|")
Dim postData2 As String = "Search Data"
Dim byteData2 As Byte() = encoding.GetBytes(postData2)
Dim postReq2 As HttpWebRequest = DirectCast(WebRequest.Create("http://Search"), HttpWebRequest)
postReq2.Method = "POST"
postReq2.KeepAlive = False
postReq2.CookieContainer = tempCookies
postReq2.ContentType = "application/x-www-form-urlencoded"
postReq2.Referer = "http://Search"
postReq2.UserAgent = "Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729)"
postReq2.ContentLength = byteData2.Length
Dim postreqstream2 As Stream = postReq2.GetRequestStream()
postreqstream2.Write(byteData2, 0, byteData2.Length)
postreqstream2.Close
Dim postresponse2 As HttpWebResponse
postresponse2 = DirectCast(postReq2.GetResponse(), HttpWebResponse)
Dim postreqreader2 As New StreamReader(postresponse2.GetResponseStream())
Dim thepage2 As String = postreqreader2.ReadToEnd
Dim SplitIt() As String
Dim CheckRating As String
Dim WrongStuff As String
If Len(thepage2) > 10 Then
If InStr(thepage2,"UCDMC:") > 0 then
SplitIt = Split(thepage2,"UCDMC:",7)
CheckRating = SplitIt(1).Substring(29,2)
CheckRating = Replace(CheckRating,".", "")
textBox1.Text = checkrating
Dim FullName As String
Dim TrueName As String
Dim DOB As String
Dim Sex As String
Dim StartP As Integer
Dim EndP As Integer
Dim Addy As String
StartP = InStr(thepage2,"UCDMC:") + 129
StartP = InStr(StartP, thepage2, ">")
EndP = InStr(StartP, thepage2, "</")
FullName = Trim(Strings.Mid(thepage2, StartP, EndP - StartP))
FullName = Replace(FullName, ">", "")
FullName = Replace(FullName, " ", " ")
TrueName = SplitList(0) + ", " + SplitList(1) + " " + SplitList(2)
TrueName = Regex.Replace(TrueName, "\p{C}+", "")
FullName = Regex.Replace(FullName, "\p{C}+", "")
WrongStuff = ""
If Trim(FullName) = Trim(TrueName) Then
'do nothing
Else
WrongStuff = " + (Wrong: Name"
End If
StartP = EndP + 23
EndP = InStr(StartP, thepage2, "</")
DOB = Trim(Strings.Mid(thepage2, StartP, EndP - StartP))
DOB = Replace(DOB, "<", "")
Dim Dobcheck As String
Dobcheck = Replace(DOB, "-", "")
If Dobcheck = SplitList(3) Then
'do nothing
Else
If WrongStuff = "" Then
WrongStuff = " + (Wrong: DOB"
Else
WrongStuff = WrongStuff + "/DOB"
End If
End If
StartP = EndP + 23
EndP = InStr(StartP, thepage2, "-")
Sex = Trim(Strings.Mid(thepage2, StartP, EndP - StartP))
Sex = Replace(Sex, "<", "")
If Sex = SplitList(4) Then
'do nothing
Else
If WrongStuff = "" Then
WrongStuff = " + (Wrong: SEX"
Else
WrongStuff = WrongStuff + "/SEX"
End If
End If
StartP = EndP + 62
EndP = InStr(StartP, thepage2, ",")
Addy = Trim(Strings.Mid(thepage2, StartP, EndP - StartP))
Addy = Replace(Addy, "<BR>", " - ")
Addy = Replace(Addy, Chr(34), "")
Addy = Replace(Addy, ">", "")
If InStr(Addy, "/td") > 0 Then
Addy = "No Address Given"
End If
If WrongStuff = "" Then
'do nothing
Else
WrongStuff = WrongStuff + ")"
End If
If checkBox1.Checked = True Then
WrongStuff = WrongStuff + " + {" + listBox2.Items(x).ToString + "}"
End If
If CheckRating > 6 then
If SplitList(2) = "" Then
listBox1.Items.Add("[" + SplitList(0) + ", " + SplitList(1) + " * " + SplitList(3) + " * " + SplitList(4) + "] + (Weight: " + CheckRating + ")" + " + (MRN: " + SplitIt(1).Substring(0,7) + ") + [" + FullName + " * " + Dobcheck + " * " + Sex + "] + {" + Addy + "}" + WrongStuff)
Else
listBox1.Items.Add("[" + SplitList(0) + ", " + SplitList(1) + " " + SplitList(2) + " * " + SplitList(3) + " * " + SplitList(4) + "] + (Weight: " + CheckRating + ")" + " + (MRN: " + SplitIt(1).Substring(0,7) + ") + [" + FullName + " * " + Dobcheck + " * " + Sex + "] + {" + Addy + "}" + WrongStuff)
End If
label2.Text = "Existing Patients: " + listBox1.Items.Count.ToString
Else
If SplitList(2) = "" Then
listBox3.Items.Add("[" + SplitList(0) + ", " + SplitList(1) + " * " + SplitList(3) + " * " + SplitList(4) + "] + (Weight: " + CheckRating + ")" + " + (MRN: " + SplitIt(1).Substring(0,7) + ") + [" + FullName + " * " + Dobcheck + " * " + Sex + "] + {" + Addy + "}" + WrongStuff)
Else
listBox3.Items.Add("[" + SplitList(0) + ", " + SplitList(1) + " " + SplitList(2) + " * " + SplitList(3) + " * " + SplitList(4) + "] + (Weight: " + CheckRating + ")" + " + (MRN: " + SplitIt(1).Substring(0,7) + ") + [" + FullName + " * " + Dobcheck + " * " + Sex + "] + {" + Addy + "}" + WrongStuff)
End If
label3.Text = "New Patients: " + listBox3.Items.Count.ToString
End if
Else
If checkBox1.Checked = True Then
WrongStuff = " + {" + listBox2.Items(x).ToString + "}"
End If
listBox3.Items.Add(SplitList(0) + ", " + SplitList(1) + " + (Not Found)" + WrongStuff)
label3.Text = "New Patients: " + listBox3.Items.Count.ToString
End If
End If
label1.Text = "Checking " & listBox1.Items.Count + listBox3.Items.Count & " of " & listBox2.Items.Count.ToString
fetch1 = fetch1 + 1
Application.DoEvents()
Next
If fetch1.ToString = test1.Text Then
If listBox1.Items.Count + listBox3.Items.Count = listBox2.Items.Count Then
label1.Text = "Mission Complete"
label1.ForeColor = Color.Green
Else
label1.Text = "Checking " & listBox1.Items.Count + listBox3.Items.Count & " of " & listBox2.Items.Count.ToString
End If
Else
fetch1 = fetch1 + 1
End If
End Sub
Sub Button2Click(sender As Object, e As EventArgs)
Dim TempName As String
Dim TempPath As String
Dim PCount As Integer
PCount = listBox2.Items.Count
Using dialog As New OpenFileDialog
dialog.Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
If dialog.ShowDialog() <> DialogResult.OK Then Return
Dim a As String = My.Computer.FileSystem.ReadAllText(dialog.FileName)
listBox2.Items.AddRange(IO.File.ReadAllText(dialog.filename).Split(New String() {Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries))
TempName = System.IO.Path.GetFileNameWithoutExtension(dialog.FileName) + ".txt"
TempPath = dialog.FileName
End Using
listBox2.SelectedIndex = 0
PCount = listBox2.Items.Count - PCount
richTextBox1.Text = richTextBox1.Text + TempName + ": " + PCount.ToString + vbCrLf
test0.Text = listBox2.Items.Count.ToString
NewList1 = NewList1 + 1
label5.Text = "Patient Files Loaded : " + NewList1.ToString
End If
End Sub
End Class

Related

TableAdapter.Update in vb.net Winform is not updating the values in the SQL Server database

I'm using a Windows Form in Visual Studio 2019 to upload an Excel file to a SQL Server database. Upload happens just fine. For simplicity; Column 'No' gets populated with values 1,2 etc. with what's included in the excel file. Column 'BUSINESS_UNIT' is left as NULL as that field is not in the excel file. What I need to do is enter a specific value, say 'ABC' for all rows of Column BUSINESS_UNIT.
No
BUSINESS_UNIT
1
NULL
2
NULL
So I'm using an update statement in my datatableadapater as below.
UPDATE MR_STAGE_SUPPLIERDELIVERY_MANUAL
SET PROCESSING_DATE = { fn NOW() },
BUSINESS_UNIT = 'ABC',
DIVISION = 'Autonomous Systems',
EAS_BUSINESS_UNIT_CD = 'TOT',
EAS_DIVISION_CD = 'AUTOSYS'
WHERE
(PERF_YEAR = #YEARINPUT) AND (PERF_MONTH = #MONTHINPUT)
This code works just as intended when I test it in Query Builder, it updates the records in SQL database. Then I added the below piece of code before debugging my winform code 'new.vb'.
Below are the functions I use to insert data from Excel to SQL database via Winform button.
Insert Function
Private Function ReturnInsertStatement(row As Integer) As String
Try
Dim tempString As String
Dim lastColumn As Integer
Dim ColumnName As String
Dim excelRange As Excel.Range
Dim filterString As String
tempString = "INSERT INTO [dbo].[MR_STAGE_SUPPLIERDELIVERY_MANUAL] (PERF_MONTH, PERF_YEAR,"
For lastColumn = 1 To 256
excelRange = objSheet.Cells(row, lastColumn)
ColumnName = excelRange.Value
filterString = "COLUMN_NAME='" + ColumnName + "'"
Dim findRow() As DataRow = BDSSMTOOLSDataSet.MR_STAGE_SUPPLIERDELIVERYNEW_COLUMNS.Select(filterString)
If findRow.Count > 0 Then
If Len(Trim(ColumnName)) > 0 Then
Me.columnsWithData = lastColumn + 1
tempString = tempString + "[" + Trim(findRow(0).Item("COLUMN_NAME").ToString) + "],"
Label5.Text = Label5.Text + " [" + Trim(Str(lastColumn)) + "]" + "(" + Trim(findRow(0).Item("DATA_TYPE").ToString) + ") " + Trim(findRow(0).Item("COLUMN_NAME").ToString) + " | "
End If
Else
If Len(Trim(ColumnName)) > 0 Then
Me.columnsWithData = lastColumn + 1
Label3.Text = Label3.Text + " [" + Trim(Str(lastColumn)) + "]" + "() " + ColumnName + " | "
End If
End If
Next
tempString = tempString.Substring(0, tempString.Length - 1) + ")"
ReturnInsertStatement = tempString
Catch ex As Exception
MsgBox(ex.ToString)
ReturnInsertStatement = ""
End Try
End Function
Return Function
Private Function ReturnValueStatement(row As Integer) As String
Try
Dim tempString As String
Dim lastColumn As Integer
Dim ColumnName As String
Dim filterString As String
tempString = " (" + perfMonthCombo.SelectedValue.ToString + "," + perfYearCombo.SelectedValue.ToString + ","
For lastColumn = 1 To Me.columnsWithData
ColumnName = excelRangeValues(row, lastColumn)
filterString = "[" + Trim(Str(lastColumn)) + "]"
If Label5.Text.Contains(filterString) Then
If Len(Trim(ColumnName)) = 0 Then
tempString = tempString + "Null,"
ElseIf Label5.Text.Contains(filterString + "(nvarchar)") Or Label5.Text.Contains(filterString + "(varchar)") Then
ColumnName = ColumnName.Replace("'", "''")
tempString = tempString + "'" + Trim(ColumnName) + "',"
ElseIf Label5.Text.Contains(filterString + "(datetime)") Or Label5.Text.Contains(filterString + "(date)") Then
Dim integerdate As Integer
If Integer.TryParse(ColumnName, integerdate) Then
ColumnName = DateTime.FromOADate(CDbl(integerdate)).ToString("MM/dd/yyyy")
End If
ColumnName = ColumnName.Replace("'", "''")
tempString = tempString + "'" + Trim(ColumnName) + "',"
Else
tempString = tempString + "" + Trim(ColumnName) + ","
End If
End If
Next
tempString = tempString.Substring(0, tempString.Length - 1) + ")"
ReturnValueStatement = tempString
Catch ex As Exception
MsgBox(ex.ToString)
ReturnValueStatement = ""
End Try
End Function
Where excel and database table is mapped
For rownum = 2 To last_row
valueString = ""
For rownum2 = 0 To 50 ' batch size
valueString = valueString + ReturnValueStatement(rownum) + ","
Label4.Text = "Rows Processing: " + Trim(Str(rownum)) + " of " + Trim(Str(last_row))
If rownum >= last_row Then Exit For
ProgressBar1.Value = rownum
rownum = rownum + 1
Next rownum2
valueString = valueString.Subs << File: VB CODE.txt >> tring(0, valueString.Length - 1)
If IsNothing(result) Then
cmd.CommandText = insertString + " VALUES " + valueString
'Console.WriteLine("T0: " + cmd.CommandText)
result = cmd.BeginExecuteNonQuery()
Else
If IsNothing(result1) Then
cmd1.CommandText = insertString + " VALUES " + valueString
' Console.WriteLine("T1: " + cmd1.CommandText)
result1 = cmd1.BeginExecuteNonQuery()
Else
cmd2.CommandText = insertString + " VALUES " + valueString
'Console.WriteLine("T2: " + cmd2.CommandText)
result2 = cmd2.BeginExecuteNonQuery()
cmdvalue2 = cmd2.EndExecuteNonQuery(result2)
'Console.WriteLine("T2: Command complete. Affected {0} rows.", cmdvalue2)
If ProgressBar2.Value + cmdvalue2 < ProgressBar2.Maximum Then
ProgressBar2.Value = ProgressBar2.Value + cmdvalue2
Else
ProgressBar2.Value = ProgressBar2.Maximum
End If
Label6.Text = "Records in the Database: " + Str(ProgressBar2.Value)
result2 = Nothing
End If
End If
If IsNothing(result) = False Then
If result.IsCompleted Or rownum >= last_row Then
cmdValue = cmd.EndExecuteNonQuery(result)
' Console.WriteLine("T0: Command complete. Affected {0} rows.", cmdValue)
If ProgressBar2.Value + cmdValue < ProgressBar2.Maximum Then
ProgressBar2.Value = ProgressBar2.Value + cmdValue
Else
ProgressBar2.Value = ProgressBar2.Maximum
End If
Label6.Text = "Records in the Database: " + Str(ProgressBar2.Value)
result = Nothing
End If
End If
If IsNothing(result1) = False Then
If result1.IsCompleted Or rownum >= last_row Then
cmdvalue1 = cmd1.EndExecuteNonQuery(result1)
' Console.WriteLine("T1: Command complete. Affected {0} rows.", cmdvalue1)
If ProgressBar2.Value + cmdvalue1 < ProgressBar2.Maximum Then
ProgressBar2.Value = ProgressBar2.Value + cmdvalue1
Else
ProgressBar2.Value = ProgressBar2.Maximum
End If
Label6.Text = "Records in the Database: " + Str(ProgressBar2.Value)
result1 = Nothing
End If
End If
Try
cmd.CommandTimeout = 10000
Me.Validate()
Me.MR_STAGE_SUPPLIERDELIVERYNEW_MANUALTableAdapter.Fill(Me.BDSSMTOOLSDataSet.MR_STAGE_SUPPLIERDELIVERYNEW_MANUAL, perfYearCombo.SelectedValue, perfMonthCombo.SelectedValue)
Me.MR_STAGE_SUPPLIERDELIVERYNEW_MANUALTableAdapter.Update(Me.BDSSMTOOLSDataSet.MR_STAGE_SUPPLIERDELIVERYNEW_MANUAL)
DataisSavedtoDB = True
perfMonthYear = Trim(perfMonthCombo.SelectedValue.ToString) + "/01/" + Trim(perfYearCombo.SelectedValue.ToString)
Label9.Text = "Current Number of Records for " + Trim(perfMonthCombo.SelectedValue.ToString) + "/" + Trim(perfYearCombo.SelectedValue.ToString) Me.BDSSMTOOLSDataSet.MR_STAGE_SUPPLIERDELIVERYNEW_MANUAL.Count.ToString
Catch ex As Exception
MsgBox(ex.ToString)
End Try
MR_STAGE_SUPPLIERDELIVERYNEW_COLUMNSTableAdapter1.Connection.Close()
When I debug this application; insert statement TableAdapter.Fill works as intended, inserting all the excel data into the SQL data, but the update statement TableAdapter.Update is not updating any of the data in my SQL database. It does not throw any error, data in SQL server database is just not updated, i.e. BUSINESS_UNIT is still NULL in database.
I attempted below solutions all day, but had no luck.
Setting dataset properties to "Do not Copy"
Wrapping up the update statement within Try Catch
Using Bindingsource.Endif() after the update statement
Attempted to use .AcceptChanges() method, but this throws an error saying that its not a member of the tableadapter
Any kind help to get this working is very much appreciated!

how to Print arabic on ESC/POS printer

i am using visual studio 2005 and i want to print Arabic on POS thermal printer. when i try to print it shows ????? in print
here is my code:
Public Sub GiftReceipt()
Try
Dim displayString As String
Dim ESC As String = Chr(&H1B) + "a" + Chr(0)
Dim ESC2 As String = Chr(&H1B) + "#"
Dim ESC1 As String = Chr(&H1B) + "a" + Chr(1)
Dim ESC4 As String = Chr(&H1B) + "a" + Chr(2)
Dim ESC5 As String = Chr(&H1B) + "!" + Chr(17)
Dim ESC6 As String = Chr(&H1B) + "!" + Chr(1)
Dim ESC7 As String = Chr(&H1B) + "t%"
Dim ESC8 As String = Chr(&H1B) + "?0"
Dim ESC9 As String = Chr(&H1B) + "R" + Chr(17)
displayString = vbNewLine
displayString += ESC7 + "معطار" + ESC8 + vbNewLine
displayString += vbNewLine
Dim pd As New PrintDialog()
pd.PrinterSettings = New PrinterSettings()
pd.UseEXDialog = True
Call DefaultPrinterName()
RawPrinterHelper.SendStringToPrinter(DefaultPrinterName, displayString)
Catch ex As Exception
MsgBox(ex.ToString())
End Try
End Sub
i have alredy tried to convert it to windows-1256, and also tried using many esc pos commands

Make a loop asynchronous in vb.net [duplicate]

This question already has answers here:
How can I run code in a background thread and still access the UI?
(2 answers)
Use of Application.DoEvents()
(10 answers)
Closed 3 years ago.
I'm trying to create an app to copy massive amounts of files in vb.net and I'm trying to make it asynchronous, so I can pause, stop and create a counter over the progress bars, and I have researched a little bit on how to do it, but I don't quite understand how to modify my code.
This is most of the code I'm working on:
Private Sub btnMoverImagenes_Click(sender As Object, e As EventArgs) Handles btnMoverImagenes.Click
Dim carpetaProducto As String
Dim agno As String
Dim mes As String
Dim dia As String
Dim secuencia As String
Dim rutaOrigen As String
Dim RutaDestinoOp As String
Dim RutaDestinoHis As String
Dim archivo As String
Dim DestinoArchivoOrigen As String
Dim DestinoArchivoHistorico As String
Dim idregistro As Integer
Dim dsregistros As Integer
Dim imagenMulti As String
Dim nuevaRutaImagenMulti As String
Dim nombreImagenOrigen As String
Dim contadorIMGCopiadas As Integer = 0
Dim contadorRegistros As Integer = 0
Dim contadorArchivosSinImagen As Integer = 0
Dim h1 As Date
Dim h2 As Date
Dim tiempoCarga As String
Dim fechaCarga As String
h1 = System.DateTime.Now
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = 1000
ProgressBar1.Value = 0
ProgressBar2.Minimum = 0
ProgressBar2.Maximum = 1000
ProgressBar2.Value = 0
fechaDesde = dtpDesde.ToString
fechaHasta = dtpHasta.ToString
dtpDesde.Format = DateTimePickerFormat.Custom
dtpDesde.CustomFormat = "yyyyMMdd"
fechaDesde = dtpDesde.Text
dtpHasta.Format = DateTimePickerFormat.Custom
dtpHasta.CustomFormat = "yyyyMMdd"
fechaHasta = dtpHasta.Text
dsImagenes = EjecutarXML(conexionDat, fechaDesde, fechaHasta)
Try
If dsImagenes.Tables(dsImagenes.Tables.Count - 1).Rows(0).Item(3) > 0 Then
dsregistros = dsImagenes.Tables(0).Rows.Count
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = dsregistros
ProgressBar1.Value = 0
ProgressBar2.Minimum = 0
ProgressBar2.Maximum = dsregistros
ProgressBar2.Value = 0
Label5.Text = ProgressBar1.Value.ToString + " de " + ProgressBar1.Maximum.ToString
Label6.Text = ProgressBar2.Value.ToString + " de " + ProgressBar2.Maximum.ToString
Log("******* SE INICIA CARGA *******")
If dsImagenes.Tables(0).Rows.Count > 0 Then
For Each row As DataRow In dsImagenes.Tables(0).Rows
archivo = row.Item(0).ToString()
carpetaProducto = row.Item(3).ToString()
rutaOrigen = row.Item(1).ToString()
idregistro = row.Item(2).ToString()
agno = row.Item(4).ToString()
mes = row.Item(5).ToString()
dia = row.Item(6).ToString()
secuencia = row.Item(7).ToString()
fechaCarga = row.Item(9).ToString()
imagenMulti = row.Item(8).ToString()
nombreImagenOrigen = row.Item(10).ToString()
nuevaRutaImagenMulti = carpetaProducto + "\" + agno + "\" + mes + "\" + dia + "\" + secuencia + "\" + nombreImagenOrigen
RutaDestinoOp = RutaDestinoNasOp + "\" + carpetaProducto + "\" + agno + "\" + mes + "\" + dia + "\" + secuencia
RutaDestinoHis = RutaDestinoNasHis + "\" + carpetaProducto + "\" + agno + "\" + mes + "\" + dia + "\" + secuenciavo
DestinoArchivoOrigen = RutaDestinoNasOp + "\" + carpetaProducto + "\" + agno + "\" + mes + "\" + dia + "\" + secuencia + "\" + nombreImagenOrigen
DestinoArchivoHistorico = RutaDestinoNasHis + "\" + carpetaProducto + "\" + agno + "\" + mes + "\" + dia + "\" + secuencia + "\" + archivo
Log("------------------------------------------------------------------------------")
Log("******* Inicio copia archivo IDREGISTRO: " + idregistro.ToString + " *******")
If ValidaExisteImagenOrigen(rutaOrigen) = True Then
If ValidarRutaOrigen(rutaOrigen) = True Then
If CargaNasHistorico(rutaOrigen, RutaDestinoHis, DestinoArchivoHistorico, conexionDat, idregistro) = True Then
If CargaNasOperativo(rutaOrigen, RutaDestinoOp, DestinoArchivoOrigen, conexionDat, idregistro, nuevaRutaImagenMulti) = True Then
contadorIMGCopiadas = contadorIMGCopiadas + 1
If ProgressBar2.Value < ProgressBar2.Maximum Then
ProgressBar2.Value += 1
End If
End If
End If
Else
If ValidaImagenHistorico(DestinoArchivoHistorico) = True Then
If CargaNasHistorico(rutaOrigen, RutaDestinoHis, DestinoArchivoHistorico, conexionDat, idregistro) = True Then
contadorIMGCopiadas = contadorIMGCopiadas + 1
If ProgressBar2.Value < ProgressBar2.Maximum Then
ProgressBar2.Value += 1
End If
Else
Log("******* TODO OK, Registro id: " + idregistro.ToString + ". no se realiza copia de imagen *******")
contadorIMGCopiadas = contadorIMGCopiadas + 1
If ProgressBar2.Value < ProgressBar2.Maximum Then
ProgressBar2.Value += 1
End If
End If
End If
End If
Else
Log("******* ALERTA: Registro id: " + idregistro.ToString + " NO EXISTE *******")
contadorArchivosSinImagen = contadorArchivosSinImagen + 1
End If
contadorRegistros = contadorRegistros + 1
Log("******* Finaliza copia archivo IDREGISTRO: " + idregistro.ToString + " *******")
archivo = ""
carpetaProducto = ""
rutaOrigen = ""
idregistro = 0
agno = ""
mes = ""
dia = ""
secuencia = ""
If ProgressBar1.Value < ProgressBar1.Maximum Then
ProgressBar1.Value += 1
End If
Label5.Text = ProgressBar1.Value.ToString
Label6.Text = ProgressBar2.Value.ToString + " de " + ProgressBar2.Maximum.ToString
Next
h2 = System.DateTime.Now
tiempoCarga = (h2 - h1).ToString
MsgBox("Proceso Terminado, revisar log para ver el detalle del proceso completo")
Log("------------------------------------------------------------------------------")
Log("******* Copia Finalizada, IMAGENES COPIADAS: " + contadorIMGCopiadas.ToString + " DE " + dsregistros.ToString + " *******")
Log("******* REGISTROS SIN IMAGENES: " + contadorArchivosSinImagen.ToString + " *******")
Log("******* TIEMPO DE EJECUCION: " + tiempoCarga + " *******")
End If
Else
MsgBox("sin datos para la fecha seleccionada")
End If
Catch ex As Exception
MsgBox("ocurrio un error al buscar los datos")
End Try
End Sub
I'd really apreciate if someone could help me.

Form_load selects line (richtextbox), form temporarily loses focus, returns back with entire richtextbox selected

I have a form_load thats selecting a string in a RTB and it works perfectly, makes the line I specify highlighted yellow and all other lines untouched. when I click a button and load another form and use it then close it, the original form now has the entirety of its contents highlighted yellow. I tried adding rtb.DeselectAll() after the lines of code that select, but nothing seems to work.
I appreciate any and all suggestions. thanks in advance
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ReminderList.SelectionStart = ReminderList.GetFirstCharIndexFromLine(0)
ReminderList.SelectionLength = ReminderList.Lines(Globalvar.ReminderCount 1).Length
ReminderList.SelectionBackColor = Color.Yellow
Call FillOutCal()
End Sub
UPDATE: What Jim has said I am already aware of, the problem is that when I use another form and revisit the original form, the yellow selected portion has changed to encompass the whole rich text box. Here is the code for a Save button that brings back the main form with the selection bug:
Private Sub SaveButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SaveButton.Click
FormDesktop.ReminderList.DeselectAll()
If ItemName.Text = Nothing Then
Dim newerror As DialogResult = MessageBox.Show("Missing some information to complete the entry, make sure everything is filled out.", _
"Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
ElseIf ReminderRadio.Checked = False And TaskRadio.Checked = False And IdeaRadio.Checked = False Then
Dim newerror As DialogResult = MessageBox.Show("Missing some information to complete the entry, make sure everything is filled out.", _
"Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
Dim TypeOfIdea As Integer
If ReminderRadio.Checked = True Then
FormDesktop.ReminderList.Text += vbCrLf
TypeOfIdea = 1
Globalvar.ReminderCount += 1
ElseIf TaskRadio.Checked = True Then
FormDesktop.TaskList.Text += vbCrLf
TypeOfIdea = 2
Globalvar.TaskCount += 1
Else
FormDesktop.IdeaList.Text += vbCrLf
TypeOfIdea = 3
Globalvar.IdeaCount += 1
End If
Dim NameOfItem As String = ItemName.Text
Dim DueMonth As Integer = DateTimePick.Value.Month
Dim DueDay As Integer = DateTimePick.Value.Day
Dim DueYear As Integer = DateTimePick.Value.Year
Dim SubMonth As Integer = DateTime.Now.Month
Dim SubDay As Integer = DateTime.Now.Day
Dim SubYear As Integer = DateTime.Now.Year
Dim DueHour As Integer = Hour.Value
Dim DueMinute As Integer = Minute.Value
If TypeOfIdea = 1 Then
If Globalvar.ReminderCount = 1 Then
FormDesktop.ReminderList.Text += "#" + Globalvar.ReminderCount.ToString + " " + NameOfItem + vbCrLf
Else
FormDesktop.ReminderList.Text += vbCrLf + "#" + Globalvar.ReminderCount.ToString + " " + NameOfItem + vbCrLf
End If
If CheckBox1.Checked = True Then
FormDesktop.ReminderList.Text += "Due: " + DueMonth.ToString + "/" + DueDay.ToString + "/" + DueYear.ToString + ", " + _
DueHour.ToString + ":" + DueMinute.ToString + vbCrLf
Else
FormDesktop.ReminderList.Text += "Due: " + "N/A" + vbCrLf
End If
FormDesktop.ReminderList.Text += "Added: " + SubMonth.ToString + "/" + SubDay.ToString + "/" + SubYear.ToString + _
", " + DateTime.Now.Hour.ToString + ":" + DateTime.Now.Minute.ToString
ElseIf TypeOfIdea = 2 Then
If Globalvar.TaskCount = 1 Then
FormDesktop.TaskList.Text += "#" + Globalvar.TaskCount.ToString + " " + NameOfItem + vbCrLf
Else
FormDesktop.TaskList.Text += vbCrLf + "#" + Globalvar.TaskCount.ToString + " " + NameOfItem + vbCrLf
End If
If CheckBox1.Checked = True Then
FormDesktop.TaskList.Text += "Due: " + DueMonth.ToString + "/" + DueDay.ToString + "/" + DueYear.ToString + ", " + _
DueHour.ToString + ":" + DueMinute.ToString + vbCrLf
Else
FormDesktop.TaskList.Text += "Due: " + "N/A"
End If
FormDesktop.TaskList.Text += "Added: " + SubMonth.ToString + "/" + SubDay.ToString + "/" + SubYear.ToString + ", " + _
DateTime.Now.Hour.ToString + ":" + DateTime.Now.Minute.ToString
Else
If Globalvar.IdeaCount = 1 Then
FormDesktop.IdeaList.Text += "#" + Globalvar.IdeaCount.ToString + " " + NameOfItem + vbCrLf
Else
FormDesktop.IdeaList.Text += vbCrLf + "#" + Globalvar.IdeaCount.ToString + " " + NameOfItem + vbCrLf
End If
FormDesktop.IdeaList.Text += "Due: " + "N/A" + vbCrLf
FormDesktop.IdeaList.Text += "Added: " + SubMonth.ToString + "/" + SubDay.ToString + "/" + SubYear.ToString + ", " + _
DateTime.Now.Hour.ToString + ":" + DateTime.Now.Minute.ToString
End If
Me.Hide()
FormDesktop.BringToFront()
End Sub

VB NET String Search

How can I search for a string inside another one and then select all the characters till end of line ?
For example, given this string:
PrinterName: PDFCreator
PortName: PDFCreator:
Status: Unknown
DriverName: PDFCreator
PrinterName: Lexmark E360dn XL
PortName: someport
Status: Unknown
DriverName: Lexmark E360dn XL
HostAddress: somehostaddress
I'd like to search the string: "PrinterName" once it finds it, add it into a combobox, in order to get only the PrinterName.
So far i wrote this:
Dim TextSearched As String = tmp.Text
Dim Paragraph As String = "PrinterName:"
Dim location As Integer = 0
Dim occurances As Integer = 0
Do
location = TextSearched.IndexOf(Paragraph, location)
If location <> -1 Then
occurances += 1
If TextSearched.EndsWith(vbCrLf) Then
Debug.Print(TextSearched.Substring(location, TextSearched.IndexOf(vbCrLf)))
End If
location += Paragraph.Length
End If
Loop Until location = -1
where tmp.Text is a long string like the example above.
When i run it I get something like this:
PrinterName: PDFCreator
PrinterName: Lexmark E3
I don't get the "360dn XL"
Have you given any thought to using Regex? You can use a pattern like:
"PrinterName: (.*?)\r\n"
Which should find the line in your long string and capture the data into group 1. You would access the result like this:
Imports System.Text.RegularExpressions
Module Module1
Sub Main()
Dim TextSearch As String = _
"PrinterName : PDFCreator()" + vbCrLf + _
"PortName: PDFCreator()" + vbCrLf + _
"Status: Unknown()" + vbCrLf + _
"DriverName: PDFCreator()" + vbCrLf + _
"PrinterName: Lexmark E360dn XL" + vbCrLf + _
"PortName: someport()" + vbCrLf + _
"Status: Unknown()" + vbCrLf + _
"DriverName: Lexmark E360dn XL" + vbCrLf + _
"HostAddress: somehostaddress()"
Dim Matcher = Regex.Match(TextSearch, "PrinterName: (.*?)\r\n")
If Matcher.Success Then
Console.WriteLine(Matcher.Groups(1))
End If
End Sub
End Module
Results:
Lexmark E360dn XL
You would add Matcher.Groups(1) to your combobox.
This involves some simple parsing using the IndexOf and SubString Extension Methods. Here is an example that puts all of the PrinterName values into a List(of String).:
Dim lstLines As List(Of String) = IO.File.ReadAllLines("C:\Your\Location\tmp.txt").ToList()
Dim lstPrinters As New List(Of String)
lstLines.ForEach(Sub(strLine As String)
If strLine.IndexOf("PrinterName:") > -1 Then
lstPrinters.Add(strLine.Substring(strLine.IndexOf("PrinterName:") + 13))
End If
End Sub)
Another one...
Dim TextSearch As String =
"PrinterName : PDFCreator()" + vbCrLf +
"PortName: PDFCreator()" + vbCrLf +
"Status: Unknown()" + vbCrLf +
"DriverName: PDFCreator()" + vbCrLf +
"PrinterName: Lexmark E360dn XL" + vbCrLf +
"PortName: someport()" + vbCrLf +
"Status: Unknown()" + vbCrLf +
"DriverName: Lexmark E360dn XL" + vbCrLf +
"HostAddress: somehostaddress()"
Dim printers As List(Of String) = TextSearch.Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries).Where(Function(x) x.ToLower.StartsWith("printername")).Select(Function(x) x.Split(":").Last).ToList
For Each printer As String In printers
Debug.Print(printer)
Next
This could also be written as:
Dim TextSearch As String =
"PrinterName : PDFCreator()" + vbCrLf +
"PortName: PDFCreator()" + vbCrLf +
"Status: Unknown()" + vbCrLf +
"DriverName: PDFCreator()" + vbCrLf +
"PrinterName: Lexmark E360dn XL" + vbCrLf +
"PortName: someport()" + vbCrLf +
"Status: Unknown()" + vbCrLf +
"DriverName: Lexmark E360dn XL" + vbCrLf +
"HostAddress: somehostaddress()"
Dim printers = From printer In TextSearch.Split(vbCrLf.ToCharArray)
Where printer.ToLower.StartsWith("printername")
Select printer.Split(":").Last
For Each printer As String In printers
Debug.Print(printer)
Next