Good Day,
I'm using visualstudio2019, and I have function like this:
Sub doQR()
Dim SallerName As String = gethexstring(1, "Bobs Records")
Dim VATReg As String = gethexstring(2, "310122393500003")
Dim DateTimeStr As String = gethexstring(3, "2022-04-25T15:30:00Z")
Dim TotalAmt As String = gethexstring(4, "10000.00")
Dim VatAmt As String = gethexstring(5, "150.00")
Dim decString As String = SallerName & VATReg & DateTimeStr & TotalAmt & VatAmt
Console.WriteLine(decString)
Console.WriteLine(HexToBase64(decString))
Console.Read()
End Sub
I want to show the output in a textbox (output.text)
Thanks,
Try this:
Sub doQR()
Dim SallerName As String = gethexstring(1, "Bobs Records")
Dim VATReg As String = gethexstring(2, "310122393500003")
Dim DateTimeStr As String = gethexstring(3, "2022-04-25T15:30:00Z")
Dim TotalAmt As String = gethexstring(4, "10000.00")
Dim VatAmt As String = gethexstring(5, "150.00")
Dim decString As String = SallerName & VATReg & DateTimeStr & TotalAmt & VatAmt
Console.WriteLine(decString)
Console.WriteLine(HexToBase64(decString))
Console.Read()
output.text = HexToBase64(decString)
End Sub
Or if you want to just show decString, then replace this line:
output.text = HexToBase64(decString)
With:
output.text = decString
Put it in a TextBox
Sub doQR()
Dim SallerName As String = gethexstring(1, "Bobs Records")
Dim VATReg As String = gethexstring(2, "310122393500003")
Dim DateTimeStr As String = gethexstring(3, "2022-04-25T15:30:00Z")
Dim TotalAmt As String = gethexstring(4, "10000.00")
Dim VatAmt As String = gethexstring(5, "150.00")
Dim decString As String = SallerName & VATReg & DateTimeStr & TotalAmt & VatAmt
Console.WriteLine(decString)
Console.WriteLine(HexToBase64(decString))
Console.Read()
' do this
TextBox1.Text = decString
End Sub
Related
I am working on some application to download files of stock prices for different dates from url. I am using the following code
Conn = New OdbcConnection("DSN=RA;MultipleActiveResultSets=True")
If Conn.State = ConnectionState.Closed Then
Conn.Open()
End If
Dim mont As Date
mont = DateTimePicker1.Value
Dim dnldurlA As String = "http://www.nseindia.com/content/historical/EQUITIES/"
Dim dnldurlB As String = UCase(mont.ToString("MMM"))
Dim dnldurlC As String = "/"
Dim dnldurlD As String = "cm"
Dim dnldurlE As String = mont.ToString("dd")
Dim dnldurlF As String = mont.ToString("yyyy")
Dim dnldurlG As String = "bhav"
Dim dnldurlH As String = ".csv"
Dim dnldurlI As String = ".zip"
Dim dnldurlJ As String = "\"
Dim FileName As String = dnldurlE & dnldurlB & dnldurlF & ".ZIP"
Try
Dim downloadClient As New WebClient()
downloadClient.Headers("Accept") = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
downloadClient.Headers("User-Agent") = "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.1 (KHTML, like Gecko) Chrome/21.0.1180.83 Safari/537.1"
Dim dnldurl As String = dnldurlA & dnldurlF & dnldurlC & dnldurlB & dnldurlC & dnldurlD & dnldurlE & dnldurlB & dnldurlF & dnldurlG & dnldurlH & dnldurlI
downloadClient.DownloadFile(New Uri(dnldurl), ("C:\" & FileName))
While (downloadClient.IsBusy = True)
End While
downloadClient.Dispose()
Catch ex As Exception
MsgBox("File can not be downloaded!!!")
Me.Close()
End Try
I am stuck with after downloading the first file, when I selected the file for another date, it throws an error
{"The remote server returned an error: (403) Forbidden."}
But when I exit the application and try again for the same date, the file is downloaded promptly.
Please help
Thanks in advance
Kris
I just made a small change and it worked perfectly
Conn = New OdbcConnection("DSN=RA;MultipleActiveResultSets=True")
If Conn.State = ConnectionState.Closed Then
Conn.Open()
End If
Dim mont As Date
mont = DateTimePicker1.Value
Dim dnldurlA As String = "http://www.nseindia.com/content/historical/EQUITIES/"
Dim dnldurlB As String = UCase(mont.ToString("MMM"))
Dim dnldurlC As String = "/"
Dim dnldurlD As String = "cm"
Dim dnldurlE As String = mont.ToString("dd")
Dim dnldurlF As String = mont.ToString("yyyy")
Dim dnldurlG As String = "bhav"
Dim dnldurlH As String = ".csv"
Dim dnldurlI As String = ".zip"
Dim dnldurlJ As String = "\"
Dim FileName As String = dnldurlE & dnldurlB & dnldurlF & ".ZIP"
Try
Dim downloadClient As New WebClient()
Dim dnldurl As String = dnldurlA & dnldurlF & dnldurlC & dnldurlB & dnldurlC & dnldurlD & dnldurlE & dnldurlB & dnldurlF & dnldurlG & dnldurlH & dnldurlI
downloadClient.DownloadFile(New Uri(dnldurl), ("C:\" & FileName))
While (downloadClient.IsBusy = True)
End While
downloadClient.Dispose()
Catch ex As Exception
MsgBox("File can not be downloaded!!!")
Me.Close()
End Try
Thanks
I want to develop a print system for check a daily list of documents to print and do it every hour.
Until now I could print one document but when the time has come to print more the code only works for the first.
Sub printTag()
Dim strCommand As String
Dim filePath As String
Dim FileName As String
Dim printer As String
Dim numRefs As Integer
Dim x As Integer
Dim ref As String
Dim numFiles As Integer
Dim t As Integer
Dim difD As Long
Dim difH As Long
Dim difM As Long
Dim listDate As Date
Dim nowDate As Date
nowDate = ThisWorkbook.Sheets("Print").Range("B8")
printer = ThisWorkbook.Sheets("Print").Range("B2")
numRefs = WorksheetFunction.CountA(ThisWorkbook.Sheets("List").Columns("A"))
numFiles = WorksheetFunction.CountA(ThisWorkbook.Sheets("Relation").Columns("A"))
For x = 1 To numRefs
On Error Resume Next
listDate = ThisWorkbook.Sheets("List").Range("A" & x)
difD = DateDiff("d", nowDate, listDate)
If difD = 0 Then
difH = DateDiff("h", nowDate, listDate)
difM = DateDiff("n", nowDate, listDate)
If difH = 0 Then
If difM >= 0 Then
For t = 1 To numFiles
If ThisWorkbook.Sheets("List").Range("B" & x) = ThisWorkbook.Sheets("Relation").Range("A" & t) Then
filePath = ThisWorkbook.Sheets("Print").Range("B1") & "\" & ThisWorkbook.Sheets("Relation").Range("B" & t)
ThisWorkbook.Sheets("Print").Range("B3") = strCommand
strCommand = "PRINT " & filePath & "/D:" & printer
Shell strCommand, 1
End If
Next t
End If
End If
End If
Next x
End Sub
I'd got the idea to create a script instead send multiples instances in command line and works perfectly. This is the result:
Sub printTag()
Dim strCommand As String
Dim filePath As String
Dim FileName As String
Dim printer As String
Dim numRefs As Integer
Dim x As Integer
Dim ref As String
Dim numFiles As Integer
Dim t As Integer
Dim difD As Long
Dim difH As Long
Dim difM As Long
Dim listDate As Date
Dim nowDate As Date
nowDate = ThisWorkbook.Sheets("Print").Range("B8")
printer = ThisWorkbook.Sheets("Print").Range("B2")
numRefs = WorksheetFunction.CountA(ThisWorkbook.Sheets("List").Columns("A"))
numFiles = WorksheetFunction.CountA(ThisWorkbook.Sheets("Relation").Columns("A"))
If Len(Dir$(ThisWorkbook.Path & "\list.bat")) > 0 Then
Kill ThisWorkbook.Path & "\list.bat"
End If
intFile = FreeFile()
Open ThisWorkbook.Path & "\list.bat" For Output As #intFile
For x = 1 To numRefs
On Error Resume Next
listDate = ThisWorkbook.Sheets("List").Range("A" & x)
difD = DateDiff("d", nowDate, listDate)
If difD = 0 Then
difH = DateDiff("h", nowDate, listDate)
difM = DateDiff("n", nowDate, listDate)
If difH = 0 Then
If difM >= 0 Then
For t = 1 To numFiles
If ThisWorkbook.Sheets("List").Range("B" & x) = ThisWorkbook.Sheets("Relation").Range("A" & t) Then
filePath = ThisWorkbook.Sheets("Print").Range("B1") & "\" & ThisWorkbook.Sheets("Relation").Range("B" & t)
Print #intFile, "PRINT " & filePath & " /D:" & printer
End If
Next t
End If
End If
End If
Next x
Print #intFile, "exit"
Close #intFile
End Sub
This program has a "fl" variable that at a specific point, gets changed to file(0), the first line of the read file. I want to run some stuff when "fl" IS NOT EQUAL to "file(0)". I'm making this for the 1st of April. I'm not the best at this, so I figured to start this early. (CTRL + F for THIS_LINE if you want to find the line that I suppose doesn't work.)
Imports System
Imports System.IO
Imports System.Collections
Public Class Form1
Private Property fl As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Opacity = 0
start.Enabled = True
End Sub
Private Sub start_Tick(sender As Object, e As EventArgs) Handles start.Tick
main()
start.Enabled = False
End Sub
Private Sub main()
' Preparations
start.Enabled = False
Me.Hide()
Dim stopval As Integer = 0
Dim failcount As Integer = 0
If Directory.Exists(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb") = False Then
My.Computer.FileSystem.CreateDirectory(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\")
End If
If File.Exists(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\v.txt") Then
My.Computer.FileSystem.DeleteFile(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\v.txt")
End If
Dim fl As String = "asd"
' Actual stuff that needs to happen
dlfile.Enabled = True
End Sub
Private Sub dlfile_Tick(sender As Object, e As EventArgs) Handles dlfile.Tick
Try
My.Computer.Network.DownloadFile("http://sth.sth/v.txt", My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\v.txt")
Catch ex As Exception
MsgBox("fail")
Dim asd As Integer = 0
End Try
dlsuc()
End Sub
Private Sub dlsuc()
Dim x As Integer = 0
Threading.Thread.Sleep(3000)
Dim file_ As String = My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\v.txt"
Dim file As String() = IO.File.ReadAllLines(file_)
Dim firstline As String = file(0)
Dim secondline As String = file(1)
If fl IsNot file(0) Then 'THIS_LINE
' Executing the command
If secondline = "command" Then
Dim file_name As String = My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\asdt.bat"
Dim i As Integer
Dim aryText(3) As String
aryText(0) = "#echo off"
aryText(1) = "cls"
aryText(2) = file(2)
aryText(3) = "pause"
Dim objWriter As New System.IO.StreamWriter(file_name)
For i = 0 To 3
objWriter.WriteLine(aryText(i))
Next
objWriter.Close()
Process.Start(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\asdt.bat")
Threading.Thread.Sleep(500)
Do Until x > 49
Try
My.Computer.FileSystem.DeleteFile(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\asdt.bat")
Catch ex As Exception
Dim xyz As String = Nothing
End Try
x = x + 1
Loop
End If
If secondline = "download" Then
Dim filename As String = file(3)
My.Computer.Network.DownloadFile(file(2), My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\" & filename)
End If
If secondline = "downloadr" Then
Dim filename As String = file(3)
My.Computer.Network.DownloadFile(file(2), My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\" & filename)
Process.Start(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\" & filename)
End If
End If
' After executing the given command
fl = file(0)
Threading.Thread.Sleep(500)
My.Computer.FileSystem.DeleteFile(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\v.txt")
file_ = Nothing
file = Nothing
firstline = Nothing
secondline = Nothing
End Sub
End Class
Update:
Also, do you know why doesn't this work? I trid it with them in one if too:
If Not fl.Equals(file(0)) Or Not fl.Equals("000") Then
End If
But it's not working
Private Sub dlsuc()
Dim x As Integer = 0
Threading.Thread.Sleep(3000)
Dim file_ As String = My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\v.txt"
Dim file As String() = IO.File.ReadAllLines(file_)
Dim firstline As String = file(0)
Dim secondline As String = file(1)
If Not fl.Equals(file(0)) Then 'THIS_LINE
If Not fl = "000" Then
' Executing the command
If secondline = "command" Then
Dim file_name As String = My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\asdt.bat"
Dim i As Integer
Dim aryText(3) As String
aryText(0) = "#echo off"
aryText(1) = "cls"
aryText(2) = file(2)
aryText(3) = "pause"
Dim objWriter As New System.IO.StreamWriter(file_name)
For i = 0 To 3
objWriter.WriteLine(aryText(i))
Next
objWriter.Close()
Process.Start(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\asdt.bat")
Threading.Thread.Sleep(500)
Do Until x > 49
Try
My.Computer.FileSystem.DeleteFile(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\asdt.bat")
Catch ex As Exception
Dim xyz As String = Nothing
End Try
x = x + 1
Loop
End If
If secondline = "download" Then
Dim filename As String = file(3)
My.Computer.Network.DownloadFile(file(2), My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\" & filename)
End If
If secondline = "downloadr" Then
Dim filename As String = file(3)
My.Computer.Network.DownloadFile(file(2), My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\" & filename)
Process.Start(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\" & filename)
End If
End If
End If
' After executing the given command
fl = file(0)
Threading.Thread.Sleep(500)
My.Computer.FileSystem.DeleteFile(My.Computer.FileSystem.SpecialDirectories.Temp & "\hb\v.txt")
file_ = Nothing
file = Nothing
firstline = Nothing
secondline = Nothing
End Sub
Then change this
If fl IsNot file(0) Then 'THIS_LINE
to
If Not fl.Equals(file(0)) Then 'THIS_LINE
Side note:
You have declared fl twice, so if that was not intended, change this
Dim fl As String = "asd"`
to this
fl = "asd"
I want to change something on a compiled game file, so I used this code:
Private Sub Next2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Next2.Click
Dim reader As New System.IO.StreamReader("Languages/" & Language & ".Devil")
Dim allLines As List(Of String) = New List(Of String)
Do While Not reader.EndOfStream
allLines.Add(reader.ReadLine())
Loop
reader.Close()
Tips.Text = ReadLine(6, allLines)
WeaponsListBox.Hide()
NewWeaponsList.Hide()
Next2.Hide()
Dim curItem As String = WeaponsListBox.SelectedItem.ToString()
Dim curItem2 As String = NewWeaponsList.SelectedItem.ToString()
Try
If MainWeapon = "Cheytac" Then
Dim supahotfire As String = curItem.Substring(0, 12)
Dim hotdestroyer As String = curItem.Replace(supahotfire, "")
Dim supa2 As String = curItem2.Substring(0, 12)
Dim hot2 As String = curItem2.Replace(supa2, "")
Dim oldfile As String = "pack/Weapon_" & curItem & ".i3pack"
Dim FileName As String = "pack/pack_" & MainWeapon & hot2 & "_" & hotdestroyer & ".i3pack"
Dim be = My.Computer.FileSystem.ReadAllBytes(oldfile)
Dim be2 As String = UnicodeBytesToString(be)
be2.Replace("Weapon\" & curItem & "/" & curItem & "_diff", "Weapon\" & curItem2 & "/" & curItem2 & "_diff")
Dim be3 As String = be2.Replace("Weapon\" & curItem & "/Cheytac_M200_Diff.i3i", "Weapon\" & curItem2 & "/Cheytac_M200_Diff.i3i")
Dim be4 = UnicodeStringToBytes(be3)
My.Computer.FileSystem.WriteAllBytes(FileName, be4, True)
'System.IO.File.AppendAllText(FileName, be4)
' Dim fs As FileStream = New FileStream(oldfile, FileMode.Open)
' Dim br As BinaryReader = New BinaryReader(fs)
'Dim bin as byte[]= br.ReadBytes(Convert.ToInt32(fs.Length));
' fs.Close()
'br.Close()
End If
Catch ex As Exception
System.IO.File.AppendAllText("MathimaticalErrors.txt", ex.ToString)
End Try
End Sub
Public Function UnicodeBytesToString(ByVal bytes() As Byte) As String
Return System.Text.Encoding.Unicode.GetString(bytes)
End Function
Public Function UnicodeStringToBytes(ByVal str As String) As Byte()
Return System.Text.Encoding.Unicode.GetBytes(str)
End Function
The problem is that the newly created file is basically the same as the old file, and nothing has changed on it. How can I solve this?
At this point in your code:
Dim be2 As String = UnicodeBytesToString(be)
be2.Replace("Weapon\" & curItem & "/" & curItem & "_diff", "Weapon\" & curItem2 & "/" & curItem2 & "_diff")
The value in be2 would remain unchanged. You have to store the return value of Replace():
Dim be2 As String = UnicodeBytesToString(be)
be2 = be2.Replace("Weapon\" & curItem & "/" & curItem & "_diff", "Weapon\" & curItem2 & "/" & curItem2 & "_diff")
Also, at this line:
My.Computer.FileSystem.WriteAllBytes(FileName, be4, True)
The True at the end means you want to append the bytes. If the file is empty this will be fine. If not, then you'll end up adding the bytes to the end of the file each time. Not sure if that is your intended result...
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)