filecopy.vb

文件复制器 2007.07.28.0最新VB源代码 地狱门神(F.R.C.) 适用范围 Windows环境下

            If ChangeProgress IsNot Nothing Then
                DIVee += 1
                ChangeProgress(DIVee / DIVer, Nothing)
            End If
        Next

        Source = Nothing
        Target = Nothing

        LogWriteLine("----")

        MappingTableDirs = New List(Of ActionDir)
        Dim ad As ActionDir
        n = 0
        While n < SourceDirs.Rows.Count
            Dim s As DataRow = SourceDirs.Rows(n)
            Dim Selected As DataRow() = TargetDirs.Select(String.Format("Path = '{0}'", Escape(s("Path"))))
            If Selected Is Nothing OrElse Selected.Length = 0 Then
                n += 1
                Continue While
            End If
            If Selected.Length = 1 Then
                Dim t As DataRow = Selected(0)
                ad = New ActionDir(s, t, ActionTypeEnum.Same)
                LogWriteLine("Same {0} -> {1}", ad.Source.Path, ad.Target.Path)
                MappingTableDirs.Add(ad)
                SourceDirs.Rows.Remove(s)
                TargetDirs.Rows.Remove(t)
            Else
                Throw New InvalidOperationException
            End If
        End While

        If Not (SameFileIdentifier And SameFileIdentifierOption.Path) Then
            n = 0
            While n < SourceDirs.Rows.Count
                Dim s As DataRow = SourceDirs.Rows(n)
                Dim Selected As DataRow() = TargetDirs.Select(String.Format("Name = '{0}'", Escape(s("Name"))))
                If Selected Is Nothing OrElse Selected.Length = 0 Then
                    n += 1
                    Continue While
                End If
                Dim t As DataRow = GetBestFitted(s, Selected) '极端情况下可能遗漏真正符合的
                ad = New ActionDir(s, t, ActionTypeEnum.Same)
                LogWriteLine("Same {0} -> {1}", ad.Source.Path, ad.Target.Path)
                MappingTableDirs.Add(ad)
                SourceDirs.Rows.Remove(s)
                TargetDirs.Rows.Remove(t)
                If ChangeProgress IsNot Nothing Then
                    DIVee += 2
                    ChangeProgress(DIVee / DIVer, Nothing)
                End If
            End While
        End If

        If Not PreserveDeleted Then
            For Each t As DataRow In TargetDirs.Rows
                ad = New ActionDir(Nothing, t, ActionTypeEnum.Delete)
                LogWriteLine("Delete NULL -> {0}", ad.Target.Path)
                MappingTableDirs.Add(ad)
            Next
        End If
        For Each s As DataRow In SourceDirs.Rows
            ad = New ActionDir(s, Nothing, ActionTypeEnum.Create)
            LogWriteLine("Create {0} -> NULL", ad.Source.Path)
            MappingTableDirs.Add(ad)
        Next

        SourceDirs = Nothing
        TargetDirs = Nothing
    End Sub

    Protected Function IsMatchFilter(ByVal s As String) As Boolean
        For Each fs As String In Filters
            If s Like fs Then Return True
        Next
        Return False
    End Function
    Protected Sub AddDirToSourceDirs(ByVal Path As String)
        '按照此顺序遍历可以使得删除文件夹可以根据文件夹是否为空来判断
        For Each d As String In Directory.GetDirectories(Path)
            If IsMatchFilter(GetRelativePath(d, SourceDir)) Then Continue For
            AddDirToSourceDirs(d)
            SourceDirs.Rows.Add(New Object() {GetFileName(GetRelativePath(d, SourceDir)), GetRelativePath(d, SourceDir)})
            Application.DoEvents()
        Next
    End Sub
    Protected Sub AddDirToTargetDirs(ByVal Path As String)
        For Each d As String In Directory.GetDirectories(Path)
            If IsMatchFilter(GetRelativePath(d, TargetDir)) Then Continue For
            AddDirToTargetDirs(d)
            TargetDirs.Rows.Add(New Object() {GetFileName(GetRelativePath(d, TargetDir)), GetRelativePath(d, TargetDir)})
            Application.DoEvents()
        Next
    End Sub
    Protected Sub AddDirToSource(ByVal Path As String)
        For Each f As String In Directory.GetFiles(Path)
            If IsMatchFilter(GetRelativePath(f, SourceDir)) Then Continue For
            Dim fi As New FileInfo(f)
            Application.DoEvents()
            Source.Rows.Add(New Object() {GetFileName(f), fi.Length, fi.LastWriteTimeUtc.ToBinary, GetRelativePath(f, SourceDir)})
        Next
        For Each d As String In Directory.GetDirectories(Path)
            If IsMatchFilter(GetRelativePath(d, SourceDir)) Then Continue For
            AddDirToSource(d)
        Next
    End Sub
    Protected Sub AddDirToTarget(ByVal Path As String)
        For Each f As String In Directory.GetFiles(Path)
            If IsMatchFilter(GetRelativePath(f, TargetDir)) Then Continue For
            Dim fi As New FileInfo(f)
            Application.DoEvents()
            Target.Rows.Add(New Object() {GetFileName(f), fi.Length, fi.LastWriteTimeUtc.ToBinary, GetRelativePath(f, TargetDir)})
        Next
        For Each d As String In Directory.GetDirectories(Path)
            If IsMatchFilter(GetRelativePath(d, TargetDir)) Then Continue For
            AddDirToTarget(d)
        Next
    End Sub
    Private Shared TimeSpan3s As New TimeSpan(0, 0, 3)
    Protected Function IsSameFile(ByVal Source As DataRow, ByVal Target As DataRow) As Boolean
        If Source.Item("Length") <> Target.Item("Length") Then Return False
        If SameFileIdentifier And SameFileIdentifierOption.CorrectWriteTimeOffsetIn2s Then
            Dim SourceTimeL As Long = Source.Item("WriteTime")
            Dim TargetTimeL As Long = Target.Item("WriteTime")
            If SourceTimeL <> TargetTimeL Then
                Dim SourceTime As DateTime = DateTime.FromBinary(SourceTimeL)
                Dim TargetTime As DateTime = DateTime.FromBinary(TargetTimeL)
                If SourceTime - TargetTime > TimeSpan3s Then Return False
                If TargetTime - SourceTime > TimeSpan3s Then Return False
            End If
        Else
            If Source.Item("WriteTime") <> Target.Item("WriteTime") Then Return False
        End If
        If SameFileIdentifier And SameFileIdentifierOption.FullFile Then
            Dim s As New FileStream(GetPath(SourceDir, Source.Item("Path")), FileMode.Open, FileAccess.Read, FileShare.Read)
            Dim t As New FileStream(GetPath(TargetDir, Target.Item("Path")), FileMode.Open, FileAccess.Read, FileShare.Read)
            For n As Integer = 0 To s.Length - 1
                If s.ReadByte <> t.ReadByte Then Return False
            Next
            Return True
        End If
        If SameFileIdentifier And SameFileIdentifierOption.First64K Then
            Dim s As New FileStream(GetPath(SourceDir, Source.Item("Path")), FileMode.Open, FileAccess.Read, FileShare.Read)
            Dim t As New FileStream(GetPath(TargetDir, Target.Item("Path")), FileMode.Open, FileAccess.Read, FileShare.Read)
            For n As Integer = 0 To Min(s.Length - 1, 65535)
                If s.ReadByte <> t.ReadByte Then Return False
            Next
            Return True
        End If
        Return True
    End Function
    ''' <summary>通过看路径的最佳匹配来确定最佳文件</summary>
    Protected Function GetBestFitted(ByVal s As DataRow, ByVal d As DataRow()) As DataRow
        If d.GetLength(0) = 1 Then Return d(0)
        Dim Fitness As Integer() = New Integer(d.GetUpperBound(0)) {}
        Dim dic As New Dictionary(Of String, Object)(StringComparer.InvariantCultureIgnoreCase)
        For Each str As String In CStr(s("Path")).Replace("/", "\").Split("\")
            If Not dic.ContainsKey(str) Then dic.Add(str, Nothing)
        Next
        For n As Integer = 0 To d.GetUpperBound(0)
            For Each str As String In CStr(d(n)("Path")).Replace("/", "\").Split("\")
                If dic.ContainsKey(str) Then Fitness(n) += 1
            Next
        Next
        Dim Best As Integer = -1
        Dim Index As Integer = -1
        For n As Integer = 0 To d.GetUpperBound(0)
            If Fitness(n) > Best Then
                Best = Fitness(n)
                Index = n
            End If
        Next
        Return d(Index)
    End Function

    Protected Function Escape(ByVal Source As String) As String
        Return Source.Replace("'", "''")
    End Function
#End Region

#Region " 磁盘空间检查 "
    Protected Function CalculateDiskSpace(ByVal s As Text.StringBuilder) As Boolean
        Dim SameFileSize As Long = 0
        Dim TargetSpace As Long = 0
        Dim NewSpace As Long = 0
        Dim BackupSpace As Long = 0
        Dim ExceptionalSpace As Long = 0

        If DifferentFileHandling = DifferentFileHandlingOption.Backup Then
            Dim TargetDiskCluster As Long = ClusterSize(GetDrive(TargetDir))
            Dim BackupDiskCluster As Long = ClusterSize(GetDrive(BackupDir))
            Dim ExceptionalDiskCluster As Long = ClusterSize(GetDrive(ExceptionalDir))
            For Each a As ActionFile In MappingTable
                Select Case a.ActionType
                    Case ActionTypeEnum.Same
                        SameFileSize += a.Source.Length
                    Case ActionTypeEnum.Refresh
                        TargetSpace -= GetSizeOnDisk(a.Target.Length, TargetDiskCluster)
                        BackupSpace += GetSizeOnDisk(a.Target.Length, BackupDiskCluster)
                        TargetSpace += GetSizeOnDisk(a.Source.Length, TargetDiskCluster)
                    Case ActionTypeEnum.Revert
                        TargetSpace -= GetSizeOnDisk(a.Target.Length, TargetDiskCluster)
                        ExceptionalSpace += GetSizeOnDisk(a.Target.Length, ExceptionalDiskCluster)
                        TargetSpace += GetSizeOnDisk(a.Source.Length, TargetDiskCluster)
                    Case ActionTypeEnum.Delete
                        TargetSpace -= GetSizeOnDisk(a.Target.Length, TargetDiskCluster)
                        BackupSpace += GetSizeOnDisk(a.Target.Length, BackupDiskCluster)
                    Case ActionTypeEnum.Create
                        TargetSpace += GetSizeOnDisk(a.Source.Length, TargetDiskCluster)
                End Select
            Next
            s.AppendLine(String.Format("相同文件空间占用：{0}", GetSizeString(SameFileSize)))
            s.AppendLine(String.Format("目标文件新增空间占用：{0}", GetSizeString(TargetSpace)))
            s.AppendLine(String.Format("备份文件新增空间占用：{0}", GetSizeString(BackupSpace)))
            s.AppendLine(String.Format("异常文件新增空间占用：{0}", GetSizeString(ExceptionalSpace)))
        Else 'If DifferentFileHandling = DifferentFileHandlingOption.CopyNew Then
            Dim TargetDiskCluster As Long = ClusterSize(GetDrive(TargetDir))
            Dim NewDiskCluster As Long = ClusterSize(GetDrive(NewDir))
            For Each a As ActionFile In MappingTable
                Select Case a.ActionType
                    Case ActionTypeEnum.Same
                        SameFileSize += a.Source.Length
                    Case ActionTypeEnum.Refresh
                        NewSpace += GetSizeOnDisk(a.Source.Length, NewDiskCluster)
                    Case ActionTypeEnum.Revert
                        NewSpace += GetSizeOnDisk(a.Source.Length, NewDiskCluster)
                    Case ActionTypeEnum.Delete

                    Case ActionTypeEnum.Create
                        NewSpace += GetSizeOnDisk(a.Source.Length, NewDiskCluster)
                End Select
            Next
            s.AppendLine(String.Format("相同文件空间占用：{0}", GetSizeString(SameFileSize)))
            s.AppendLine(String.Format("目标文件新增空间占用：{0}", GetSizeString(TargetSpace)))
            s.AppendLine(String.Format("新增文件新增空间占用：{0}", GetSizeString(NewSpace)))
        End If

        Dim DiskName As New List(Of Char)
        DiskName.Add(GetDrive(TargetDir))
        If DifferentFileHandling = DifferentFileHandlingOption.Backup Then
            If Not DiskName.Contains(GetDrive(BackupDir)) Then DiskName.Add(GetDrive(BackupDir))
            If Not DiskName.Contains(GetDrive(ExceptionalDir)) Then DiskName.Add(GetDrive(ExceptionalDir))
        Else 'If DifferentFileHandling = DifferentFileHandlingOption.CopyNew Then
            If Not DiskName.Contains(GetDrive(NewDir)) Then DiskName.Add(GetDrive(NewDir))
        End If
        Dim DiskSpace As Long() = New Long(DiskName.Count - 1) {}
        DiskSpace(DiskName.IndexOf(GetDrive(TargetDir))) += TargetSpace
        If DifferentFileHandling = DifferentFileHandlingOption.Backup Then
            DiskSpace(DiskName.IndexOf(GetDrive(BackupDir))) += BackupSpace
            DiskSpace(DiskName.IndexOf(GetDrive(ExceptionalDir))) += ExceptionalSpace
        Else 'If DifferentFileHandling = DifferentFileHandlingOption.CopyNew Then
            DiskSpace(DiskName.IndexOf(GetDrive(NewDir))) += NewSpace
        End If

        Dim ret As Boolean = True
        For n As Integer = 0 To DiskName.Count - 1
            s.AppendLine(String.Format("{0}盘需要空间 {1}", DiskName(n), GetSizeString(DiskSpace(n))))
            Dim FreeSpace As Long = New DriveInfo(DiskName(n)).AvailableFreeSpace
            If FreeSpace >= DiskSpace(n) Then
                s.AppendLine(String.Format("{0}盘剩余空间 {1}", DiskName(n), GetSizeString(FreeSpace)))
            Else
                s.AppendLine(String.Format("{0}盘剩余空间 {1} 不足", DiskName(n), GetSizeString(FreeSpace)))
                ret = False
            End If
        Next

        Return ret
    End Function

    Protected Function GetDrive(ByVal Path As String) As String
        If Path = "" Then Throw New InvalidDataException
        Dim d As Char = Path(0)
        If Char.IsLetter(d) Then Return Char.ToUpper(d)
        If d = "." Then Return Char.ToUpper(Application.StartupPath(0))
        Throw New InvalidDataException
    End Function
    Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, ByRef lpSectorsPerCluster As Integer, ByRef lpBytesPerSector As Integer, ByRef lpNumberOfFreeClusters As Integer, ByRef lpTtoalNumberOfClusters As Integer) As Integer
    Protected Function ClusterSize(ByVal Drive As Char) As Long
        Dim lAns As Integer

        Dim lSectorsPerCluster As Integer
        Dim lBytesPerSector As Integer
        Dim lBytesPerCluster As Integer
        Dim lTotalClusters As Integer
        Dim lFreeClusters As Integer
        lAns = GetDiskFreeSpace(Char.ToLower(Drive) & ":\", lSectorsPerCluster, lBytesPerSector, lFreeClusters, lTotalClusters)
        lBytesPerCluster = lSectorsPerCluster * lBytesPerSector
        Return lBytesPerCluster
    End Function
    Function GetSizeOnDisk(ByVal Length As Long, ByVal ClusterSize As Long) As Long
        Return ((Length + ClusterSize - 1) \ ClusterSize) * ClusterSize
    End Function
    Function GetSizeString(ByVal i As Long) As String
        If Abs(i) < 2 ^ 10 Then Return CStr(i) & "B"
        If Abs(i) < 2 ^ 20 Then Return CStr(Sign(i) * ((Abs(i) + 2 ^ 10 - 1) \ 2 ^ 10)) & "KB"
        If Abs(i) < 2 ^ 30 Then Return CStr(Round(i / 2 ^ 20, 2)) & "MB"
        If Abs(i) < 2 ^ 40 Then Return CStr(Round(i / 2 ^ 30, 2)) & "GB"
        Return CStr(Round(i / 2 ^ 40, 2)) & "TB"
    End Function
#End Region