Public Function GetMetaDataFromPIC(ByVal _imgpath As String) As String
Dim fname As String
Dim RichTextBox1 As New RichTextBox
Dim myStreamReader As System.IO.StreamReader
Dim OneLine As String
Dim ffmpeg As Process
Dim Fi As FileInfo
Try
Application.DoEvents()
Fi = New FileInfo(_imgpath)
'fcreated_date = Fi.LastWriteTime.ToShortDateString
fname = _imgpath
ffmpeg = New Process
ffmpeg.StartInfo.WindowStyle = ProcessWindowStyle.Normal
ffmpeg.StartInfo.FileName = """" & Application.StartupPath & "\exiftool.exe"""
ffmpeg.StartInfo.UseShellExecute = False
ffmpeg.StartInfo.RedirectStandardError = True
ffmpeg.StartInfo.RedirectStandardOutput = True
ffmpeg.StartInfo.CreateNoWindow = True
'ffmpeg.StartInfo.Arguments = "-verbose & """ & _imgpath & """ "
ffmpeg.StartInfo.Arguments = " & """ & _imgpath & """ "
ffmpeg.Start()
RichTextBox1.Text = ""
myStreamReader = ffmpeg.StandardOutput
Dim i As Integer = 0
OneLine = myStreamReader.ReadLine()
Do
' Application.DoEvents()
i = i + 1
RichTextBox1.AppendText(OneLine + System.Environment.NewLine)
OneLine = myStreamReader.ReadLine()
If i > 200 Then Exit Do
Loop Until ffmpeg.HasExited And (OneLine Is Nothing)
If RichTextBox1.Text <> "" Then
GetMetaDataFromPIC = RichTextBox1.Text
Else
GetMetaDataFromPIC = ""
End If
myStreamReader.Close()
Catch ex As Exception
Write_ErrorLog(ex.Message & vbTab & "GetMetaDataFromPIC of " & _imgpath)
GetMetaDataFromPIC = ""
Finally
End Try
End Function
this is the code i am using to find metadata of image but everyday once in night i get this Error Creating Windows Handles error and it crash my application.
Related
I have a Sub that reads a file that was created in another Sub. I'm getting an error
Can't access file in use in other process
From what I've read on the net I need to close the StreamReader. I've tried to use .close() on different variables, but nothing seems to work.
Below is the code that writes the file the other Sub then accesses.
Private Sub CreateGraphicsFunction(sender As Object, e As EventArgs)
Dim Regex = New Regex("infoEntityIdent=""(ICN.+?)[""].*?[>]")
strGraphicFile = MoveLocation & "\ICN-LIST.txt"
Dim ICNFiles = Directory.EnumerateFiles(MovePath, "*.*", SearchOption.AllDirectories)
For Each tFile In ICNFiles
Dim input = File.ReadAllText(tFile)
Dim match = Regex.Match(input)
If match.Success Then
output.Add(match.Groups(1).Value)
End If
Next
File.WriteAllLines(strGraphicFile, output)
locationGraphicsLog = strGraphicFile
End Sub
The other Sub that reads the file created
Private Sub btnFindICN_Click(sender As Object, e As EventArgs) Handles btnFindICN.Click
Application.UseWaitCursor = True
Application.DoEvents()
Me.Refresh()
Dim sGraphicFilesToFind As String
Dim graphicLocation As String
'MoveWithPath As String
Dim graphicFile As String
graphicLocation = txtSearchICN.Text
MoveLocation = MovePath
graphicLogFile = MoveLocation & "\Reports\1-OrphanedFilesItems.txt"
Dim FILE_NAME As String
FILE_NAME = MoveLocation & "\ICN-LIST.txt"
Dim objReader As New System.IO.StreamReader(FILE_NAME)
Dim sGraphicFile As String
Do While objReader.Peek() <> -1
graphicFile = objReader.ReadLine()
sGraphicFilesToFind = graphicLocation & "\" & graphicFile & "*.*"
sGraphicFile = graphicFile
Dim createGraphicReportFldr As String
Dim paths() As String = IO.Directory.GetFiles(graphicLocation, sGraphicFile, IO.SearchOption.AllDirectories)
If paths.Count = 0 Then
'Debug.Print(graphicFile)
If System.IO.File.Exists(graphicLogFile) = True Then
Dim objWriter As New System.IO.StreamWriter(graphicLogFile, IO.FileMode.Append)
objWriter.WriteLine(graphicFile)
objWriter.Close()
Else
'MsgBox("Creating Orphaned graphicFile Now. ")
createGraphicReportFldr = MoveLocation & "\Reports"
If Not IO.Directory.Exists(createGraphicReportFldr) Then
IO.Directory.CreateDirectory(createGraphicReportFldr)
'MsgBox("folder created" & createGraphicReportFldr)
Dim writeFile As IO.StreamWriter
writeFile = IO.File.CreateText(graphicLogFile)
writeFile.Write(graphicFile & vbCrLf)
writeFile.Close()
Else
'MsgBox("Folder already exist")
End If
End If
Else
For Each pathAndFileName As String In paths
Dim createGraphicsFolder As String
'Dim moveFileToNewFolder As String
If System.IO.File.Exists(pathAndFileName) = True Then
Dim sRegLast As String = pathAndFileName.Substring(pathAndFileName.LastIndexOf("\") + 1)
Dim toGraphiicFileLocation As String
'MsgBox("sRegLast " & sRegLast)
fileGraphicLoc = MoveLocation & sRegLast
createGraphicsFolder = MoveLocation & "\Figures"
moveGraphicFileToNewFolder = MoveLocation & "\Figures\" & sRegLast
toGraphiicFileLocation = createGraphicsFolder & "\" & sRegLast
'MsgBox("FileLoc " & fileLoc)
If Not IO.Directory.Exists(createGraphicsFolder) Then
IO.Directory.CreateDirectory(createGraphicsFolder)
' MsgBox("folder created" & createGraphicsFolder)
End If
If System.IO.File.Exists(fileGraphicLoc) = False Then
System.IO.File.Copy(pathAndFileName, moveGraphicFileToNewFolder)
Debug.Write("Graphics moved to : " & moveGraphicFileToNewFolder & vbCrLf)
End If
End If
Next
End If
Loop
'MsgBox("graphicFiles have been moved")
Call CreateGraphicsFunction(Nothing, System.EventArgs.Empty)
Application.UseWaitCursor = False
Application.DoEvents()
' Me.Close()
End Sub
In the "other Sub", change
Dim objReader As New System.IO.StreamReader(FILE_NAME)
to
Using objReader = New System.IO.StreamReader(FILE_NAME)
and add End Using where you are done with it. Probably right after Loop. This will ensure that the disposable stream is always disposed.
See Using Statement (Visual Basic). You almost always want to wrap an IDisposable object in a Using block if you are able to restrict its scope to a single method.
I'm currently writing a GUI for xmr-stak (www.xmrgui.com)
Having some trouble getting the output from the program and basically want to grab the last 30 lines from the output text file and append them to the RichTextBox if they don't already exist. Storing the text file in memory isn't a big issue because it will be deleted every 20 min or so...at least so I think. Maybe my function is taking up too much memory or time as it is.
My only requirement is that the Sub TimerOutput_tick can process each of the 30 last lines of text from the file to run a regex on each line and that the RichTextBox does not repeat old information.
Heres my code:
Private Function getlastlines(filename As String, numberOfLines As Integer) As Dictionary(Of Integer, String)
Try
Dim fs = File.Open(filename, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim reader As StreamReader = New StreamReader(fs)
Dim everything As New Dictionary(Of Integer, String)
Dim n As Integer = 1
While reader.Peek > -1
Dim line = reader.ReadLine()
If everything.ContainsKey(n) Then
everything(n) = line
n += 1
Else
everything.Add(n, line)
n += 1
End If
End While
Dim results As New Dictionary(Of Integer, String)
Dim z As Integer = 1
If n - numberOfLines > 0 Then
For x As Integer = n - numberOfLines To n - 1
'MsgBox(everything.Count - numberOfLines)
If results.ContainsKey(z) Then
results(z) = everything(x)
z += 1
Else
results.Add(z, everything(x))
z += 1
End If
Next
End If
Return results
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Function
' GRABS XMR-STAK OUTPUT FROM ReadLastLinesFromFile AND RUNS A REGEX ON THE HASHRATE TO PROVIDE VALUES TO THE CHART
And here is the Sub that calls the previous function:
Private Sub timeroutput_Tick(sender As Object, e As EventArgs) Handles timeroutput.Tick
'Try
Dim lateststring = getlastlines(xmroutput, 30)
Try
If lateststring IsNot rtlateststring Then
Dim kvp As KeyValuePair(Of Integer, String)
For Each kvp In lateststring
If lateststring.ContainsKey(kvp.Key) Then
Dim line = kvp.Value
RichTextBox1.AppendText(line & vbCrLf)
If line.Contains("Totals") Then ' Should be "Totals"
'Dim regex As Regex = New Regex("\d+?.\d+")
Dim regex As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim ret = regex.Match(line).Value
If ret <> "" Then
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " " & ret & " H/s"
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & ret & " H/s"
Else
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & "Initializing..."
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " Initializing..."
ret = "0.0"
End If
'Dim match As Match = regex.Match(lastline)
newhashrate = Convert.ToDouble(ret)
ElseIf line.Contains("NVIDIA") Then
Dim regexnv As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retnv = regexnv.Match(line).Value
newNVhashRate = Convert.ToDouble(retnv)
If firstNV = False Then
newser.Add(nvidiacard1)
nvidiacard1.Title = "NIVIDIA Hashrate(H/s)"
nvidiacard1.Values = nvidiavalues
nvidiavalues.add(0)
nvidiavalues.add(4)
nvidiavalues.add(2)
nvidiavalues.add(5)
firstNV = True
End If
ElseIf line.Contains("AMD") Then
Dim regexAMD As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retAMD = regexAMD.Match(line).Value
newAMDhashrate = Convert.ToDouble(retAMD)
If firstAMD = False Then
newser.Add(AMDCard1)
AMDCard1.Title = "AMD Hashrate(H/s)"
AMDCard1.Values = AMDValues
AMDValues.add(0)
AMDValues.add(4)
AMDValues.add(2)
AMDValues.add(5)
firstAMD = True
End If
End If
' Now if a GPU exists, add a new lineseries for CPU
If firstAMD = True Or firstNV = True Then
If firstCPU = False Then
newser.Add(CPU1)
CPU1.Title = "CPU Hashrate(H/s)"
CPU1.Values = CPUValues
CPUValues.add(0)
CPUValues.add(4)
CPUValues.add(2)
CPUValues.add(5)
firstCPU = True
End If
newCPUhashrate = newhashrate - newNVhashRate - newAMDhashrate
End If
rtlateststring = lateststring
End If
Next
RichTextBox1.SelectionStart = RichTextBox1.Text.Length
End If
Catch
End Try
End Sub
I've found a much easier solution, running the code within one function and then loading the entire text file into the richtextbox. From there its much easier to read the last ten lines individually:
Private Sub timeroutput_Tick(sender As Object, e As EventArgs) Handles timeroutput.Tick
Try
'Dim lateststring = getlastlines(xmroutput, 30)
' START NEW TEST
Dim fs = File.Open(xmroutput, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim reader As StreamReader = New StreamReader(fs)
Dim wholefile = reader.ReadToEnd
RichTextBox1.Text = wholefile
RichTextBox1.SelectionStart = RichTextBox1.Text.Length
For x As Integer = 1 To 10
Dim line As String = RichTextBox1.Lines(RichTextBox1.Lines.Length - x)
If line.Contains("Totals") Then ' Should be "Totals"
'Dim regex As Regex = New Regex("\d+?.\d+")
Dim regex As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim ret = regex.Match(line).Value
If ret <> "" Then
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " " & ret & " H/s"
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & ret & " H/s"
Else
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & "Initializing..."
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " Initializing..."
ret = "0.0"
End If
'Dim match As Match = regex.Match(lastline)
newhashrate = Convert.ToDouble(ret)
ElseIf line.Contains("NVIDIA") Then
Dim regexnv As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retnv = regexnv.Match(line).Value
newNVhashRate = Convert.ToDouble(retnv)
If firstNV = False Then
newser.Add(nvidiacard1)
nvidiacard1.Title = "NIVIDIA Hashrate(H/s)"
nvidiacard1.Values = nvidiavalues
For Each z In Chartvalues
Chartvalues.remove(z)
Next
nvidiavalues.add(0)
firstNV = True
End If
ElseIf line.Contains("AMD") Then
Dim regexAMD As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retAMD = regexAMD.Match(line).Value
newAMDhashrate = Convert.ToDouble(retAMD)
If firstAMD = False Then
newser.Add(AMDCard1)
AMDCard1.Title = "AMD Hashrate(H/s)"
AMDCard1.Values = AMDValues
For Each z In Chartvalues
Chartvalues.remove(z)
Next
AMDValues.add(0)
firstAMD = True
End If
End If
' Now if a GPU exists, add a new lineseries for CPU
If firstAMD = True Or firstNV = True Then
If firstCPU = False Then
newser.Add(CPU1)
CPU1.Title = "CPU Hashrate(H/s)"
CPU1.Values = CPUValues
For Each z In Chartvalues
Chartvalues.remove(z)
Next
CPUValues.add(0)
Chartvalues.add(0)
firstCPU = True
End If
newCPUhashrate = newhashrate - newNVhashRate - newAMDhashrate
End If
Next
Catch
End Try
' END NEW TEST
End Sub
This is my first vb.net program, so please bear with me if my question is very mediocre.
Before mentioning my problem, the mechanism of my accounting program is that if the user would input data into the datagridview and export it, so that when he restarts the program, he can import the exported data.
I have imported this .csv file to my datagridview
The problem is that when I have imported it, only column texts would appear like this.
This is the export code that I have used to create the .csv file.
Private Sub ExportToExcelToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ExportToExcelToolStripMenuItem.Click
Dim msg1 = "Export Successful"
Dim title = "Excel Export"
MsgBox(msg1, , title)
Try
Dim iexport1 As String = ""
Dim eexport1 As String = ""
For Each C As DataGridViewColumn In Income.Columns
iexport1 &= """" & C.HeaderText & ""","
Next
iexport1 = iexport1.Substring(0, iexport1.Length - 1)
iexport1 &= Environment.NewLine
For Each R As DataGridViewRow In Income.Rows
For Each C As DataGridViewCell In R.Cells
If Not C.Value Is Nothing Then
iexport1 &= """" & C.Value.ToString & ""","
Else
iexport1 &= """" & "" & ""","
End If
Next
iexport1 = iexport1.Substring(0, iexport1.Length - 1)
iexport1 &= Environment.NewLine
Next
For Each C As DataGridViewColumn In Expense.Columns
eexport1 &= """" & C.HeaderText & ""","
Next
eexport1 = eexport1.Substring(0, eexport1.Length - 1)
eexport1 &= Environment.NewLine
For Each R As DataGridViewRow In Expense.Rows
For Each C As DataGridViewCell In R.Cells
If Not C.Value Is Nothing Then
eexport1 &= """" & C.Value.ToString & ""","
Else
eexport1 &= """" & "" & ""","
End If
Next
eexport1 = eexport1.Substring(0, eexport1.Length - 1)
eexport1 &= Environment.NewLine
Next
Dim tw As IO.TextWriter = New IO.StreamWriter(path:="C:\Users\S2009516\Desktop\JanuaryIncome.CSV")
tw.Write(iexport1)
tw.Close()
Dim tw2 As IO.TextWriter = New IO.StreamWriter(path:="C:\Users\S2009516\Desktop\JanuaryExpense.CSV")
tw2.Write(eexport1)
tw2.Close()
Catch ex As Exception
End Try
End Sub
And this is the one I have used for importing csv file.
Private Sub ImportFromExcelToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ImportFromExcelToolStripMenuItem.Click
Dim expenseload1 As String = "C:\Users\S2009516\Desktop\JanuaryExpense.CSV"
Dim incomeload1 As String = "C:\Users\S2009516\Desktop\JanuaryIncome.CSV"
Try
Dim expensereader1 As New StreamReader(expenseload1, Encoding.Default)
Dim incomereader1 As New StreamReader(incomeload1, Encoding.Default)
Dim eline As String = ""
Dim iline As String = ""
Do
eline = expensereader1.ReadLine
iline = incomereader1.ReadLine
If eline Is Nothing Then Exit Do
If iline Is Nothing Then Exit Do
Dim words() As String = eline.Split(",")
Dim words2() As String = iline.Split(",")
Income.Rows.Add("")
Expense.Rows.Add("")
For ix As Integer = 0 To 3
Me.Income.Rows(Income.Rows.Count - 1).Cells(ix).Value = words2(ix)
Me.Expense.Rows(Income.Rows.Count - 1).Cells(ix).Value = words(ix)
Next
Loop
expensereader1.Close()
incomereader1.Close()
Catch ex As Exception
End Try
End Sub
I have no clue on why this is happening... I have followed all the steps in the tutorial video.. Please save my soul... I have been stuck with this for 2 days already.
I was making a mod installer for a Minecraft community, when I ended with this problem:
Here's my code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Button1.Enabled = False
Button2.Enabled = False
ComboBox1.Enabled = False
Button1.Text = "DOWNLOADING... DO NOT QUIT!"
Dim selected As String
Dim issel As Boolean
issel = False
selected = ComboBox1.SelectedItem
If selected = "Minecade Mod 1.7.2" Then
selected = "5"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with OptiFine Standard" Then
selected = "3"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with Optifine Ultra" Then
selected = "4"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with Optifine Standard and Minecade Capes" Then
selected = "1"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with Optifine Ultra and Minecade Capes" Then
selected = "2"
issel = True
End If
If issel = False Then
MsgBox("Invalid Selection! Try again.")
Else
Dim answ As Integer
answ = MsgBox("You have chosen the mod with the ID of: " & selected & "." & vbCrLf & "Do you want to install this mod?", vbYesNo)
If answ = 6 Then
If My.Computer.FileSystem.FileExists("C:\Documents and Settings\All Users\Documents\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip") Then
Dim answOverW As Integer = MsgBox("The file already exists on the download location. Do you wish to download the file again (NO) or do you want to continue with the old one (YES)? (Preferred: Yes)", vbYesNo)
'6y7n
End If
'Installation process begins
Try
Dim dlPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
My.Computer.Network.DownloadFile("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip", dlPath, "", "", False, 500, True)
Dim Unpackandinstall As Boolean = MsgBox("Download succesful. Do you want to unpack and install the archieve?", vbYesNo)
If Unpackandinstall = True Then
'UNPACK -------
'''Error occures inside the TRY tags here!'''
Try
Dim filePath As String
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & ".minecraft\versions\1.7.2modded" & selected
Dim startPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Dim zipPath As String = filePath
Dim extractPath As String = filePath
My.Computer.FileSystem.CreateDirectory(filePath)
ZipFile.CreateFromDirectory(startPath, zipPath)
ZipFile.ExtractToDirectory(zipPath, extractPath)
MsgBox("Decompression, installation and finishing done! Ready to play!")
Catch ex As Exception
MsgBox("Error in decompression and installment proceidure." & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Report to JOWD, as this should NOT happen!")
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
End Try
'''Error area ends!'''
End If
Catch ex As Exception
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
MsgBox("Download failed. Error code below!" & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Check the main topic for a possible solution, if nothing applies leave a reply!")
Exit Sub
End Try
Else
'installation process aborted.
End If
End If
End Sub
I will be happy to answer any question related to my problem, I've tried to look help anywhere but nothing helps me!
Thanks.
Read! Edited.
Regarding the 2 answers from David Sdot and Visual Vincent, - Their answers did not fix my problem.
I tried to use the following line on the code:
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\versions\1.7.2modded" & selected
Same error occurred.
Still looking for more advices from you!
Leave a comment if you want the project file to test it out.
Read! Edited.
Here's the source for the app, do your testing there!
http://files.casualnetwork.net/installers/moddedminec/source/MinecadeModInstaller_Min.zip
Ok so here's my solution to your problem:
Here, I used a WebClient instead of My.Computer.Network.DownloadFile, since I think it's better. (You use whatever you want of course)
Dim Download As New WebClient
Download.DownloadFileAsync(New Uri("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip"), dlPath)
I also noticed some stuff that had to be changed in your code.
For some reason you tried to zip your file into itself:
ZipFile.CreateFromDirectory(startPath, zipPath)
Remove this. :)
And you also tried to extract .minecraft\versions\1.7.2modded to itself by doing this:
Dim startPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Dim zipPath As String = filePath
Dim extractPath As String = filePath
ZipFile.ExtractToDirectory(zipPath, extractPath)
Simply change zipPath from:
Dim zipPath As String = filePath
To:
Dim zipPath As String = startPath
Now the zipping should work fine :)
One more thing I noticed is that you couldn't skip the unzip part even if you pressed "No" in the MsBox. So I changed that code a little:
Dim Unpackandinstall As DialogResult
Unpackandinstall = MessageBox.Show("Download succesful. Do you want to unpack and install the archieve?", "", MessageBoxButtons.YesNo)
If Unpackandinstall = Windows.Forms.DialogResult.Yes Then
...
End If
Here's the whole Try block:
Try
Dim Download As New WebClient
Dim dlPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Download.DownloadFileAsync(New Uri("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip"), dlPath)
Dim Unpackandinstall As DialogResult
Unpackandinstall = MessageBox.Show("Download succesful. Do you want to unpack and install the archieve?", "", MessageBoxButtons.YesNo)
If Unpackandinstall = Windows.Forms.DialogResult.Yes Then
Try
Dim filePath As String
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\versions\1.7.2modded" & selected
Dim startPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Dim zipPath As String = startPath
Dim extractPath As String = filePath
My.Computer.FileSystem.CreateDirectory(filePath)
'ZipFile.CreateFromDirectory(startPath, zipPath)
ZipFile.ExtractToDirectory(zipPath, extractPath)
MsgBox("Decompression, installation and finishing done! Ready to play!")
Catch ex As Exception
MsgBox("Error in decompression and installment proceidure." & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Report to JOWD, as this should NOT happen!")
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
End Try
End If
Catch ex As Exception
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
MsgBox("Download failed. Error code below!" & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Check the main topic for a possible solution, if nothing applies leave a reply!")
Exit Sub
End Try
And just replace
Download.DownloadFileAsync(New Uri("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip"), dlPath)
With your My.Computer.Network code if you'd rather use that instead. :)
Hope this helps!
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & ".minecraft\versions\1.7.2modded" & selected
The path return by Environment.GetFolderPath has no \ at the end and you prepended a dot instead.
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\minecraft\versions\1.7.2modded" & selected
I need code to read a .txt file which is in my project bin\debug directory that contains SQL code to create tables in a large number it size of 936kb
This following code only I'm using...
By using this it gives result like table created but it is not reading the file... there is nothing in the database
Public Function readTextFile(ByVal fileName As String) As String
Dim strContent As String()
Dim x As String = ""
Try
'fileName = "CSYSS802.txt"
If Not System.IO.File.Exists(fileName) Then
'o Until EOF()
strContent = System.IO.File.ReadAllLines(fileName)
For Each Str As String In strContent
x = x + Str
Next
readTextFile = x
End If
Catch ex As Exception
MessageBox.Show(ex.ToString)
End Try
readTextFile = x
End Function
Public Sub createTable(ByVal vdbs As String, ByVal file As String)
username = frmlogin.txtusername.Text
password = frmlogin.txtusername.Text
vsvr = vServer
vdb = Trim$(vdbs)
strCon1 = "Server=" & vsvr & ";Database=" & vdb & ";uid=" & username & ";pwd=" & password & ";"
sqlCon1 = New SqlClient.SqlConnection(strCon1)
sqlCon1.Open()
Dim arr() As String
arr = Split(readTextFile(file), "GO")
Dim i As String
For Each i In arr
If i <> "" Then
Dim cmd2 As New SqlClient.SqlCommand("" & i & "")
cmd2.CommandType = CommandType.Text
cmd2.ExecuteNonQuery()
End If
Next
End Sub
In the readTextFile function, it will only attempt to read the text from the text file if the file DOESN'T exist. If the text file exists then the function returns an empty string and if the text file doesn't exist, the function will throw a file not found exception.
Replace:
If Not System.IO.File.Exists(fileName) Then
with:
If System.IO.File.Exists(fileName) = True Then
You might also want to include an Else clause in case the file doesn't exist as it won't throw an error since you have handled it correctly.
If System.IO.File.Exists(fileName) = True Then
strContent = System.IO.File.ReadAllLines(fileName)
For Each Str As String In strContent
x &= Str
Next
Return x
Else
MessageBox.Show("The file '" & fileName & "' does not exist.")
Return ""
End If
My Self I had Found The solution..I attache the Following Code...It now Creating All tables Properly..
Make sure that each Sql Commands in your Text File ends with go.. because i used "GO" Keyword to split the text...
Public Sub createTable(ByVal vdbs As String, ByVal file As String)
username = frmlogin.txtusername.Text
password = frmlogin.txtusername.Text
vsvr = vServer
vdb = Trim$(vdbs)
strCon1 = "Server=" & vsvr & ";Database=" & vdb & ";uid=" & username & ";pwd=" & password & ";"
sqlCon1 = New SqlClient.SqlConnection(strCon1)
sqlCon1.Open()
Dim arr() As String
arr = Split(readTextFile(file), " GO ")
Dim i As String
For Each i In arr
If i <> "" Then
Dim cmd2 As New SqlClient.SqlCommand("" & i & "", sqlCon1)
cmd2.CommandType = CommandType.Text
cmd2.ExecuteNonQuery()
End If
Next
End Sub
Public Function readTextFile(ByVal file As String) As String
Dim fso As New System.Object
Dim ts As Scripting.TextStream
Dim sLine As String
fso = CreateObject("Scripting.FileSystemObject")
ts = fso.openTextFile(file)
Do Until ts.AtEndOfStream
sLine = sLine & " " & ts.ReadLine
Loop
ts.Close()
fso = Nothing
readTextFile = sLine
End Function