Logic help for DotNetZip loop logic - vb.net

I have a logic problem, just need more brains working on this.
For Each JobNode In JobNodes
Dim Source = JobNode.SelectNodes("Source")
For Each item As System.Xml.XmlNode In Source
Dim infoReader As System.IO.FileInfo
''''Discerns whether a file or directory
If item.InnerText.Contains(".") Then 'is a file
If Dir$(item.InnerText) <> vbNullString Then
mySize += FileLen(item.InnerText)
End If
zip.AddFile(item.InnerText, "")
Dim numFiles2 = filenames.Count
mySize = BytesTO(mySize, convTo.MB)
Console.WriteLine("...Added all " & numFiles2 & " files. Total loose file collection size is " & Math.Round(mySize, 2) & " MB")
Console.WriteLine(vbCrLf)
Else 'is a directory
zip.AddDirectory(item.InnerText, GetLastDirName(item.InnerText & " "))
Dim dinfo As New DirectoryInfo(item.InnerText)
Dim sizeOfDir As Long = DirectorySize(dinfo, True)
Dim numFiles As Integer = CountFiles_FolderAndSubFolders(item.InnerText)
Console.WriteLine("...Added all " & numFiles & " files. Total directory size is {0:N2} MB", (CDbl(sizeOfDir)) / (1024 * 1024))
Console.WriteLine(vbCrLf)
End If
Next
This is part of a backup program I made. This is the part that determines if the object to be added to the zip is a file (first part of the IF statement) or a directory (ELSE part of the IF statement).
My problem is, I am trying to add this code:
Dim numFiles2 = filenames.Count
mySize = BytesTO(mySize, convTo.MB)
Console.WriteLine("...Added all " & numFiles2 & " files. Total loose file collection size is " & Math.Round(mySize, 2) & " MB")
Console.WriteLine(vbCrLf)
Just after the zip.AddFile(item.innertext,"") part. I want to add this so that I can get a console print out of the information.
The problem is, if I just put it directly after the zip.addfile(), it outputs the code directly above each time. I only want it to print out that part (directly above) once it has finished adding all of the loose files (or files added using zip.AddFile())
EDIT: adding the for loops at the top for more clarification

Add a flag and then look for it after the loop completes. It seems as though you are looping through the files instead of calling this recursively. I am guessing you have only one loop right now.
Before Loop iteration:
Dim FilesBeingAdded as Boolean = False
Dim numFiles2 as Integer = 0
Inside of iteration:
If item.InnerText.Contains(".") Then 'is a file
If FilesBeingAdded = False Then
FilesBeingAdded = true
End If
If Dir$(item.InnerText) <> vbNullString Then
mySize += FileLen(item.InnerText)
End If
zip.AddFile(item.InnerText, "")
numFiles2 +=1
Else 'is a directory
zip.AddDirectory(item.InnerText, GetLastDirName(item.InnerText & " "))
Dim dinfo As New DirectoryInfo(item.InnerText)
Dim sizeOfDir As Long = DirectorySize(dinfo, True)
Dim numFiles As Integer = CountFiles_FolderAndSubFolders(item.InnerText)
Console.WriteLine("...Added all " & numFiles & " files. Total directory size is {0:N2} MB", (CDbl(sizeOfDir)) / (1024 * 1024))
Console.WriteLine(vbCrLf)
End If
After Loop Iteration:
If FilesBeingAdded = True Then
mySize = BytesTO(mySize, convTo.MB)
Console.WriteLine("...Added all " & numFiles2 & " files. Total loose file collection size is " & Math.Round(mySize, 2) & " MB")
Console.WriteLine(vbCrLf)
mySize = 0
numFiles2 = 0
FilesBeingAdded = False
End If
So when it finishes the current iteration it will take the tally of files it added, along with the size and print it to the console. It then zeros the variables so that the next iteration of the inner loop has clean values. I am presuming you run this on more than one directory. By checking FilesBeingAdded you can be sure to avoid situations where an ugly zero count output is shown if the directory contained no files.
This solution presumes a lot about how you enter this piece of code. If my presumptions were not correct, please modify the question to enable a better solution.

Related

FileExist returns false

I have a folder with 700+ .jpgs. I also have a Textbox with one filename per line.
I want to check which file does not exist in the folder, but should be there.
This is my code:
Dim Counter As Integer = 0
For Each Line As String In tbFileNames.Lines
Counter = Counter + 1
If (IO.File.Exists(tbFolder.Text & "\" & tbFileNames.Lines(Counter - 1).ToString & ".jpg")) = False Then
tbNotExistingFiles.Text = tbNotExistingFiles.Text & vbNewLine & (tbFileNames.Lines(Counter - 1).ToString)
Else
End If
Next
Problem: I get more than 300 "missing" files, but there should be only 7. When I search for the output filenames, they are in the folder, so the FileExists functions returns false, but it shouldn't.
Where is the problem? Is it the amount of files?
According to this line:
If (IO.File.Exists(tbFolder.Text & "\" & tbFileNames.Lines(Counter - 1).ToString & ".jpg")) = False
Which can be interpreted as:
The tbFolder TextBox contains the directory's path where the images are located.
The tbFileNames TextBox contains the main and complete file names. One file name per line.
Appending the extension & ".jpg" means that the file names in the tbFileNames TextBox are without extensions. And,
You need to get a list of the missing files in that directory and show the result in the tbNotExistingFiles TextBox.
If my interpretation is correct, then you can achieve that using the extension methods like:
Imports System.IO
'...
Dim missingFiles = tbFileNames.Lines.
Select(Function(x) $"{x.ToLower}.jpg").
Except(Directory.GetFiles(tbFolder.Text).
Select(Function(x) Path.GetFileName(x.ToLower)))
tbNotExistingFiles.Text = String.Join(ControlChars.NewLine, missingFiles)
Or by a LINQ query:
Dim missingFiles = From x In tbFileNames.Lines
Where (
Aggregate y In Directory.EnumerateFiles(tbFolder.Text)
Where Path.GetFileName(y).ToLower.Equals($"{x.ToLower}.jpg")
Into Count()
) = 0
Select x
'Alternative to tbNotExistingFiles.Text = ...
tbNotExistingFiles.Lines = missingFiles.ToArray
Note that, there's no need nor use for the File.Exists(..) function in the preceding snippets. Just in case you prefer your approach using For..Loop and File.Exists(..) function, then you can do:
Dim missingFiles As New List(Of String)
For Each line In tbFileNames.Lines
If Not File.Exists(Path.Combine(tbFolder.Text, $"{line}.jpg")) Then
missingFiles.Add(line)
End If
Next
tbNotExistingFiles.Lines = missingFiles.ToArray

Bitmap read, write & compare

A) When I write a BMP file & then read it back into another bitmap object the objects appear different. Looks like Horizontal & Vertical Resolutions are changed.
B) When I make the bitmap object resolutions the same the bitmap objects still appear different despite all attributes appearing the same.
C) If I read the same BMP file twice into two different bitmap objects the objects appear different.
Eventually I want to clone small sections of a larger bitmap & ascertain whether I already have a file for the smaller section by comparing against the contents of each known previously generated file in turn. That is, by reading each file as a bitmap I want to be able to compare against the small section bitmap.
I will eventually be placing a checksum in each file's name or attributes for quicker exclusion but will still need to compare each file contents of those who "survive the exclusion" to prevent different files with the same checksum issue.
When run, the code below shows the issues.
Private Sub btnTest_Click(sender As Object, e As EventArgs) Handles btnTest.Click
Dim sFileName As String = "c:\Temp\Red.bmp"
' Create red coloured bitmap
Dim oBitMap1 As New Bitmap(200, 100)
Dim oGraphics = Graphics.FromImage(oBitMap1)
oGraphics.FillRectangle(Brushes.Red, 0, 0, 200, 100)
Dim oBitMapA As New Bitmap(200, 100)
oBitMapA = oBitMap1
Debug.Print("oBitMap1 Is oBitMapA = " & CStr(oBitMap1 Is oBitMapA))
' Save the bitmap
oBitMap1.Save(sFileName, Imaging.ImageFormat.Bmp)
' Read the "same" details back into oBitMap2 & BitMap3
Dim oBitMap2 = New Bitmap(sFileName)
Dim oBitMap3 = New Bitmap(sFileName)
'Dim oBitMap2 As Bitmap = Image.FromFile(sFileName)
'Dim oBitMap3 As Bitmap = Image.FromFile(sFileName)
' Show what's what
Debug.Print("Show whether BitMaps are the same (pre changes)")
Debug.Print("oBitMap1 Is oBitMap2 = " & CStr(oBitMap1 Is oBitMap2))
Debug.Print("oBitMap2 Is oBitMap3 = " & CStr(oBitMap2 Is oBitMap3))
Debug.Print("Show resolutions (pre any changes)")
Debug.Print("oBitMap1.Resolution = " & Format(oBitMap1.HorizontalResolution, "##0.###") & "," & Format(oBitMap1.VerticalResolution, "##0.###"))
Debug.Print("oBitMap2.Resolution = " & Format(oBitMap2.HorizontalResolution, "##0.###") & "," & Format(oBitMap2.VerticalResolution, "##0.###"))
Debug.Print("oBitMap3.Resolution = " & Format(oBitMap3.HorizontalResolution, "##0.###") & "," & Format(oBitMap3.VerticalResolution, "##0.###"))
oBitMap2.SetResolution(96, 96)
oBitMap3.SetResolution(96, 96)
Debug.Print("Show resolutions (post changes)")
Debug.Print("oBitMap1.Resolution = " & Format(oBitMap1.HorizontalResolution, "##0.###") & "," & Format(oBitMap1.VerticalResolution, "##0.###"))
Debug.Print("oBitMap2.Resolution = " & Format(oBitMap2.HorizontalResolution, "##0.###") & "," & Format(oBitMap2.VerticalResolution, "##0.###"))
Debug.Print("oBitMap3.Resolution = " & Format(oBitMap3.HorizontalResolution, "##0.###") & "," & Format(oBitMap3.VerticalResolution, "##0.###"))
Debug.Print("Show whether BitMaps are the same (post changes)")
Debug.Print("oBitMap1 Is oBitMap1 = " & CStr(oBitMap1 Is oBitMap1))
Debug.Print("oBitMap1 Is oBitMap2 = " & CStr(oBitMap1 Is oBitMap2))
Debug.Print("oBitMap2 Is oBitMap3 = " & CStr(oBitMap2 Is oBitMap3))
End Sub
Using descriptions above
A) I'm expecting oBitMap2 read from the file created from oBitMap1 to be the same as oBitMap1 but the resolutions are different.
B) When I set the oBitMap2 resolutions to be the same as oBitMap1 I'm expecting oBitMap1 & oBitmap2 to be the same but they're different.
C) When I read the same file twice I'm expecting the two bitmaps created (oBitMap2 & oBitMap3) to be the same but they're different.
I am wondering whether I've misunderstood the "Is" compare operator or the bitmaps have "hidden" attributes that don't show when I "print" them in the debugger as all the shown attributes appear to be the same.

FileInfo returning wrong value?

Okay, so I'm working in VB.NET, manually writing error logs to log files (yes, I know, I didn't make the call). Now, if the files are over an arbitrary size, when the function goes to write out the new error data, it should start a new file with a new file name.
Here's the function:
Dim listener As New Logging.FileLogTraceListener
listener.CustomLocation = System.Configuration.ConfigurationManager.AppSettings("LogDir")
Dim loc As String = DateTime.UtcNow.Year.ToString + DateTime.UtcNow.Month.ToString + DateTime.UtcNow.Day.ToString + DateTime.UtcNow.Hour.ToString + DateTime.UtcNow.Minute.ToString
listener.BaseFileName = loc
Dim logFolder As String
Dim source As String
logFolder = ConfigurationManager.AppSettings("LogDir")
If ex.Data.Item("Source") Is Nothing Then
source = ex.Source
Else
source = ex.Data.Item("Source").ToString
End If
Dim errorFileInfo As New FileInfo(listener.FullLogFileName)
Dim errorLengthInBytes As Long = errorFileInfo.Length
If (errorLengthInBytes > CType(System.Configuration.ConfigurationManager.AppSettings("maxFileSizeInBytes"), Long)) Then
listener.BaseFileName = listener.BaseFileName + "1"
End If
Dim msg As New System.Text.StringBuilder
If String.IsNullOrEmpty(logFolder) Then logFolder = ConfigurationManager.AppSettings("LogDir")
msg.Append(vbCrLf & "Exception" & vbCrLf)
msg.Append(vbTab & String.Concat("App: AppMonitor | Time: ", Date.Now.ToString) & vbCrLf)
msg.Append(vbTab & String.Concat("Source: ", source, " | Message: ", ex.Message) & vbCrLf)
msg.Append(vbTab & "Stack: " & ex.StackTrace & vbCrLf)
listener.Write(msg.ToString())
listener.Flush()
listener.Close()
I have this executing in a loop for testing purposes, so I can see what happens when it gets (say) 10000 errors in all at once. Again, I know there are better ways to handle this systemically, but this was the code I was told to implement.
How can I reliably get the size of the log file before writing to it, as I try to do above?
Well, as with many things, the answer to this turned out to be "did you read your own code closely" with a side order of "eat something, you need to fix your blood sugar."
On review, I saw that I was always checking BaseFileName and, if it was over the arbitrary limit, appending a character and writing to that file. What I didn't do was check to see if that file or, indeed, other more recent files existed. I've solved the issue be grabbing a directory list of all the files matching the "BaseFileName*" argument in Directory.GetFiles and selecting the most recently accessed one. That ensures that the logger will always select the more current file to write to or -if necessary- use as the base-name for another appended character.
Here's that code:
Dim directoryFiles() As String = Directory.GetFiles(listener.Location.ToString(), listener.BaseFileName + "*")
Dim targetFile As String = directoryFiles(0)
For j As Integer = 1 To directoryFiles.Count - 1 Step 1
Dim targetFileInfo As New FileInfo(targetFile)
Dim compareInfo As New FileInfo(directoryFiles(j))
If (targetFileInfo.LastAccessTimeUtc < compareInfo.LastAccessTimeUtc) Then
targetFile = directoryFiles(j)
End If
Next
Dim errorFileInfo As New FileInfo(listener.Location.ToString() + targetFile)
Dim errorLengthInBytes As Long = errorFileInfo.Length

Removing binary zero from a string

I've had to move a whole directory structure (thousands of directories and files) from the Mac to the PC, but now on the PC for some reason some of the folder names have a character on the end of value binary zero ( a few have this in the middle). I need to clean this up since it crashes a macro which tries to read these directories.
I've tried the following code in a vba-word macro using the Replace function (as part of a larger program that walks through the directory tree) but the Replace function doesn't seem to catch chr(0) .
Set current_folder = fso.GetFolder(source_folder.Path)
current_folder_name = current_folder.Name
cleaned_folder_name = Replace(current_folder_name, Chr(0), " ")
Selection.TypeText "Old directory name: " & current_folder_name
Selection.TypeParagraph
Selection.TypeText "New directory name: " & cleaned_folder_name
Selection.TypeParagraph
If current_folder_name <> cleaned_folder_name Then
current_folder.Name = cleaned_folder_name
End If
I've also tried:
cleaned_folder_name = Replace(current_folder_name, Chr(0), " ", 1, -1, vbBinaryCompare)
How I can get the Replace function to replace binary 0 in a string by a blank.
Or does anyone knows a different approach to cleaning up these directory and file names that would work.
Thanks,
Harry
This should do it:
Dim OldFolderName As String, NewFolderName As String
OldFolderName = source_folder.Path
If InStr(OldFolderName, Chr(0)) > 0 Then
'NewFolderName = Application.Clean(OldFolderName) 'Works on some versions
NewFolderName = Application.WorksheetFunction.Clean(OldFolderName) 'By Gene Skuratovsky
Name OldFolderName As NewFolderName
End If
Edit2: Probably best to use the Clean() method.
In my case Replace() and InStr() don't work with Chr(0) (can't see it not displaying any error), but this removal can be done for example this way:
If Mid$(str, 1, 1) = Chr$(0) Then str = Mid$(str, 2)
If Mid$(str, Len(str), 1) = Chr$(0) Then str = Left$(str, Len(str) - 1)
This is Null removal from ends, for example from objFile.ExtendedProperty("Dimensions") value, like "?600 x 400?". Nulls (?) are insterted here in Windows 10 but not in Windows XP.
You can write a custom loop function to determine what character you are having issues with:
OldFolderName = source_folder.Path
For x = 0 To 255
If InStr(OldFolderName, Chr(x)) > 0 Then
MsgBox "Chr(" & x & ") is found at position " & InStr(OldFolderName, Chr(x))
EndIf
Next x

VBA Text File Input for Reading and Writing

I'm writing in VB 2010 with a form with one button to be completely idiot. I haven't done VB in awhile and noticed 2010 has a lot of changes compare when I did it a couple of years ago.
What I need done is it to read from a file and write two new separate files while writing to original. It will read from a text file to get some contents and compare the current date.
The text content will be a serial and the next two columns will be dates.
Dim iFileName As New StreamReader("G:\SAP In and Out\test.txt", False)
Dim sFileExport As New StreamWriter(DateValue(Now)) + " SAP Export", False)
Dim sFileImport As New StreamWriter(DateAdd(DateInterval.Day, 10, DateValue(Now)) + " SAP Import", False)
Dim VTS As String 'Will be used to grab the VT serial
Dim CurrentDate As Date 'Will be used to compare to grabbed dates
Dim NextDateOut As Date 'Will be used to grab next date out value
Dim NextDateIn As Date 'Will be used to grab next date in value
'Setting a consistant value with daily'
CurrentDate = DateValue(Now)
Do While Not EOF(1)
Input(iFileName),VTS,NextDateOut,NextDateIn
If CurrentDate = NextDateOut Then
'Write to the export File
sFileExport.write(VTS)
'Write under the just read line in the open file
iFileName.write(/newline + VTS + /TAB + (DateAdd(DateInterval.Day, 20, DateValue(Now)) + /tab + (DateAdd(DateInterval.Day, 30, DateValue(Now)))
ElseIf CurrentDate = NextDateIn Then
'Write to import file
sFileImport.Write(VTS)
End If
Loop
End Sub
But my syntax is off and it's obviously not running since I'm asking for help.
Please help and thanks in advance. I've been working on this for hours and haven't had any positive results yet.
Well I think its right now, but i had to add an extra function so i could test it out.
I was receiving errors o the date format because I expect you use US date format (MM/DD/YYYY) and I use UK date format (DD/MM/YYYY).
Anyway you can strip the function out as I dont think you will need it, but I've left it in anyway so you can see whats going on its quite self explanatory and simply converts between the date formats, though it was made more difficult by the fact your days and month are not two digits long (no leading zero).
I hope it helps point you in the right direction and you can chop and change it to your preference.
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim iFileName As New System.IO.StreamReader("c:\temp\vttest.txt", False)
Dim iReadData As List(Of String)
Dim Buffer As String
'Read complete file into array
iReadData = New List(Of String)
Do While Not iFileName.EndOfStream()
Try
Buffer = ""
Buffer = iFileName.ReadLine()
iReadData.Add(Buffer)
Catch ex As Exception
'error or end of file
End Try
Loop
iFileName.Close()
'Not needed
'Dim VTS As String 'This is in iLineData(0) after we split the line
'Dim NextDateOut As Date 'This is in iLineData(1) after we split the line
'Dim NextDateIn As Date 'This is in iLineData(2) after we split the line
'Process
Dim iFileUpdated As New System.IO.StreamWriter("c:\temp\vttest_copy.txt", True)
Dim sFileExport As New System.IO.StreamWriter("c:\temp\vttest" & Replace(DateValue(Now), "/", "_") & " SAP Export.txt", True)
Dim sFileImport As New System.IO.StreamWriter("c:\temp\vttest" & Replace(DateAdd(DateInterval.Day, 10, DateValue(Now)), "/", "_") + " SAP Import.txt", True)
Dim iLineData() As String
'Setting a consistant value with daily'
Dim CurrentDate As Date = DateValue(Now)
Dim RowId = 0
Do While RowId < iReadData.Count()
iLineData = Split(iReadData(RowId), " ")
iFileUpdated.WriteLine(iLineData(0) & " " & iLineData(1) & " " & iLineData(2))
If CurrentDate = FormatDate(iLineData(1), "US", "UK") Then
'Write to the export File
sFileExport.WriteLine(iLineData(0))
'Write under the just read line in the open file
iFileUpdated.WriteLine(iLineData(0) & " " & (DateAdd(DateInterval.Day, 20, DateValue(Now))) & " " & (DateAdd(DateInterval.Day, 30, DateValue(Now))))
ElseIf CurrentDate = FormatDate(iLineData(2), "US", "UK") Then
'Write to import file
sFileImport.WriteLine(iLineData(0))
End If
RowId = RowId + 1
Loop
sFileExport.Close()
sFileImport.Close()
iFileUpdated.Close()
MsgBox("Finshed")
End Sub
'This section added because my PC is set to DD/MM/YYYY (UK)
'Expect yours is set to MM/DD/YYYY (US)
Function FormatDate(ThisDate As String, ThisFormat As String, ThisTargetFormat As String) As Date
Dim X As Integer = 0
Dim Day1 As Integer = 0
Dim Month1 As Integer = 0
Dim Year1 As Integer = 0
Dim Buf As String = ""
If ThisFormat = "US" Then
For X = 1 To Len(ThisDate)
If Mid(ThisDate, X, 1) = "/" Then
If Month1 > 0 Then
Day1 = Buf
Buf = ""
Else
Month1 = Buf
Buf = ""
End If
Else
Buf = Buf & Mid(ThisDate, X, 1)
End If
Next
Year1 = Buf
Else
For X = 1 To Len(ThisDate)
If Mid(ThisDate, X, 1) = "/" Then
If Day1 > 0 Then
Month1 = Buf
Buf = ""
Else
Day1 = Buf
Buf = ""
End If
Else
Buf = Buf & Mid(ThisDate, X, 1)
End If
Next
Year1 = Buf
End If
'reformat for output
If ThisFormat = "US" Then
If ThisTargetFormat = "US" Then
'USA
FormatDate = (Format(Month1, "00") & "/" & Format(Day1, "00") & "/" & Format(Year1, "0000"))
Else
'UK
FormatDate = (Format(Day1, "00") & "/" & Format(Month1, "00") & "/" & Format(Year1, "0000"))
End If
Else
If ThisTargetFormat = "US" Then
'USA
FormatDate = (Format(Month1, "00") & "/" & Format(Day1, "00") & "/" & Format(Year1, "0000"))
Else
'UK
FormatDate = (Format(Day1, "00") & "/" & Format(Month1, "00") & "/" & Format(Year1, "0000"))
End If
End If
End Function
Additionally i changed the file names so as not to overwrite the existing files (So i could compare the two files).
Most of the problems were arising from the back slashes in the dates in the FILENAMES - making the pc look for paths like /3/12 i guess it was translating the slashes into folder delimiters so I replaced them with UNDERSCORES on the fly.
Once you have edited the code to your preference you can OVERWRITE the existing file rather than generating a _copy.txt as thats how I tested with a _copy.txt in the sample.
Update
Thanks for the feedback. Well its strange that your (generated) files are empty, because in the ones I have ONE has data the other is empty. This leads me to the assumption that your tweaks may have something to do with it?
For your reference I have posted them below.
ORIGINAL FILE [VTSTEST.TXT]
VT1000 3/26/2013 4/5/2013
VT1100 3/26/2013 4/5/2013
VT2000 3/27/2013 4/6/2013
VT2200 3/27/2013 4/6/2013
COPY OF VTSTEST.TXT (after modification)
VT1000 3/26/2013 4/5/2013
VT1100 3/26/2013 4/5/2013
VT2000 3/27/2013 4/6/2013
VT2000 16/04/2013 26/04/2013
VT2200 3/27/2013 4/6/2013
VT2200 16/04/2013 26/04/2013
Note: I expect the two longer lines are the ones inserted inbetween the existing four lines of text
VTTEST06_04_2013 SAP Import.Txt
This file was empty
VTTEST27_03_2013 SAP Export.TXT
VT2000
VT2000