how to Print arabic on ESC/POS printer - vb.net

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

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!

Error extracting images in powerpoint using shape.export and identifying paragraph format as bullets in VBA

I repurposed the code on MicrosoftPowerpointConverter - MoinMoin to work without the Microsoft Scripting Runtime.
I was able to generate a new file and export text to it, (I know that's the easy part), where I am getting stuck is in two places:
Formatting bullets:
Original code
' Check for bullets
If aShape.TextFrame.TextRange.ParagraphFormat.Bullet = msoTrue Then
outText = Replace(outText, Chr(10), " * ")
End If
My code
' Check for bullets
If oShape.TextFrame.TextRange.ParagraphFormat.Bullet.Type <> ppBulletNone Then
outText = Replace(outText, Chr(10), " * ")
End If
This doesn't work at all, and it totally ignores bullet formatting, but still outputs the content without the *
Exporting images:
Original Code
' Is it a picture or embedded object
If aShape.Type = msoPicture Or aShape.Type = msoEmbeddedOLEObject Or aShape.Type = msoLinkedPicture Or aShape.Type = msoGroup Then
aShape.Export outPath + "\image" + Trim(Str(i)) + Trim(Str(j)) + ".png", ppShapeFormatPNG
oFileStream.WriteLine (Chr(13) + "attachment:image" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(13))
End If
My code
' Is it a picture or embedded object
If oShape.Type = msoPicture Or oShape.Type = msoEmbeddedOLEObject Or oShape.Type = msoLinkedPicture Or oShape.Type = msoGroup Then
Dim imagepath
imagepath = oPres.Path & "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png"
oShape.Export imagepath, ppShapeFormatPNG
Print #iFile, (Chr(13) + "<img src=" + Chr(34) + "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(34) + ">" + Chr(13))
End If
This code throws up the following error in windows, and is totally ignored in Mac
Adding my complete code below:
Sub ExportToWiki()
' Iterators
Dim i As Integer
Dim j As Integer
' Pres, Slide, Shape
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide As Slide 'Slide Object
Dim oShp As Shape 'Shape Object
Dim iFile As Integer 'File handle for output
iFile = FreeFile 'Get a free file number
Dim PathSep As String
Dim FileNum As Integer
Set oPres = ActivePresentation
Set oSlides = oPres.Slides
FileNum = FreeFile
'Open output file
' NOTE: errors here if file hasn't been saved
Open oPres.Path & "/text.xml" For Output As FileNum
' File Handling
Dim outText As String
' Table exports
Dim row As Integer
Dim col As Integer
Dim cellText As String
' Select my ppt
' Write TOC
Print #iFile, ("[[TableOfContents]]")
' Loop through slides
For i = 1 To oPres.Slides.Count
Set oSlide = oPres.Slides(i)
' Loop through shapes
For j = 1 To oSlide.Shapes.Count
Set oShape = oSlide.Shapes(j)
' Is it a text frame?
If oShape.HasTextFrame Then
If oShape.TextFrame.HasText Then
outText = oShape.TextFrame.TextRange.Text
' Check for bullets
If oShape.TextFrame.TextRange.ParagraphFormat.Bullet.Type <> ppBulletNone Then
outText = Replace(outText, Chr(10), " * ")
End If
If j = 1 Then ' Assume first text is always the header
outText = "= " + outText + " ="
End If
Print #iFile, (outText + Chr(13) + "[[BR]]" + Chr(13))
End If
End If
' Is it a table?
If oShape.Type = msoTable Then
cellText = ""
For row = 1 To oShape.Table.Rows.Count
For col = 1 To oShape.Table.Columns.Count
If row = 1 Then
cellText = cellText + "||<class=" + Chr(34) + "tableheader" + Chr(34) + ">" + oShape.Table.Columns.Item(col).Cells(row).Shape.TextFrame.TextRange.Text
Else
cellText = cellText + "||" + oShape.Table.Columns.Item(col).Cells(row).Shape.TextFrame.TextRange.Text
End If
If col = oShape.Table.Columns.Count Then
cellText = cellText + "||" + Chr(13)
End If
Next col
Next row
Print #iFile, (Chr(13) + cellText + Chr(13))
End If
' Is it a picture or embedded object
If oShape.Type = msoPicture Or oShape.Type = msoEmbeddedOLEObject Or oShape.Type = msoLinkedPicture Or oShape.Type = msoGroup Then
Dim imagepath
imagepath = oPres.Path & "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png"
oShape.Export imagepath, ppShapeFormatPNG
Print #iFile, (Chr(13) + "<img src=" + Chr(34) + "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(34) + ">" + Chr(13))
End If
Next j
Next i
Close #iFile
End Sub
For the first part, I think you probably need to recursively check each paragraph within the TextRange as bullets can be set for the whole text range or specific paragraphs within it and if there is a mix, you'll get unexpected results. I also don't see why the replacement is being made for Char 10. I think you should be returning the text for the paragraphs where a bullet is found and prefixing it with your Wiki string. For example:
' Check for bullets
Dim p As Long
Dim para As String
With oShape.TextFrame.TextRange
For p = 1 To .Paragraphs.Count
If .Paragraphs(p).ParagraphFormat.Bullet.Type <> ppBulletNone Then
para = " * " & .Paragraphs(p).Text
Else
para = .Paragraphs(p).Text
End If
outText = outText & para
Next
End With
For the second point, I got the same error because the images sub folder didn't exist. Once I created it manually, the code ran on PC. For Mac, you'll need to use POSIX or AppleScript path syntax if I recall correctly, for example:
#If Mac Then
Public Const PathSeparator = ":"
#Else
Public Const PathSeparator = "\"
#End If
However, if you're using PowerPoint:mac 2016 then things are more complicated due to its sandboxed environment. Check this article for more info:
http://www.rondebruin.nl/mac/mac034.htm

Loop through file extensions

Try
Dim lImage As Image = Image.FromFile(appPath + "\" + "ActiveDisplay" + "\" + "Helmets" + "\" + vData + **"extension loop need"**)
ResizePicture(Me.PictureBox1, lImage)
Catch ex As Exception
End Try
I'm searching for a image name in viewer and need to loop through extensions
any help would be appreciated
You can use a String array and a For Each
Dim extensions As String() = {".png", ".jpg", ".bmp"}
For Each ext As String In extensions
Dim file As String = appPath + "\" + "ActiveDisplay" + "\" + "Helmets" + "\" + vData + ext
'I recomend use: Dim file As String= String.Format("{0}\ActiveDisplay\Helmets\{1}\{2}", appPath, vData, ext)
If IO.File.Exists(file) Then
Dim lImage As Image = Image.FromFile(file)
End If
Next

Faster HTTPWEBREQUEST/WEBRESPONSE - Too Slow

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

Remove blank lines at the end of a file

I am trying to remove the blank lines at the end of a text file. The program takes a file, manipulates it and produces another file. However, there's blank lines at the end of the file that I need to get rid of...
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
' Save to desktop if nothing is selected
If txtDestLoc.Text = "" Then
txtDestLoc.Text = "C:\Documents and Settings\" & LCase(Environment.UserName) & "\desktop"
End If
If txtFileLoc.Text <> "" Then
Dim fsr As New FileStream(txtFileLoc.Text, FileMode.Open)
Dim sr As New StreamReader(fsr)
Dim sb As New System.Text.StringBuilder
'Dim strHeader As String
' Get just file name
Dim strFileName = Me.OpenFileDialog1.FileName()
Dim fnPeices() As String = strFileName.Split("\")
Dim fileName As String = ""
fileName = "CCCPositivePay.txt"
Dim strOutFile As String = txtDestLoc.Text & "\" & fileName
Dim fsw As New FileStream(strOutFile, FileMode.Create, FileAccess.Write)
Dim w As New StreamWriter(fsw)
Dim i As Double
Dim srRow As String
Dim strW As String
Dim strDate As String
Dim strAmt As String
Dim strChNo As String
Dim strName As String
Dim strAddInfo As String
Dim strCustAcct As String
Dim totamt As Double = 0
Dim strAcct As String = "2000002297330"
strLoc = txtDestLoc.Text()
srRow = ""
Do While sr.Peek() <> -1
srRow = srRow.ToString & sr.ReadLine()
If srRow.Length = 133 Then
If srRow.Substring(131, 2) = "CR" Then
strCustAcct = srRow.Substring(2, 18).Replace("-", "")
strName = srRow.Substring(23, 35)
strAddInfo = srRow.Substring(23, 30)
strDate = srRow.Substring(103, 4) + srRow.Substring(97, 2) + srRow.Substring(100, 2)
strChNo = srRow.Substring(110, 10)
strAmt = strip(srRow.Substring(121, 10))
strW = strAcct + strChNo.Trim.PadLeft(10, "0") + strAmt.Trim.PadLeft(10, "0") + strDate + " " + strAddInfo + Space(8) + strName + Space(20)
sb.AppendLine(strW)
totamt = totamt + CDbl(strAmt)
i = i + 1
End If
End If
srRow = ("")
Loop
'w.WriteLine(strHeader)
w.WriteLine(sb.ToString)
Dim file As String = txtFileLoc.Text
Dim path As String = txtFileLoc.Text.Substring(0, File.lastindexof("\"))
Dim strFileProcessed As String
strFileProcessed = fnPeices(fnPeices.Length - 1)
Label1.Text = "Refund File Processed: " & strFileProcessed
Label2.Text = "File saved to: " & strOutFile
' Close everything
w.Close()
sr.Close()
fsw.Close()
fsr.Close()
' Move file after processing
System.IO.File.Move(file, path + "\CB008_Processed\" + Now.ToString("MMddyyyyHHmm") + strFileProcessed)
' Put a copy of the results in "Processed" folder
System.IO.File.Copy(strOutFile, path + "\CB008_Processed\" + Now.ToString("MMddyyyyHHmm") + fileName)
Else
MessageBox.Show("Please select a Refund file to process.", "CCC Refund File", MessageBoxButtons.OK)
End If
End Sub
Public Function strip(ByVal des As String)
Dim strorigFileName As String
Dim intCounter As Integer
Dim arrSpecialChar() As String = {".", ",", "<", ">", ":", "?", """", "/", "{", "[", "}", "]", "`", "~", "!", "#", "#", "$", "%", "^", "&", "*", "(", ")", "_", "-", "+", "=", "|", " ", "\"}
strorigFileName = des
intCounter = 0
Dim i As Integer
For i = 0 To arrSpecialChar.Length - 1
Do Until intCounter = 29
des = Replace(strorigFileName, arrSpecialChar(i), "")
intCounter = intCounter + 1
strorigFileName = des
Loop
intCounter = 0
Next
Return strorigFileName
End Function
Only do a Writeline if Not String.IsNullOrEmpty(sb)