Hello,
I am trying to figure out how to do a synchronization between two computers thanks to robocopy in a VB app in order to have a progress bar that shows the process state
I have found this code that fit perfectly my need but when I put the TransferData() function in a loop, no matter what i change, it always give me the same error.
The BeginOutputReadLine tries to access an open file
Can someone help me with this ?
Imports System
Imports System.IO
Imports System.Diagnostics
Imports System.Threading
Imports System.Windows.Forms
Imports Microsoft.Win32
Imports Microsoft.VisualBasic
Public Class MyRoboCopy
#Region "variables"
Delegate Sub SetTextInTextBox1Callback(ByVal value As String)
Delegate Sub SetTextInTextBox2Callback(ByVal Value As String)
Delegate Sub SetTextInTextBox3Callback(ByVal value As String)
Delegate Sub SetProgressBar1Callback(ByVal value As Integer)
Private Declare Function DrawMenuBar Lib "user32.dll" _
(ByVal hwnd As IntPtr) As IntPtr
Private Declare Function GetSystemMenu Lib "user32.dll" _
(ByVal hwnd As IntPtr, ByVal bRevert As Int32) As IntPtr
Private Declare Function GetMenuItemCount Lib "user32.dll" _
(ByVal hMenu As IntPtr) As Int32
Private Declare Function RemoveMenu Lib "user32.dll" _
(ByVal hMenu As IntPtr, _
ByVal nPosition As Int32, _
ByVal wFlags As Int32) _
As Int32
Private Const MF_BYPOSITION As Int32 = &H400I
Private Const MF_REMOVE As Int32 = &H1000I
Private Directory As String
Private fs As FileStream
Private sw As StreamWriter
Private lineNumber As Integer = 0
Private eventHandled As Boolean
Private WithEvents myProcess As New Process
Public Event Exited As EventHandler
Dim WriteEndLines As Boolean = False
Dim NeedToSetText As Boolean = False
#End Region
#Region "Fonction lecture du fichier ini"
Private Declare Function GetPrivateProfileSection Lib "kernel32.dll" Alias "GetPrivateProfileSectionA" _
(ByVal lpAppName As String, _
ByVal lpReturnedBuffer As String, _
ByVal nSize As Integer, _
ByVal lpFileName As String) _
As Integer
Private Declare Ansi Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As System.Text.StringBuilder, _
ByVal nSize As Integer, _
ByVal lpFileName As String) _
As Integer
Private Declare Function GetPrivateProfileInt Lib "kernel32.dll" Alias "GetPrivateProfileIntA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal nDefault As Integer, _
ByVal lpFileName As String) _
As Integer
Public Function ReadValue(ByVal section As String, ByVal key As String, ByVal Path As String) As String
Dim sb As New System.Text.StringBuilder(255)
Dim i = GetPrivateProfileString(section, key, "null", sb, 255, Path)
Return sb.ToString()
End Function
#End Region
Public Function ReadIni(ByVal iniPath As String) As Integer
Dim nombre_section As Integer
nombre_section = 1
Dim nom_synchro As String
Dim ouvert As Boolean = True
'Compte le nombre de synchro à réaliser
While ouvert
Dim retour As String, a As Integer
nom_synchro = "Synchro_" & nombre_section
retour = ""
a = GetPrivateProfileSection(nom_synchro, retour, 255, iniPath)
If a = 0 Then
nombre_section -= 1
ouvert = False
Else
nombre_section += 1
End If
End While
'MessageBox.Show(nombre_section)
'pour chaque synchro
For indexA As Integer = 1 To nombre_section
nom_synchro = "Synchro_" & indexA
Dim source As String
Dim destination As String
Dim selection_fichier As String
Dim options As New List(Of String)
Dim opti As String
source = ReadValue(nom_synchro, "dossier_source", iniPath)
destination = ReadValue(nom_synchro, "dossier_destinataire", iniPath)
selection_fichier = ReadValue(nom_synchro, "selection_fichier", iniPath)
If (source Is "null") Then
MessageBox.Show("Erreur :Pas de fichier source")
End If
If (destination Is "null") Then
MessageBox.Show("Erreur : Pas de fichier destination")
End If
If (selection_fichier Is "null") Then
MessageBox.Show("Erreur : Pas de type de fichier à selectionner")
End If
'MessageBox.Show("fichier source : " & source & "\n destinataire :" & destination & "\n type fichier : " & selection_fichier)
If GetPrivateProfileInt(nom_synchro, "ajouter_repertoire_vide", -1, iniPath) = 1 Then
opti = " /E"
options.Add(opti)
Else
opti = " /S"
options.Add(opti)
End If
If GetPrivateProfileInt(nom_synchro, "ajuster_heure_ete", -1, iniPath) = 1 Then
opti = " /DST"
options.Add(opti)
End If
'For Each optio As String In options
' MessageBox.Show(nom_synchro & " - " & optio)
'Next
TextBox1.Text = "Realise la copie"
TextBox2.Text = "Fichier source : " & source & " \n Fichier destination : " & destination
Application.DoEvents()
Next indexA
Return Nothing
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StartButton.Click
If StartButton.Text = "Start" Then
Application.DoEvents()
ExitButton.Enabled = False
StartButton.Text = "Cancel"
WorkingLabel.Visible = True
WorkingBar.Visible = True
WorkingBar.Minimum = 0
WorkingBar.Maximum = 100
Dim hMenu As IntPtr = GetSystemMenu(MyBase.Handle, CInt(False)) 'Disable Close (X) Button
Dim nCount As Int32 = GetMenuItemCount(hMenu) 'Disable Close (X) Button
If nCount > 2 Then
RemoveMenu(hMenu, nCount - 1, MF_REMOVE Or MF_BYPOSITION)
RemoveMenu(hMenu, nCount - 2, MF_REMOVE Or MF_BYPOSITION)
DrawMenuBar(MyBase.Handle)
End If
TransferData()
ElseIf StartButton.Text = "Cancel" Then
Dim rProcess() As Process = Process.GetProcessesByName("Robocopy")
For Each r As Process In rProcess
r.Kill()
Next
Application.Exit()
End If
End Sub
Public Sub TransferData()
For index As Integer = 1 To 3
AddHandler myProcess.OutputDataReceived, AddressOf _DataReceivedEventHandler
AddHandler myProcess.Exited, AddressOf myProcess_Exited
Dim iniPath As String
iniPath = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Download_data_site", "path_ini_file", Nothing)
With myProcess.StartInfo
.FileName = "C:\windows\system32\robocopy.exe"
.Arguments = "D:\log_pyxis\Project_" & index & "\debasedMode D:\log_pyxis_copie\Project_" & index & "\debasedMode *.* /e /ETA /NFL /NJH"
.WorkingDirectory = "D:\log_pyxis_copie\Project_" & index
.WindowStyle = ProcessWindowStyle.Hidden
.CreateNoWindow = True
.UseShellExecute = False
.RedirectStandardOutput = True
End With
myProcess.EnableRaisingEvents = True
myProcess.Start()
TextBox1.Text = ("Performing Backup.")
CheckForIllegalCrossThreadCalls = False
fs = New FileStream(myProcess.StartInfo.WorkingDirectory & "\" & "Robocopy.log", FileMode.Append, FileAccess.Write)
sw = New StreamWriter(fs)
myProcess.BeginOutputReadLine()
eventHandled = False
Next
End Sub
Public Sub _DataReceivedEventHandler(ByVal sender As Object, ByVal e As DataReceivedEventArgs)
If WriteEndLines Then sw.WriteLine(e.Data)
If NeedToSetText Then SetTextInTextBox2(Directory)
If eventHandled = True Then
myProcess.Close()
sw.Close()
fs.Close()
Exit Sub
Else
If myProcess.HasExited = True Then
myProcess.Close()
sw.Close()
fs.Close()
Exit Sub
End If
End If
lineNumber += 1
Dim dataValue As String = e.Data.ToString
If lineNumber = 2 Then
sw.WriteLine("-------------------------------------------------------------------------------")
ElseIf lineNumber = 3 Then
sw.WriteLine("Currently Logged On: " & My.User.Name)
sw.Flush()
End If
If lineNumber >= 4 And lineNumber <= 17 Then
sw.WriteLine(e.Data)
sw.Flush()
ElseIf lineNumber >= 18 Then
If e.Data.Contains("*EXTRA File") Then
NeedToSetText = True
SetTextInTextBox3("Deleted: " & e.Data.Substring(e.Data.LastIndexOf(vbTab) + 1))
ElseIf e.Data.Contains("*EXTRA Dir") Then
NeedToSetText = True
SetTextInTextBox2("Deleted: " & e.Data.Substring(e.Data.LastIndexOf(vbTab) + 28))
ElseIf e.Data.Contains("ERROR") Then
sw.WriteLine(e.Data)
sw.Flush()
StartButton.Enabled = False
Dim Result As DialogResult
Result = MessageBox.Show("MyRoboCopy has encountered an error and will now exit. Please try again and if the error continues contact the Helpdesk.", "MyRoboCopy Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
If Result = System.Windows.Forms.DialogResult.OK Then
Dim rProcess() As Process = Process.GetProcessesByName("Robocopy")
For Each r As Process In rProcess
r.Kill()
Next
Application.Exit()
End If
ElseIf e.Data.Contains("C:\") Then
Directory = e.Data.Substring(e.Data.IndexOf("C:\"))
SetTextInTextBox2(e.Data.Substring(e.Data.LastIndexOf(vbTab) + 1))
SetTextInTextBox3("")
SetProgressBar1(0)
ElseIf dataValue.Contains("%"c) Then
Dim s() As String = dataValue.Split("%"c)
Dim numericString As String = s(0)
Dim numeric As Double = 0.0
Double.TryParse(numericString, numeric)
Dim result As Integer = Convert.ToInt32(numeric)
SetProgressBar1(result)
ElseIf e.Data.Contains("Newer") Then
NeedToSetText = True
SetTextInTextBox3("Updating: " & e.Data.Substring(e.Data.LastIndexOf(vbTab) + 1))
ElseIf e.Data.Contains("New File") Then
NeedToSetText = True
SetTextInTextBox3(e.Data.Substring(e.Data.LastIndexOf(vbTab) + 1))
ElseIf e.Data.Contains("------------------------------------------------------------------------------") Then
WriteEndLines = True
End If
End If
End Sub
Private Sub SetTextInTextBox2(ByVal value As String) 'Directory
If Me.TextBox2.InvokeRequired Then
Dim l As New SetTextInTextBox1Callback(AddressOf SetTextInTextBox2)
Me.BeginInvoke(l, New Object() {"Directory: " & value})
Else
Me.TextBox2.Text = value
End If
End Sub
Private Sub SetTextInTextBox3(ByVal value As String) 'File
If Me.TextBox3.InvokeRequired Then
Dim d As New SetTextInTextBox3Callback(AddressOf SetTextInTextBox3)
Me.BeginInvoke(d, New Object() {"File: " & value})
Else
Me.TextBox3.Text = value
End If
End Sub
Private Sub SetProgressBar1(ByVal progress As Integer)
If Me.ProgressBar1.InvokeRequired Then
Dim p As New SetProgressBar1Callback(AddressOf SetProgressBar1)
Me.BeginInvoke(p, New Object() {progress})
Else
Me.ProgressBar1.Value = progress
End If
End Sub
Private Sub SetTextBox1OnExit(ByVal value As String)
If Me.TextBox1.InvokeRequired Then
Dim t As New SetTextInTextBox1Callback(AddressOf SetTextBox1OnExit)
Me.BeginInvoke(t, New Object() {value})
Else
Me.TextBox1.Text = value
End If
End Sub
Private Sub myProcess_Exited(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles myProcess.Exited
eventHandled = True
TextBox1.Text = "Backup Complete."
ProgressBar1.Value = 0
TextBox2.Text = ""
TextBox3.Text = ""
WorkingLabel.Visible = False
WorkingBar.Visible = False
WorkingBar.Value = 0
StartButton.Text = "Start"
StartButton.Enabled = False
ExitButton.Enabled = True
GetSystemMenu(MyBase.Handle, CInt(True)) 'Enable Close (X) Button
DrawMenuBar(MyBase.Handle) 'Enable Close (X) Button
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ExitButton.Click
Application.Exit()
End Sub
'Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'End Sub
End Class