The copy process is very slow with this function vb.net - vb.net

I use this function for copying some files from the Source folder to the Destination folder, but the copying is needed more time than usual.
Sub SyncFiles(Lbl_Percentage As Label, Lbl_FileName As Label, PrgrsBar As ProgressBar)
Try
Dim Sql As String = "SELECT GroupID FROM Tbl_Current"
Dim GetGroupID = MsAcc_RetriveTemp(Sql, 0)
Dim Sql1 As String = "Select * FROM Tbl_SyncPath where ID=" & GetGroupID
Dim Src As String = MsAcc_RetriveTemp(Sql1, 1)
Dim Des As String = MsAcc_RetriveTemp(Sql1, 2)
If Not IO.Directory.Exists(Des) Then IO.Directory.CreateDirectory(Des)
Dim fls() As String = IO.Directory.GetFiles(Des)
PrgrsBar.Value = 0
PrgrsBar.Maximum = fls.Count
For Each fn As String In fls
Dim filename As String = IO.Path.GetFileName(fn)
My.Computer.FileSystem.CopyDirectory(Des, Src, True)
PrgrsBar.Value += 1 'add 1 to the ProgressBar`s value
Dim Percntge As Integer = (PrgrsBar.Value / fls.Count) * 100
Lbl_Percentage.Text = Percntge & " %"
Lbl_FileName.Text = "جاري تحديث ملف: " & filename
Application.DoEvents()
Lbl_FileName.Text = "اكتمل عملية التحديث."
Next
Catch ex As Exception
End Try
End Sub

You copy all the files in the folder for each files.
For Each fn As String In fls
Dim filename As String = IO.Path.GetFileName(fn)
My.Computer.FileSystem.CopyDirectory(Des, Src, True) ' <--- No file specified
PrgrsBar.Value += 1 'add 1 to the ProgressBar`s value
Dim Percntge As Integer = (PrgrsBar.Value / fls.Count) * 100
Lbl_Percentage.Text = Percntge & " %"
Lbl_FileName.Text = "جاري تحديث ملف: " & filename
Application.DoEvents()
Lbl_FileName.Text = "اكتمل عملية التحديث."
Next
Put this outside the loop
My.Computer.FileSystem.CopyDirectory(Des, Src, True)
For Each fn As String In fls
' ...
Next
Also, seems like des and src are mixed up.

Related

I Want to add a Timestamp with the original Name of the Folders name that is being Copied (in vb.net)

I found some Code to Copy a Folder with all its contents to another folder. the Folder name that is being copied to another folder is the same as the original folder in its original path. I want to add a timestamp with a date and time to show you the most recent 'copy' of the folder you copied.
An example would be:
Original Folder: Rage 2 ;
Copied Folder: Rage 2 - 3/11/2021 - 7:37
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim parts As String() = directoryTargetLocation.Split(New Char() {"\"c})
Dim filename As String = parts(parts.Count - 1) 'target folder name
Dim dir_path As String = "" 'directory without target folder name
For f As Integer = 0 To parts.Count - 2
dir_path += parts(f) + "\"
Next
Dim copied As Integer = 0
Dim counter As Integer = IO.Directory.GetFiles(directoryTargetLocation, "*.*", IO.SearchOption.AllDirectories).Length 'counts the number of files
SetProgressbar(counter, ProgressBar2) 'Sets ProgressBar maximum to number of files
setLabelTxt("Copied (0/" + counter.ToString + ")", Label4) 'displays the amount of copied files
Dim FolderList As New List(Of String)
FolderList.Add(directoryTargetLocation) 'Set first folder
Do While True
If (BackgroundWorker1.CancellationPending = True) Then 'cancel loop
e.Cancel = True
Exit Do
End If
Dim FoldersInsideDirectory As New List(Of String)
If FolderList.Count = 0 Then
Exit Do 'If there is no folder to copy Exit Do
Else
For l As Integer = 0 To FolderList.Count - 1
If (BackgroundWorker1.CancellationPending = True) Then 'stop for loop
e.Cancel = True
Exit For
End If
Dim sourceDirectoryInfo As New System.IO.DirectoryInfo(FolderList(l))
Dim dest As String = FolderList(l).Replace(dir_path, "")
If (Not System.IO.Directory.Exists(Destinydirectory + "\" + dest)) Then 'create subFolder inside directory
System.IO.Directory.CreateDirectory(Destinydirectory + "\" + dest)
End If
Dim fileSystemInfo As System.IO.FileSystemInfo
For Each fileSystemInfo In sourceDirectoryInfo.GetFileSystemInfos
If (BackgroundWorker1.CancellationPending = True) Then
e.Cancel = True
Exit For
End If
Dim destinationFileName As String = System.IO.Path.Combine(Destinydirectory + "\" + dest, fileSystemInfo.Name)
If TypeOf fileSystemInfo Is System.IO.FileInfo Then
Dim streamRead As New System.IO.FileStream(fileSystemInfo.FullName, System.IO.FileMode.Open)
setLabelTxt(fileSystemInfo.FullName.ToString, LabelProgress)
Dim streamWrite As New System.IO.FileStream(Destinydirectory + "\" + dest + "\" + fileSystemInfo.Name, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.None)
Dim lngLen As Long = streamRead.Length - 1
setLabelTxt("Copy bytes : (0/" + (lngLen * 100).ToString + ")", Label10)
Dim byteBuffer(1048576) As Byte 'our stream buffer
Dim intBytesRead As Integer 'number of bytes read
While streamRead.Position < lngLen 'keep streaming until EOF
If (BackgroundWorker1.CancellationPending = True) Then
e.Cancel = True
Exit While
End If
BackgroundWorker1.ReportProgress(CInt(streamRead.Position / lngLen * 100))
setLabelTxt("Copy bytes : (" + CInt(streamRead.Position).ToString + "/" + (lngLen * 100).ToString + ")", Label10)
intBytesRead = (streamRead.Read(byteBuffer, 0, 1048576))
streamWrite.Write(byteBuffer, 0, intBytesRead)
End While
'Clean up
streamWrite.Flush()
streamWrite.Close()
streamRead.Close()
addProgress(1, ProgressBar2)
copied += 1
setLabelTxt("Copied (" + copied.ToString + "/" + counter.ToString + ")", Label4)
Else
FoldersInsideDirectory.Add(fileSystemInfo.FullName)
End If
Next
Next
FolderList.Clear()
FolderList = FoldersInsideDirectory
End If
Loop
End Sub
Before:
Dim streamWrite As New System.IO.FileStream(Destinydirectory + "\" + dest + "\" + fileSystemInfo.Name, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.None)
After:
dim fnbase as string = Path.GetFileNameWithoutExtension(fileSystemInfo.Name)
dim fnexten as string = path.getextension(fileSystemInfo.Name)
dim fndate as string = DateTime.Now.ToString("yyyyMMdd HHmmss")
dim fn as string = $"{fnbase} - {fndate}{fnexten}"
Dim streamWrite As New System.IO.FileStream(Destinydirectory + "\" + dest + "\" + fn, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.None)
I broke this down the way I did just so it was really easy for you to see the different pieces of it. You could just as easily put all of this together dynamically as the value you pass to System.IO.FileStream.
As an aside, you're doing the copy itself the complicated way. Maybe you need to use that method for a specific reason, but if not, maybe consider File.Copy next time.

Variable '' is used before it has been assigned a value.

I'm trying to make a program that downloads a bunch of domains and adds them windows hosts file but I'm having a bit of trouble. I keep getting an error when I try storing them in a list. I don't get why it doesn't work.
Sub Main()
Console.Title = "NoTrack blocklist to Windows Hosts File Converter"
Console.WriteLine("Downloading . . . ")
Dim FileDelete As String = Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "/Downloads" & "/notracktemp.txt"
If System.IO.File.Exists(FileDelete) = True Then
System.IO.File.Delete(FileDelete)
End If
download()
Threading.Thread.Sleep(1000)
Dim s As New IO.StreamReader(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "/Downloads" & "/notracktemp.txt", True)
Dim tempRead As String ' = s.ReadLine
Dim tempSplit As String() ' = tempRead.Split(New Char() {" "})
Dim i As Integer = 0
Dim tempStore As String()
s.ReadLine()
s.ReadLine()
Do Until s.EndOfStream = True
tempRead = s.ReadLine
tempSplit = tempRead.Split(New Char() {" "})
Console.WriteLine(tempSplit(0))
tempStore(i) = tempSplit(0)'The part that gives me the error
i = i + 1
Loop
Console.ReadKey()
End Sub
Sub download()
Dim localDir As String = Environment.GetFolderPath(Environment.SpecialFolder.UserProfile)
'"Enter file URL"
Dim url As String = "https://quidsup.net/notrack/blocklist.php?download"
'"Enter directory"
Dim dirr As String = localDir & "/Downloads" & "/notracktemp.txt"
My.Computer.Network.DownloadFile(url, dirr)
'System.IO.File.Delete(localDir & "/notracktemp.txt")
End Sub
tempStore() has to have a size
count number of lines in file with loop, then declare it as tempStore(i) where i is the amount of lines. Here is a function that counts the lines.
Function countlines()
Dim count As Integer
Dim s As New IO.StreamReader(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "/Downloads" & "/notracktemp.txt", True)
s.ReadLine()
s.ReadLine()
count = 0
Do Until s.EndOfStream = True
s.ReadLine()
count = count + 1
Loop
Console.WriteLine(count)
Return count
Console.ReadKey()
End Function
Then what you do is:
Dim count As Integer
count = countlines()
Dim tempStore(count) As String

creating csv file in VB2010

I am trying to create CSV file for below code. When i run the code initially it usually create the csv file. For same code it not creating CSV file. Let me Know What issue is
If counter = 1 Then
counter = 0
Dim headerText = ""
Dim csvFile As String = IO.Path.Combine(My.Application.Info.DirectoryPath, "test.csv")
If Not IO.File.Exists((csvFile)) Then
headerText = "Date,TIME ,Current, "
End If
Using outFile = My.Computer.FileSystem.OpenTextFileWriter(csvFile, True)
If headerText.Length > 0 Then
outFile.WriteLine(headerText)
End If
Dim date1 As String = "24-10-2014"
Dim time1 As String = CStr(TimeOfDay())
Dim Current As String = CStr(distance)
'Dim x As String = CStr(CDbl(date1 + "," + time1 + ",") + distance)
Dim x As String = date1
outFile.Write(x)
End Using
End If

system.io.ioexception the process cannot access because it is being used by another process

i am getting this problem in some systems, some systems working properly, here my code is,
Dim fileName As String = "FaultTypesByMonth.csv"
Using writer As IO.StreamWriter = New IO.StreamWriter(fileName, True, System.Text.Encoding.Default) '------------ rao new ----
Dim Str As String
Dim i As Integer
Dim j As Integer
Dim headertext1(rsTerms.Columns.Count) As String
Dim k As Integer = 0
Dim arrcols As String = Nothing
For Each column As DataColumn In TempTab.Columns
arrcols += column.ColumnName.ToString() + ","c
k += 1
Next
writer.WriteLine(arrcols)
For i = 0 To (TempTab.Rows.Count - 1)
For j = 0 To (TempTab.Columns.Count - 1)
If j = (TempTab.Columns.Count - 1) Then
Str = (TempTab.Rows(i)(j).ToString)
Else
Str = (TempTab.Rows(i)(j).ToString & ",")
End If
writer.Write(Str)
Next
writer.WriteLine()
Next
writer.Close()
writer.Dispose()
End Using
Dim FileToDelete As String = Nothing
Dim sd As New SaveFileDialog
sd.Filter = "CSV Files (*.csv)|*.csv"
sd.FileName = "FaultTypesByMonth"
If sd.ShowDialog = Windows.Forms.DialogResult.OK Then
FileCopy(fileName, sd.FileName)
MsgBox(" File Saved in selected path")
FileToDelete = fileName
If System.IO.File.Exists(FileToDelete) = True Then
System.IO.File.Delete(FileToDelete)
End If
End If
FileToDelete = fileName
If System.IO.File.Exists(FileToDelete) = True Then
System.IO.File.Delete(FileToDelete)
End If
when i am trying to save this file in desired path, then i am getting this error.
if save in shared folder i am not getting this error
system.io.ioexception the process cannot access because it is being used by another process...
what i am doing wrong,Help me

vb.net xls to csv with quotes?

I have a xls file, or a csv without quotes, and using vb.net need to turn it into a csv with quotes around every cell. If I open the xls/csv without quotes in MS Access, set every column to text and then export it, its in the format I need. Is there an easier way? If not, how do I do replicate this in vb.net? Thanks.
If you use the .Net OLE DB provider, you can specify the .csv formatting details in a schema.ini file in the folder your data files live in. For the 'unquoted' .csv the specs
should look like
[noquotes.csv] <-- file name
ColNameHeader=True <-- or False
CharacterSet=1252 <-- your encoding
Format=Delimited(,) <--
TextDelimiter= <-- important: no " in source file
Col1=VendorID Integer <-- your columns, of course
Col2=AccountNumber Char Width 15
for the 'quoted' .csv, just change the name and delete the TextDelimiter= line (put quotes around text fields is the default).
Then connect to the Text Database and execute the statement
SELECT * INTO [quotes.csv] FROM [noquotes.csv]
(as this creates quotes.csv, you may want to delete the file before each experimental run)
Added to deal with "Empty fields must be quoted"
This is a VBScript demo, but as the important things are the parameters for .GetString(), you'll can port it to VB easily:
Dim sDir : sDir = resolvePath( "§LibDir§testdata\txt" )
Dim sSrc : sSrc = "noquotes.csv"
Dim sSQL : sSQL = "SELECT * FROM [" & sSrc & "]"
Dim oTxtDb : Set oTxtDb = New cADBC.openDb( Array( "jettxt", sDir ) )
WScript.Echo goFS.OpenTextFile( goFS.BuildPath( sDir, sSrc ) ).ReadAll()
Dim sAll : sAll = oTxtDb.GetSelectFRO( sSQL ).GetString( _
adClipString, , """,""", """" & vbCrlf & """", "" _
)
WScript.Echo """" & Left( sAll, Len( sAll ) - 1 )
and output:
VendorID;AccountNumber;SomethingElse
1;ABC 123 QQQ;1,2
2;IJK 654 ZZZ;2,3
3;;3,4
"1","ABC 123 QQQ","1,2"
"2","IJK 654 ZZZ","2,3"
"3","","3,4"
(german locale, therefore field separator ; and decimal symbol ,)
Same output from this VB.Net code:
Imports ADODB
...
Sub useGetString()
Console.WriteLine("useGetString")
Const adClipString As Integer = 2
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim sAll As String
cn.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=M:\lib\kurs0705\testdata\txt\;" _
& "Extended Properties=""text;"""
cn.Open()
rs = cn.Execute("SELECT * FROM [noquotes.csv]")
sAll = rs.GetString( adClipString, , """,""", """" & vbCrLf & """", "" )
cn.Close()
sAll = """" & Left( sAll, Len( sAll ) - 1 )
Console.WriteLine( sAll )
End Sub
Check out the method at this link.
What you can do to make sure quotes go around is append quotes to the beginning and end of each column data in the loop that is putting the column data in the file.
for example make the loop like this:
For InnerCount = 0 To ColumnCount - 1
Str &= """" & DS.Tables(0).Rows(OuterCount).Item(InnerCount) & ""","
Next
Public Class clsTest
Public Sub Test
Dim s as string = "C:\!Data\Test1.csv"
Dim Contents As String = System.IO.File.ReadAllText(s)
Dim aryLines As String() = Contents.Split(New String() { Environment.Newline }, StringSplitOptions.None)
Dim aryParts() As String
Dim aryHeader() As String
Dim dt As System.Data.DataTable
For i As Integer = 0 To aryLines.Length - 1
aryParts = SplitCSVLine(aryLines(i))
If dt Is Nothing And aryHeader Is Nothing Then
aryHeader = CType(aryParts.Clone, String())
ElseIf dt Is Nothing And aryHeader IsNot Nothing Then
dt = DTFromStringArray(aryParts, 1000, "", aryHeader)
Else
DTAddStringArray(dt, aryParts)
End If
Next
dt.dump
End Sub
Public Shared Function SplitCSVLine(strCSVQuotedLine As String) As String()
Dim aryLines As String() = strCSVQuotedLine.Split(New String() {Environment.NewLine}, StringSplitOptions.None)
Dim aryParts As String() = Nothing
For i As Integer = 0 To aryLines.Length - 1
Dim regx As New Text.RegularExpressions.Regex(",(?=(?:[^\""]*\""[^\""]*\"")*(?![^\""]*\""))")
aryParts = regx.Split(aryLines(i))
For p As Integer = 0 To aryParts.Length - 1
aryParts(p) = aryParts(p).Trim(" "c, """"c)
Next
Next
Return aryParts
End Function
Public Shared Function DTFromStringArray(ByVal aryValues() As String, Optional ByVal intDefaultColumnWidth As Integer = 255, Optional ByVal strTableName As String = "tblArray", Optional ByVal aryColumnNames() As String = Nothing) As DataTable
If String.IsNullOrWhiteSpace(strTableName) Then strTableName = "tblArray"
Dim dt As DataTable = New DataTable(strTableName)
Dim colNew(aryValues.GetUpperBound(0)) As DataColumn
If aryColumnNames Is Nothing Then
ReDim aryColumnNames(aryValues.Length)
Else
If aryColumnNames.GetUpperBound(0) < aryValues.GetUpperBound(0) Then
ReDim Preserve aryColumnNames(aryValues.Length)
End If
End If
For x As Integer = aryColumnNames.GetLowerBound(0) To aryColumnNames.GetUpperBound(0)
If String.IsNullOrWhiteSpace(aryColumnNames(x)) Then
aryColumnNames(x) = "Field" & x.ToString
Else
aryColumnNames(x) = aryColumnNames(x)
End If
Next
For i As Integer = 0 To aryValues.GetUpperBound(0)
colNew(i) = New DataColumn
With colNew(i)
.ColumnName = aryColumnNames(i) '"Value " & i
.DataType = GetType(String)
.AllowDBNull = False
.DefaultValue = ""
.MaxLength = intDefaultColumnWidth
.Unique = False
End With
Next
dt.Columns.AddRange(colNew)
Dim pRow As DataRow = dt.NewRow
For i As Integer = aryValues.GetLowerBound(0) To aryValues.GetUpperBound(0)
pRow.Item(i) = aryValues(i)
Next
dt.Rows.Add(pRow)
Return dt
End Function
Public Shared Sub DTAddStringArray(ByRef dt As DataTable, ByVal aryRowValues() As String)
Dim pRow As DataRow
pRow = dt.NewRow
For i As Integer = aryRowValues.GetLowerBound(0) To aryRowValues.GetUpperBound(0)
pRow.Item(i) = aryRowValues(i)
Next
dt.Rows.Add(pRow)
End Sub
End Class