module.vb

'------------------------------------------------------
'| Projet         |  SyncMX                           |
'| Contexte       |         Perso                     |
'| Date           |                        10/03/2006 |
'| Release 1      |                        20/11/2006 |
'| Release 2      |                        06/11/2007 |
'| Update 3       |                        19/12/2007 |
'| Update 4       |                        22/01/2008 |
'| Update 5       |                        12/02/2008 |
'| Update 6       |                        20/03/2008 |
'| Update 7       |                        05/02/2009 |
'| Update 8       |                        21/11/2009 |
'| Auteur         |                          Couitchy |
'|----------------------------------------------------|
'| Modifications :                                    |
'| - gestion mises à jour automatiques     06/11/2007 |
'| - gestion des fichiers en lecture seule 11/03/2008 |
'| - gestion des exécutions multiples      13/03/2008 |
'| - gestion progressbar dans taskbar Win7 13/02/2010 |
'| - téléchargement auto des dépendances   05/04/2010 |
'| - gestion des liens symboliques         15/03/2022 |
'------------------------------------------------------
Imports System.IO
Imports System.Text
Imports System.Xml.Serialization
Imports Shell32
Imports System.Net
Imports System.ComponentModel
Imports System.Diagnostics
Imports Microsoft.Win32
Imports Win7Taskbar
Public Class clsModule
    Public Declare Function GetPrivateProfileString   Lib "kernel32" Alias "GetPrivateProfileStringA" (lpApplicationName As String, lpKeyName As String, lpDefault As String, lpReturnedString As StringBuilder, nSize As Integer, lpFileName As String) As Integer
    Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA"(lpApplicationName As String, lpKeyName As String, lpString As String, ByVal lpFileName As String) As Integer
    Public Declare Function OpenIcon                  Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function SetForegroundWindow       Lib "user32" (ByVal hwnd As Long) As Long
    Public Const  CgCodeLines As Integer        = 4987
    Public Const  CgINIFile As String           = "\SyncMX.ini"
    Public Const  CgRulesFile As String         = "\SyncMX.cfg"
    Public Const  CgLOGFile As String           = "\SyncMX.log"
    Public Const  CgCHMFile As String           = "\SyncMX.chm"
    Public Const  CgUpDFile As String           = "\SyncMX.new"
    Public Const  CgHSTFile As String           = "\Historique.txt"
    Public Const  CgUpdater As String           = "\Updater.exe"
    Public Const  CgURL1 As String              = "http://couitchy.free.fr/upload/SyncMX/Updates/TimeStamp.txt"
    Public Const  CgURL2 As String              = "http://couitchy.free.fr/upload/SyncMX/Updates/SyncMX.new"
    Public Const  CgURL3 As String              = "http://couitchy.free.fr/upload/SyncMX/Updates/Historique.txt"
    Public Const  CgURL4 As String              = "http://couitchy.free.fr/upload/SyncMX/Lib/"
    Public Const  CgShellRegKey As String       = "SyncMXShell"
    Public Const  CgShellText As String         = "Synchroniser avec SyncMX"
    Public Const  CgRecent As String            = "Recents"
    Public Const  CgRacine As String            = "Racine"
    Public Const  CgSeuilSimil As Double        = 0.5
    Public Const  CgSeuilRatio As Single        = 0.1
    Public Const  CgInteraction As Long         = &H400
    Public Shared CgRequiredFiles() As String   = {"\Win7Taskbar.dll", "\SandBar.dll", "\SourceGrid2.dll", "\SourceLibrary.dll", "\Interop.Shell32.dll", "\SharpCompress.dll", CgINIFile, CgUpdater, CgCHMFile}
    Public Shared VgShell As New Shell32.ShellClass
    Public Shared VgRemoteDate As Date
    Public Shared VgCancel As Boolean
    Public Shared WithEvents VgTray As NotifyIcon
    Public Shared WithEvents VgTimer As Timer
    Public Shared WithEvents VgClient As New WebClient
    Public Shared Sub RecurSearch(VpCurDir As DirectoryInfo, VpRoot As String, ByRef VpListe As ArrayList, VpIgnoreSymlink As Boolean, VpBar As ProgressBar)
    '-------------------------------------------------
    'Parcourt récursif des répertoires et des fichiers
    '-------------------------------------------------
        Application.DoEvents
        'Fichiers dans le répertoire en cours
        If (Not VpCurDir.Exists) Or ((VpCurDir.Attributes And FileAttributes.ReparsePoint) And VpIgnoreSymlink) Or VgCancel Then Exit Sub
        For Each VpFile As FileInfo In VpCurDir.GetFiles
            Try
                VpListe.Add(New clsFile(VpFile, VpRoot))
            Catch
                Call clsModule.ShowWarning("Erreur de lecture sur le fichier" + vbCrLf + VpFile.FullName)
            End Try
        Next VpFile
        'Répertoires dans le répertoire en cours
        For Each VpDir As DirectoryInfo In VpCurDir.GetDirectories
            If (VpDir.Attributes And FileAttributes.System) <> FileAttributes.System Then
                Call RecurSearch(VpDir, VpRoot, VpListe, VpIgnoreSymlink, VpBar)
                Call GestBar(VpBar)
            End If
        Next VpDir
    End Sub
    Public Shared Function CountDirectories(VpCurDir As DirectoryInfo, Optional VpIsRoot As Boolean = True) As Integer
    '---------------------------------
    'Parcourt récursif des répertoires
    '---------------------------------
    Static VpCount As Integer   'Compteur répertoire
        Application.DoEvents
        If (Not Options.VgSettings.Progression) Or VgCancel Then Return 0
        'Réinitialisation du compteur
        If VpIsRoot Then
            VpCount = 0
        End If
        'Gestion des "faux" dossiers
        If Not VpCurDir.Exists Then Exit Function
        'Répertoires dans le répertoire en cours
        For Each VpDir As DirectoryInfo In VpCurDir.GetDirectories
            If (VpDir.Attributes And FileAttributes.System) <> FileAttributes.System Then
                Call CountDirectories(VpDir, False)
                VpCount = VpCount + 1
            End If
        Next VpDir
        Return VpCount
    End Function
    Public Shared Sub GestBar(VpBar As ProgressBar, Optional VpMax As Integer = -1, Optional VpMarquee As Boolean = False)
    '----------------------------
    'Gestion barre de progression
    '----------------------------
        If Not Options.VgSettings.Progression Then Exit Sub
        If VpMax <> -1
            VpBar.Maximum = VpMax
            MainForm.VgMe.VgBar.Maximum = VpMax
            VpBar.Value = 0
            MainForm.VgMe.VgBar.Value = 0
            VpBar.Style = ProgressBarStyle.Blocks
            MainForm.VgMe.VgBar.Style = ProgressBarStyle.Blocks
            VpBar.Visible = True
            MainForm.VgMe.VgBar.ShowInTaskbar = True
        Else
            If VpMarquee Then
                VpBar.Style = ProgressBarStyle.Marquee
                MainForm.VgMe.VgBar.Style = ProgressBarStyle.Marquee
                VpBar.Visible = True
                MainForm.VgMe.VgBar.ShowInTaskbar = True
            Else
                If VpBar.Style = ProgressBarStyle.Marquee Then
                    VpBar.Style = ProgressBarStyle.Blocks
                    MainForm.VgMe.VgBar.Style = ProgressBarStyle.Blocks
                End If
                VpBar.Increment(1)
                MainForm.VgMe.VgBar.Increment(1)
            End If
        End If
    End Sub
    Public Shared Sub SetTip(VpControl As Control, VpText As String)
    '----------------------------------------------------
    'Insère un tooltip sur le contrôle passé en paramètre
    '----------------------------------------------------
    Dim VpToolTip As New ToolTip
        VpToolTip.SetToolTip(VpControl, VpText)
    End Sub
    Public Shared Function GetPathFromNode(VpNode As TreeNode) As String
    '------------------------------------------------------
    'Reconstruit le chemin absolu à partir du noeud courant
    '------------------------------------------------------
    Dim VpPath As String = ""
        While VpNode.Text <> clsModule.CgRacine
            VpPath = VpNode.Text + "\" + VpPath
            VpNode = VpNode.Parent
        End While
        Return VpPath
    End Function
    Public Shared Function IsDescendent(VpNode As TreeNode, VpSearchNode As TreeNode) As Boolean
    '------------------------------------------------------------------------------------------------------------
    'Regarde si Node est un descendant de SearchNode, ie. SearchNode est-il présent dans les ascendants de Node ?
    '------------------------------------------------------------------------------------------------------------
    Dim VpCurNode As TreeNode = VpNode
        Do
            If VpCurNode Is VpSearchNode Then
                Return True
            Else
                VpCurNode = VpCurNode.Parent
            End If
        Loop Until VpCurNode Is Nothing
        Return False
    End Function
    Public Shared Function Matching(VpStr As String) As Object
    '-------------------------------------------
    'Adapte une chaîne en un type plus approprié
    '-------------------------------------------
        If VpStr = "True" Then
            Return True
        ElseIf VpStr = "False" Then
            Return False
        ElseIf VpStr = "Normal" Then
            Return FormWindowState.Normal
        ElseIf VpStr = "Maximized" Then
            Return FormWindowState.Maximized
        ElseIf VpStr = "Minimized" Then
            Return FormWindowState.Minimized
        ElseIf VpStr = "DateModification" Then
            Return Options.eCritere.DateModification
        ElseIf VpStr = "TailleFichier" Then
            Return Options.eCritere.TailleFichier
        ElseIf IsNumeric(VpStr)
            Return CInt(VpStr)
        Else
            Return VpStr
        End If
    End Function
    Public Shared Function Matching8Name(VpPath As String) As String
    '-------------------------------------------------------------
    'Retourne un nom de répertoire ancien format en nouveau format
    '-------------------------------------------------------------
    Dim VpDirName As DirectoryInfo
        If VpPath.IndexOf("~") >= 0 Then
            VpDirName = New DirectoryInfo(VpPath)
            Return VpDirName.FullName
        Else
            Return VpPath.Replace("""", "")
        End If
    End Function
    Public Shared Sub LOGWrite(VpStr As String)
    '------------------------
    'Ecriture dans le journal
    '------------------------
    Dim VpLog As New IO.StreamWriter(Application.StartupPath + CgLOGFile, True)
        VpLog.Write(DateTime.Now + "    " + VpStr + vbCrLf)
        VpLog.Close
    End Sub
    Public Shared Function LOGRead As String
    '-----------------------
    'Lecture dans le journal
    '-----------------------
    Dim VpLog As IO.StreamReader
    Dim VpStr As String = ""
        If IO.File.Exists(Application.StartupPath + CgLOGFile) Then
            VpLog = New IO.StreamReader(Application.StartupPath + CgLOGFile)
            VpStr = VpLog.ReadToEnd
            VpLog.Close
        End If
        Return VpStr
    End Function
    Public Shared Function LOGParse As Dictionary(Of DateTime, PointF)
    Dim VpVolume As New Dictionary(Of DateTime, PointF)
    Dim VpLog As IO.StreamReader
    Dim VpStr As String
    Dim VpDate As DateTime
    Dim VpCount As Integer
    Dim VpMBytes As Single
    Dim VpPoint As PointF
        If IO.File.Exists(Application.StartupPath + CgLOGFile) Then
            VpLog = New IO.StreamReader(Application.StartupPath + CgLOGFile)
            While Not VpLog.EndOfStream
                VpStr = VpLog.ReadLine
                If VpStr.Contains("à traiter, pour un total de") Then
                    VpDate = DateTime.Parse(VpStr.Substring(0, 10))
                    VpCount = Val(VpStr.Substring(25))
                    VpMBytes = Val(VpStr.Substring(VpStr.IndexOf("à traiter, pour un total de") + 28))
                    If VpStr.EndsWith("Ko.") Then
                        VpMBytes /= 1024
                    End If
                    If VpMBytes > 10000 Then
                        VpMBytes = 0    'on ignore les volumes > 10 Go qui ne sont en fait pas réels (probablement des synchronisations partielles non traitées)
                    End If
                    If Not VpVolume.ContainsKey(VpDate) Then
                        VpVolume.Add(VpDate, New PointF(CSng(VpCount), VpMBytes))
                    Else
                        VpPoint = VpVolume.Item(VpDate)
                        VpVolume.Item(VpDate) = New PointF(VpPoint.X + CSng(VpCount), VpPoint.Y + VpMBytes)
                    End If
                End If
            End While
            VpLog.Close
        End If
        Return VpVolume
    End Function
    Public Shared Sub IntegrationShell(VpIntegrate As Boolean)
    '--------------------------------------------------------------------------------------
    'Gestion de l'intégration de SyncMX dans les menus contextuels de l'Explorateur Windows
    '--------------------------------------------------------------------------------------
    Dim VpKey As RegistryKey = Registry.ClassesRoot
    Dim VpIntegrated As Boolean
        VpKey = VpKey.OpenSubKey("Folder").OpenSubKey("shell", True)
        VpIntegrated = Not (VpKey.OpenSubKey(CgShellRegKey) Is Nothing)
        'Si l'intégration n'est pas faite et qu'il faut la faire
        If VpIntegrate And Not VpIntegrated Then
            VpKey = VpKey.CreateSubKey(CgShellRegKey)
            VpKey.SetValue("", CgShellText)
            VpKey = VpKey.CreateSubKey("command")
            VpKey.SetValue("", Application.ExecutablePath + " ""%1""")
        'Si l'intégration est faite et qu'il ne faut pas la faire
        ElseIf VpIntegrated And Not VpIntegrate Then
            VpKey.DeleteSubKeyTree(CgShellRegKey)
        End If
    End Sub
    Public Shared Function PreventMultipleInstance(VpInteraction As clsInteraction) As Boolean
    '-----------------------------------------------------------------------------------------------------------------
    'Vérifie si une instance de SyncMX est déjà en cours d'exécution, renvoie True si la nouvelle instance doit fermer
    '-----------------------------------------------------------------------------------------------------------------
    Dim VmHandle As Long
    Dim VmProcesses() As Process
        VmProcesses = Process.GetProcessesByName(Process.GetCurrentProcess.ProcessName)
        For Each VpProcess As Process In VmProcesses
            If VpProcess.Id <> Process.GetCurrentProcess.Id Then
                VmHandle = VpProcess.MainWindowHandle.ToInt32
                Call OpenIcon(VmHandle)
                Call SetForegroundWindow(VmHandle)
                'Si SyncMX a été lancé par un menu contextuel de l'Explorateur Windows, inscrit le répertoire à synchroniser
                If Environment.GetCommandLineArgs.Length > 1 Then
                    VpInteraction.PostMsg(VmHandle, clsModule.CgInteraction, 0, Environment.GetCommandLineArgs(1))
                End If
                Return True
            End If
        Next VpProcess
        Return False
    End Function
    Public Shared Sub CheckForUpdates(Optional VpExplicit As Boolean = False)
    '------------------------------------------------------------------
    'Vérifie si une mise à jour du logiciel est disponible sur Internet
    '------------------------------------------------------------------
    Dim VpRequest As HttpWebRequest
    Dim VpAnswer As Stream
    Dim VpBuf(0 To 18) As Byte
    Dim VpOldText As String
        VpOldText = MainForm.VgMe.StatusTextGet
        Call MainForm.VgMe.StatusText("Vérification des mises à jour...")
        'Fichier d'historique des versions
        Call clsModule.DownloadUpdate(New Uri(clsModule.CgURL3), clsModule.CgHSTFile)
        Try
            VpRequest = WebRequest.Create(CgURL1)
            VpAnswer = VpRequest.GetResponse().GetResponseStream()
            'Lecture du fichier horodaté sur Internet
            VpAnswer.Read(VpBuf, 0, 19)
            VgRemoteDate = CDate(New ASCIIEncoding().GetString(VpBuf))
            'Si version plus récente
            If DateTime.Compare(File.GetLastWriteTimeUtc(Application.ExecutablePath), VgRemoteDate) < 0 Then
                VgTray.Visible = True
                VgTray.ShowBalloonTip(10, "SyncMX", "Une mise à jour de l'application est disponible..." + vbCrLf + "Cliquer ici pour la télécharger, quitter SyncMX et l'installer.", ToolTipIcon.Info)
            ElseIf VpExplicit Then
                Call clsModule.ShowInformation("Vous disposez déjà de la dernière version de SyncMX !")
            End If
        Catch
            'En cas d'échec de connexion, inutile de continuer à checker
            VgTimer.Stop
            If VpExplicit Then
                Call clsModule.ShowWarning("La connexion au serveur a échoué..." + vbCrLf + "Vérifier la connectivité à Internet et les paramètres du pare-feu.")
            End If
        End Try
        Call MainForm.VgMe.StatusText(VpOldText)
    End Sub
    Public Shared Sub NotifyIconBalloonTipClosed(ByVal sender As Object, ByVal e As EventArgs) Handles VgTray.BalloonTipClosed
        VgTray.Visible = False
    End Sub
    Public Shared Sub NotifyIconBalloonTipClicked(ByVal sender As Object, ByVal e As EventArgs) Handles VgTray.BalloonTipClicked
        VgTray.Visible = False
        VgTimer.Stop
        Call DownloadUpdate(New Uri(CgURL2), CgUpDFile)
    End Sub
    Public Shared Sub TimerTick(ByVal sender As Object, ByVal e As EventArgs) Handles VgTimer.Tick
        Call CheckForUpdates
        VgTimer.Stop
    End Sub
    Public Shared Function CheckIntegrity As Boolean
    '------------------------------------
    'Vérifie l'intégrité de l'application
    '------------------------------------
        For Each VpFile As String In clsModule.CgRequiredFiles
            'Si le fichier n'existe pas
            If Not File.Exists(Application.StartupPath + VpFile) Then
                'Essaie de le télécharger
                Call clsModule.DownloadNow(New Uri(CgURL4 + VpFile.Replace("\", "")), VpFile)
                'Si le fichier n'existe toujours pas, on ne démarre pas
                If Not File.Exists(Application.StartupPath + VpFile) Then
                    Call clsModule.LOGWrite("SyncMX n'a pas pu démarrer correctement (impossible de trouver " + VpFile + ").")
                    Call clsModule.ShowWarning("Des fichiers nécessaires à l'exécution sont manquants..." + vbCrLf + "Consultez le fichier journal pour plus de détails.")
                    Return False
                Else
                    Call clsModule.LOGWrite("SyncMX a dû télécharger une dépendance : " + VpFile)
                End If
            End If
        Next VpFile
        Return True
    End Function
    Public Shared Sub DownloadNow(VpURI As System.Uri, VpOutput As String)
    '----------------------------------------------------------------------------
    'Télécharge immédiatement l'application mise à jour ou une de ses dépendances
    '----------------------------------------------------------------------------
        Try
            VgClient.DownloadFile(VpURI, Application.StartupPath + VpOutput)
        Catch
        End Try
    End Sub
    Public Shared Sub DownloadUpdate(VpURI As System.Uri, VpOutput As String)
    '------------------------------------
    'Télécharge l'application mise à jour
    '------------------------------------
        Call MainForm.VgMe.StatusText("Téléchargement en cours")
        Try
            VgClient.DownloadFileAsync(VpURI, Application.StartupPath + VpOutput)
        Catch
        End Try
    End Sub
    Public Shared Sub ClientDownloadProgressChanged(ByVal sender As Object, ByVal e As DownloadProgressChangedEventArgs) Handles VgClient.DownloadProgressChanged
        If Not MainForm.VgMe.IsBusy Then
            MainForm.VgMe.prgAvance.Maximum = 100
            MainForm.VgMe.VgBar.Maximum = 100
            MainForm.VgMe.prgAvance.Value = e.ProgressPercentage
            MainForm.VgMe.VgBar.Value = e.ProgressPercentage
            MainForm.VgMe.prgAvance.Visible = True
            MainForm.VgMe.VgBar.ShowInTaskbar = True
        End If
    End Sub
    Public Shared Sub ClientDownloadFileCompleted(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs) Handles VgClient.DownloadFileCompleted
    '----------------------------------
    'Installe l'application mise à jour
    '----------------------------------
        MainForm.VgMe.prgAvance.Visible = False
        MainForm.VgMe.VgBar.ShowInTaskbar = False
        Call MainForm.VgMe.StatusText("Téléchargement terminé")
        If File.Exists(Application.StartupPath + clsModule.CgUpDFile) Then
            File.SetLastWriteTimeUtc(Application.StartupPath + CgUpDFile, VgRemoteDate)
            While MainForm.VgMe.IsBusy
                Application.DoEvents
            End While
            Process.Start(New ProcessStartInfo(Application.StartupPath + CgUpdater))
        End If
    End Sub
    Public Shared Function GetListeString(VpListe As ArrayList) As String()
    Dim VpOut As String()
        If VpListe.Count > 0 Then
            ReDim VpOut(0)
            For Each VpFile As clsFile In VpListe
                VpOut(UBound(VpOut)) = VpFile.Nom.ToUpper
                ReDim Preserve VpOut(UBound(VpOut) + 1)
            Next VpFile
            ReDim Preserve VpOut(UBound(VpOut) - 1)
            Return VpOut
        Else
            Return Nothing
        End If
    End Function
    Public Shared Function CheckSources(VpOwner As MainForm, Vp1 As Integer, Vp2 As Integer) As Boolean
    '---------------------------------------------------------------------------------------------------------------------
    'Vérifie la disparité entre les deux sources (1ère synchronisation, branchement oublié) et suggestions à l'utilisateur
    '---------------------------------------------------------------------------------------------------------------------
    Dim VpStr As String = ""
    Dim VpBig As String = "1"
    Dim VpSmall As String = "2"
    Dim VpRatio As Single
    Dim VpAsk As Boolean = False
        If Vp1 = 0 Or Vp2 = 0 Then
            If Vp1 = 0 Then
                VpSmall = "1"
                VpBig = "2"
            End If
            VpStr = "Aucun fichier n'a été détecté sur la source " + VpSmall + " :"
            VpAsk = True
        Else
            VpRatio = Vp2 / Vp1
                If VpRatio > 1 Then
                    VpBig = "2"
                    VpSmall = "1"
                    VpRatio = 1 / VpRatio
                End If
                If VpRatio < CgSeuilRatio Then
                    VpStr = "Un nombre beaucoup plus important de fichiers a été détecté sur la source " + VpBig + " que sur la source " + VpSmall + " :"
                    VpAsk = True
                End If
        End If
        If VpAsk Then
            If ShowQuestion(VpStr + vbCrLf + "- s'il s'agit de votre première synchronisation, il est recommandé d'effectuer la première copie de manière classique depuis l'Explorateur Windows" + vbCrLf + "- sinon, vérifier que le répertoire cible existe et est bien le bon" + vbCrLf + "Poursuivre tout de même sous SyncMX ?") = DialogResult.Yes Then
                Return True
            Else
                If ShowQuestion("Voulez-vous ouvrir la source " + VpBig + " dans l'Explorateur Windows ?") = DialogResult.Yes Then
                    If VpBig = "1" Then
                        VgShell.Explore(VpOwner.cboSource1.Text.Trim)
                    Else
                        VgShell.Explore(VpOwner.cboSource2.Text.Trim)
                    End If
                    Return False
                End If
            End If
        Else
            Return True
        End If
    End Function
    Public Shared Sub AddToPermanentRules(VpFile As clsFile)
    '------------------------------------------------------------------------------
    'Ajoute la règle spécifiée du fichier spécifié à la base des règles permanentes
    '------------------------------------------------------------------------------
    Dim VpCfg As New StreamWriter(Application.StartupPath + clsModule.CgRulesFile, True)
        VpCfg.WriteLine(VpFile.Path + ":" + VpFile.Rule.ToString)
        VpCfg.Flush
        VpCfg.Close
    End Sub
    Public Shared Sub AddToPermanentRulesDir(VpPath As String, VpRule As clsFile.EgRule)
    '------------------------------------------------------------------------------
    'Ajoute la règle spécifiée du dossier spécifié à la base des règles permanentes
    '------------------------------------------------------------------------------
    Dim VpCfg As New StreamWriter(Application.StartupPath + clsModule.CgRulesFile, True)
        VpCfg.WriteLine("<DIR>:" + VpPath + ":" + VpRule.ToString)
        VpCfg.Flush
        VpCfg.Close
    End Sub
    Public Shared Sub RemoveFromPermanentRules(VpFile As String)
    '-------------------------------------------------------------------------------
    'Retire la règle spécifiée du fichier spécifié de la base des règles permanentes
    '-------------------------------------------------------------------------------
    Dim VpCfg As StreamReader
    Dim VpCfg2 As StreamWriter
    Dim VpStr As String
        If Not File.Exists(Application.StartupPath + clsModule.CgRulesFile) Then Exit Sub
        VpCfg = New StreamReader(Application.StartupPath + clsModule.CgRulesFile)
        VpCfg2 = New StreamWriter(Application.StartupPath + "\cfg.tmp")
        While Not VpCfg.EndOfStream
            VpStr = VpCfg.ReadLine
            If VpStr.Contains(":") Then
                If Not VpStr.Substring(0, VpStr.IndexOf(":")) = VpFile Then
                    VpCfg2.WriteLine(VpStr)
                End If
            End If
        End While
        VpCfg2.Flush
        VpCfg2.Close
        VpCfg.Close
        File.Delete(Application.StartupPath + clsModule.CgRulesFile)
        File.Move(Application.StartupPath + "\cfg.tmp", Application.StartupPath + clsModule.CgRulesFile)
    End Sub
    Public Shared Function GetProperRule(VpFile As String) As clsFile.EgRule
    '-----------------------------------------------------------------------------
    'Si une règle permanente a été spécifiée pour le fichier spécifié, la retourne
    '-----------------------------------------------------------------------------
    Dim VpCasse As StringComparison = IIf(Options.VgSettings.Casse, StringComparison.Ordinal, StringComparison.OrdinalIgnoreCase)
    Dim VpCfg As StreamReader
    Dim VpStr As String
    Dim VpParam() As String
        If Not File.Exists(Application.StartupPath + clsModule.CgRulesFile) Then
            Return clsFile.EgRule.Unknown
        Else
            VpCfg = New StreamReader(Application.StartupPath + clsModule.CgRulesFile)
            While Not VpCfg.EndOfStream
                VpStr = VpCfg.ReadLine
                If VpStr.Contains(":") Then
                    VpParam = VpStr.Split(":")
                    If ( VpParam.Length = 2 AndAlso String.Equals(VpParam(0), VpFile, VpCasse) ) OrElse ( VpParam.Length = 3 AndAlso VpFile.StartsWith(VpParam(1), VpCasse) ) Then
                        Select Case VpParam(VpParam.Length - 1)
                            Case "DoNothing"
                                VpCfg.Close
                                Return clsFile.EgRule.DoNothing
                            Case "Delete"
                                VpCfg.Close
                                Return clsFile.EgRule.Delete
                            Case "Copy"
                                VpCfg.Close
                                Return clsFile.EgRule.Copy
                            Case "KeepLessRecent"
                                VpCfg.Close
                                Return clsFile.EgRule.KeepLessRecent
                            Case Else
                                VpCfg.Close
                                Return clsFile.EgRule.Copy
                        End Select
                    End If
                End If
            End While
            VpCfg.Close
            Return clsFile.EgRule.Unknown
        End If
    End Function
    Public Shared Sub ShowWarning(VpStr As String)
        Call MessageBox.Show(VpStr, "Problème", MessageBoxButtons.OK, MessageBoxIcon.Warning, MessageBoxDefaultButton.Button1)
    End Sub
    Public Shared Sub ShowInformation(VpStr As String)
        Call MessageBox.Show(VpStr, "Information", MessageBoxbuttons.OK, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1)
    End Sub
    Public Shared Function ShowQuestion(VpStr As String) As DialogResult
        Return MessageBox.Show(VpStr, "Question", MessageBoxbuttons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
    End Function
End Class
Public Class clsFile
    Public Enum EgStatus
        Equal = 0
        MostRecent
        LessRecent
        OnlyMe
    End Enum
    Public Enum EgRule  'Attention à l'ordre, il correspond au tag des menus contextuels (pas très propre mais plus concis)
        DoNothing = 0
        Delete
        Copy
        KeepLessRecent
        Unknown
    End Enum
    Private VmPath As String
    Private VmDate As Date
    Private VmStatus As EgStatus
    Private VmRefNode As TreeNode
    Private VmRefFile As clsFile
    Private VmRule As EgRule
    Private VmRulePermanent As Boolean
    Private VmLength As Long
    Private VmRoot As String
    Private VmIsDoublon As Boolean = False
    Public Sub New(VpFile As FileInfo, VpRoot As String)
        VmPath = VpFile.FullName.Replace(VpRoot, "")
        VmRoot = VpRoot
        VmStatus = EgStatus.OnlyMe
        VmDate = VpFile.LastWriteTimeUtc
        VmLength = VpFile.Length
        VmRule = clsModule.GetProperRule(VmPath)
        If Not VmRule = EgRule.Unknown Then
            VmRulePermanent = True
        Else
            VmRulePermanent = False
            VmRule = EgRule.Copy
        End If
    End Sub
    Public Sub New
        'Constructeur vide pour la sérialisation
    End Sub
    Public Shared Sub CopyFiles(VpFiles() As String, VpSourceFolder As String, VpTargetFolder As String)
    Dim VpSource As New System.Text.StringBuilder
    Dim VpTarget As New System.Text.StringBuilder
    Dim VpI As Integer
        If VpFiles.Length > 0 Then
            For VpI = 0 To VpFiles.Length - 1
                VpSource = VpSource.Append(VpSourceFolder).Append(VpFiles(VpI)).Append(vbNullChar)
                VpTarget = VpTarget.Append(VpTargetFolder).Append(VpFiles(VpI)).Append(vbNullChar)
            Next VpI
            VpSource = VpSource.Append(vbNullChar)
            VpTarget = VpTarget.Append(vbNullChar)
            Call clsFileCopy.CopyFiles(VpSource, VpTarget)
        End If
    End Sub
    Public Shared Sub DeleteFiles(ByRef VpFiles As ArrayList, VpRoot As String)
        For Each VpPath As String In VpFiles
            Call clsFile.SecureDelete(VpRoot + VpPath)
        Next VpPath
    End Sub
    Public Shared Sub SecureDelete(VpFile As String)
        'Trappe d'erreur en cas de droits insuffisants
        Try
            File.SetAttributes(VpFile, FileAttributes.Normal)
            File.Delete(VpFile)
        Catch
            Call clsModule.LOGWrite("SyncMX n'a pas pu obtenir les privilèges suffisants pour supprimer un fichier.")
        End Try
    End Sub
    Public Sub SetDateModif(VpDate As Date, Optional VpRoot As String = "")
        Try
            File.SetLastWriteTimeUtc(IIf(VpRoot = "", MainForm.cboSource1.Text, VpRoot) + VmPath, VpDate)
            VmDate = VpDate
        Catch
            Call clsModule.ShowWarning("Impossible de modifier la date du fichier en lecture seule suivant :" + vbCrLf + vbCrLf + VmPath)
        End Try
    End Sub
    Public Property DateModif As Date
        Get
            Return VmDate
        End Get
        Set(VpDate As Date)
            VmDate = VpDate
        End Set
    End Property
    Public Property Path As String
        Get
            Return VmPath
        End Get
        Set(VpPath As String)
            VmPath = VpPath
        End Set
    End Property
    Public Property Root As String
        Get
            Return VmRoot
        End Get
        Set(VpRoot As String)
            VmRoot = VpRoot
        End Set
    End Property
    Public Property Etat As EgStatus
        Get
            Return VmStatus
        End Get
        Set(VpEtat As EgStatus)
            VmStatus = VpEtat
        End Set
    End Property
    <XmlIgnore> _
    Public Property RefNode As TreeNode
        Get
            Return VmRefNode
        End Get
        Set(VpRefNode As TreeNode)
            VmRefNode = VpRefNode
        End Set
    End Property
    Public ReadOnly Property Nom As String
        Get
            Return VmPath.Substring(VmPath.LastIndexOf("\") + 1)
        End Get
    End Property
    Public Property RefFile As clsFile
        Get
            Return VmRefFile
        End Get
        Set(VpRefFile As clsFile)
            VmRefFile = VpRefFile
        End Set
    End Property
    Public Property Rule As EgRule
        Get
            Return VmRule
        End Get
        Set(VpRule As EgRule)
            VmRule = VpRule
        End Set
    End Property
    Public Property RulePermanent As Boolean
        Get
            Return VmRulePermanent
        End Get
        Set(VpRulePermanent As Boolean)
            VmRulePermanent = VpRulePermanent
        End Set
    End Property
    Public Property Size As Long
        Get
            Return VmLength
        End Get
        Set(VpLength As Long)
            VmLength = VpLength
        End Set
    End Property
    Public Property IsDoublon As Boolean
        Get
            Return VmIsDoublon
        End Get
        Set(VpIsDoublon As Boolean)
            VmIsDoublon = VpIsDoublon
        End Set
    End Property
End Class
Public Class clsDoublon
    Private VmGroupe As New ArrayList
    Private VmRoot As String
    Public Sub New(VpFile1 As clsFile, VpFile2 As clsFile, VpRoot As String)
        VmGroupe.Add(VpFile1)
        VmGroupe.Add(VpFile2)
        VmRoot = VpRoot
    End Sub
    Public Sub AddDoublon(VpFile As clsFile)
        VmGroupe.Add(VpFile)
    End Sub
    Public Function GetDoublon(VpIndex As Integer) As clsFile
        Return VmGroupe.Item(VpIndex)
    End Function
    Public ReadOnly Property Size As Long
        Get
            Dim VpSize As Long = 0
            For Each VpFile As clsFile In VmGroupe
                VpSize = VpSize + VpFile.Size
            Next
            Return VpSize
        End Get
    End Property
    Public ReadOnly Property Groupe As ArrayList
        Get
            Return VmGroupe
        End Get
    End Property
    Public ReadOnly Property Racine As String
        Get
            Return VmRoot
        End Get
    End Property
End Class
Public Class clsGrdInfo
    Private VmFiles12 As Integer
    Private VmFiles21 As Integer
    Private VmDelFiles1 As Integer
    Private VmDelFiles2 As Integer
    Public Sub New(Vp1 As Integer, Vp2 As Integer, Vp3 As Integer, Vp4 As Integer)
        VmFiles12 = Vp1
        VmFiles21 = Vp2
        VmDelFiles1 = Vp3
        VmDelFiles2 = Vp4
    End Sub
    Public ReadOnly Property Files12 As Integer
        Get
            Return VmFiles12
        End Get
    End Property
    Public ReadOnly Property Files21 As Integer
        Get
            Return VmFiles21
        End Get
    End Property
    Public ReadOnly Property DelFiles1 As Integer
        Get
            Return VmDelFiles1
        End Get
    End Property
    Public ReadOnly Property DelFiles2 As Integer
        Get
            Return VmDelFiles2
        End Get
    End Property
End Class
Public Class clsSizeComparer
    Implements IComparer
    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
    Dim VpX As String = x.ToString
    Dim VpY As String = y.ToString
        VpX = VpX.Substring(0, VpX.IndexOf(" "))
        VpY = VpY.Substring(0, VpY.IndexOf(" "))
        Return CInt(VpX) - CInt(VpY)
    End Function
End Class
Public Class clsInteraction
    Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private VmHandle As Integer = 0
    Private VmMsg As Integer = 0
    Private VmParam As Integer = 0
    Private VmSParam As String = ""
    Private VmTempA(-1) As Byte
    Public Event eMsgReceived(ByVal VpResult As String)
    Public Sub BuildMessage(ByVal VpPtr As IntPtr)
    Dim VpTempB(VmTempA.Length) As Byte
        If VpPtr <> 0 Then
            VmTempA.CopyTo(VpTempB, 0)
            VpTempB(VmTempA.Length) = VpPtr
            ReDim VmTempA(VpTempB.Length - 1)
            VpTempB.CopyTo(VmTempA, 0)
        Else
            RaiseEvent eMsgReceived(Encoding.UTF8.GetString(VmTempA))
            ReDim VmTempA(-1)
        End If
    End Sub
    Public Sub PostMsg(ByVal VpHandle As Integer, ByVal VpMsg As Integer, ByVal VpParam As Integer, ByVal VpSParam As String)
    Dim VpTh As New Threading.Thread(AddressOf SendMessage)
        Me.VmHandle = VpHandle
        Me.VmMsg = VpMsg
        Me.VmParam = VpParam
        Me.VmSParam = VpSParam
        VpTh.Start()
    End Sub
    Private Sub SendMessage()
    Dim VpBA() As Byte
    Dim VpI As Integer
        VpBA = Encoding.UTF8.GetBytes(VmSParam)
        For VpI = 0 To VpBA.Length - 1
            Call PostMessage(VmHandle, VmMsg, VmParam, VpBA(VpI))
        Next
        Call PostMessage(VmHandle, VmMsg, VmParam, 0)
    End Sub
End Class