filecopy.vb

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

#End Region

#Region " 实际执行 "
    Sub Apply(ByVal PostCopyCmds As String(), ByRef Output As String, Optional ByVal ChangeProgress As ProgressEventHandler = Nothing)
#If CONFIG <> "Debug" Then
        Try
#End If
        If Not IO.Directory.Exists(GetFileDirectory(LogPath)) Then IO.Directory.CreateDirectory(GetFileDirectory(LogPath))
        LogOpen(True)
        LogWriteLine("----------------")
        LogWriteLine(DateAndTime.Now & " " & TimeZone.CurrentTimeZone.GetUtcOffset(DateAndTime.Now).TotalHours.ToString("+##.#;-##.#"))
        LogWriteLine("----执行报告----")
        LogWriteLine("")
        Dim DIVer As Long = 0
        Dim DIVee As Long = 0
        If ChangeProgress IsNot Nothing Then
            ChangeProgress(0, "")
            For Each a As ActionFile In MappingTable
                Select Case a.ActionType
                    Case ActionTypeEnum.Same, ActionTypeEnum.Delete
                        DIVee += 1
                    Case ActionTypeEnum.Refresh, ActionTypeEnum.Revert, ActionTypeEnum.Create
                        DIVee += 20
                End Select
            Next
            DIVer = DIVee
            DIVee = 0
        End If

        For Each a As ActionFile In MappingTable
            DoActionFile(a)
            If ChangeProgress IsNot Nothing Then
                Select Case a.ActionType
                    Case ActionTypeEnum.Same, ActionTypeEnum.Delete
                        DIVee += 1
                    Case ActionTypeEnum.Refresh, ActionTypeEnum.Revert, ActionTypeEnum.Create
                        DIVee += 20
                End Select
                If a.Target Is Nothing Then
                    ChangeProgress(DIVee / DIVer, a.Source.Path)
                Else
                    ChangeProgress(DIVee / DIVer, a.Target.Path)
                End If
            End If
        Next
        LogWriteLine("----")
        For Each a As ActionDir In MappingTableDirs
            DoActionDirectory(a)
        Next
        LogWriteLine("--------PostCopy批处理--------")
        Output = "--------PostCopy批处理--------" & Environment.NewLine & ExecuteCmds("PostCopy.cmd", PostCopyCmds)
        LogWriteLine("----------------")
        LogClose()
#If CONFIG <> "Debug" Then
        Catch ex As Exception
            LogWriteLine()
            LogWriteLine(ex.ToString)
            LogClose()
            Throw
        End Try
#End If
    End Sub

    Protected Sub DoActionFile(ByVal a As ActionFile)
        Dim SourceCreateTime As DateTime
        If a.Source IsNot Nothing Then SourceCreateTime = IO.File.GetCreationTimeUtc(GetPath(SourceDir, a.Source.Path))
        Dim TargetCreateTime As DateTime
        If a.Target IsNot Nothing Then TargetCreateTime = IO.File.GetCreationTimeUtc(GetPath(TargetDir, a.Target.Path))
        Dim AbsTargetPath As String = Nothing
        Select Case a.ActionType
            Case ActionTypeEnum.Same
                LogWrite("Same {0} -> {1}", a.Source.Path, a.Target.Path)
                SetWriteTime(a.Target.Path, a.Source.WriteTime, a.Target.WriteTime)
                SetTimeNameAndMove(a.Source.Path, a.Target.Path, SourceCreateTime, TargetCreateTime, True)
            Case ActionTypeEnum.Refresh
                LogWrite("Refresh {0} -> {1}", a.Source.Path, a.Target.Path)
                RemoveAndBackup(a.Target.Path, a.ActionType)
                AbsTargetPath = GetPath(TargetDir, a.Target.Path)
                If Not IO.Directory.Exists(GetFileDirectory(AbsTargetPath)) Then IO.Directory.CreateDirectory(GetFileDirectory(AbsTargetPath))
                IO.File.Copy(GetPath(SourceDir, a.Source.Path), AbsTargetPath)
                SetTimeNameAndMove(a.Source.Path, a.Target.Path, SourceCreateTime, TargetCreateTime)
            Case ActionTypeEnum.Revert
                LogWrite("Revert {0} -> {1}", a.Source.Path, a.Target.Path)
                RemoveAndBackup(a.Target.Path, a.ActionType)
                AbsTargetPath = GetPath(TargetDir, a.Target.Path)
                If Not IO.Directory.Exists(GetFileDirectory(AbsTargetPath)) Then IO.Directory.CreateDirectory(GetFileDirectory(AbsTargetPath))
                IO.File.Copy(GetPath(SourceDir, a.Source.Path), AbsTargetPath)
                SetTimeNameAndMove(a.Source.Path, a.Target.Path, SourceCreateTime, TargetCreateTime)
            Case ActionTypeEnum.Delete
                LogWrite("Delete NULL -> {0}", a.Target.Path)
                RemoveAndBackup(a.Target.Path, a.ActionType)
            Case ActionTypeEnum.Create
                LogWrite("Create {0} -> NULL", a.Source.Path)
                AbsTargetPath = GetPath(TargetDir, a.Source.Path)
                If Not IO.Directory.Exists(GetFileDirectory(AbsTargetPath)) Then IO.Directory.CreateDirectory(GetFileDirectory(AbsTargetPath))
                IO.File.Copy(GetPath(SourceDir, a.Source.Path), AbsTargetPath)
                Dim fa As FileAttributes = IO.File.GetAttributes(AbsTargetPath)
                If fa And FileAttributes.ReadOnly Then
                    IO.File.SetAttributes(AbsTargetPath, fa And Not FileAttributes.ReadOnly)
                    IO.File.SetCreationTimeUtc(AbsTargetPath, SourceCreateTime)
                    IO.File.SetAttributes(AbsTargetPath, fa Or FileAttributes.ReadOnly)
                Else
                    IO.File.SetCreationTimeUtc(AbsTargetPath, SourceCreateTime)
                End If
        End Select
        LogWriteLine(" !OK")
    End Sub
    Protected Sub SetWriteTime(ByVal TargetPath As String, ByVal SourceWriteTime As DateTime, ByVal TargetWriteTime As DateTime)
        If SameFileIdentifier And SameFileIdentifierOption.CorrectWriteTimeOffsetIn2s Then
            If SourceWriteTime < TargetWriteTime Then
                IO.File.SetLastWriteTimeUtc(GetPath(TargetDir, TargetPath), SourceWriteTime)
            End If
        End If
    End Sub
    Protected Sub SetTimeNameAndMove(ByVal SourcePath As String, ByVal TargetPath As String, ByVal SourceCreateTime As DateTime, ByVal TargetCreateTime As DateTime, Optional ByVal Same As Boolean = False)
        Dim AbsSourcePath As String = GetPath(SourceDir, SourcePath)
        Dim AbsTargetPath As String = Nothing
        If CreateTimeAndCharCaseHandling = CreateTimeAndCharCaseHandlingOption.Source OrElse (CreateTimeAndCharCaseHandling = CreateTimeAndCharCaseHandlingOption.Target AndAlso SourceCreateTime < TargetCreateTime) Then
            AbsTargetPath = GetPath(TargetDir, SourcePath)
            IO.File.Move(GetPath(TargetDir, TargetPath), AbsTargetPath)
            Dim fa As FileAttributes = IO.File.GetAttributes(AbsTargetPath)
            If fa And FileAttributes.ReadOnly Then
                IO.File.SetAttributes(AbsTargetPath, fa And Not FileAttributes.ReadOnly)
                IO.File.SetCreationTimeUtc(AbsTargetPath, SourceCreateTime)
                IO.File.SetAttributes(AbsTargetPath, fa Or FileAttributes.ReadOnly)
            Else
                IO.File.SetCreationTimeUtc(AbsTargetPath, SourceCreateTime)
            End If
        Else 'If CreateTimeAndCharCaseHandling = CreateTimeAndCharCaseHandlingOption.Target OrElse (CreateTimeAndCharCaseHandling = CreateTimeAndCharCaseHandlingOption.Target AndAlso SourceCreateTime >= TargetCreateTime) Then
            AbsTargetPath = GetPath(TargetDir, GetPath(GetFileDirectory(SourcePath), GetFileName(TargetPath)))
            If Not IO.Directory.Exists(GetFileDirectory(AbsTargetPath)) Then IO.Directory.CreateDirectory(GetFileDirectory(AbsTargetPath))
            IO.File.Move(GetPath(TargetDir, TargetPath), AbsTargetPath)
            If Not Same Then
                Dim fa As FileAttributes = IO.File.GetAttributes(AbsTargetPath)
                If fa And FileAttributes.ReadOnly Then
                    IO.File.SetAttributes(AbsTargetPath, fa And Not FileAttributes.ReadOnly)
                    IO.File.SetCreationTimeUtc(AbsTargetPath, TargetCreateTime)
                    IO.File.SetAttributes(AbsTargetPath, fa Or FileAttributes.ReadOnly)
                Else
                    IO.File.SetCreationTimeUtc(AbsTargetPath, TargetCreateTime)
                End If
            End If
        End If
    End Sub
    Protected Sub RemoveAndBackup(ByVal TargetPath As String, ByVal Type As ActionTypeEnum)
        Select Case Type
            Case ActionTypeEnum.Refresh, ActionTypeEnum.Delete
                If Not IO.Directory.Exists(GetFileDirectory(GetPath(BackupDir, TargetPath))) Then IO.Directory.CreateDirectory(GetFileDirectory(GetPath(BackupDir, TargetPath)))
                If IO.File.Exists(GetPath(BackupDir, TargetPath)) Then
                    My.Computer.FileSystem.DeleteFile(GetPath(BackupDir, TargetPath), FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
                End If
                IO.File.Move(GetPath(TargetDir, TargetPath), GetPath(BackupDir, TargetPath))
            Case ActionTypeEnum.Revert
                If Not IO.Directory.Exists(GetFileDirectory(GetPath(ExceptionalDir, TargetPath))) Then IO.Directory.CreateDirectory(GetFileDirectory(GetPath(ExceptionalDir, TargetPath)))
                If IO.File.Exists(GetPath(ExceptionalDir, TargetPath)) Then
                    My.Computer.FileSystem.DeleteFile(GetPath(ExceptionalDir, TargetPath), FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
                End If
                IO.File.Move(GetPath(TargetDir, TargetPath), GetPath(ExceptionalDir, TargetPath))
        End Select
    End Sub

    Protected Sub DoActionDirectory(ByVal a As ActionDir)
        Dim SourceCreateTime As DateTime
        If a.Source IsNot Nothing Then SourceCreateTime = IO.Directory.GetCreationTimeUtc(GetPath(SourceDir, a.Source.Path))
        Dim TargetCreateTime As DateTime
        If a.Target IsNot Nothing Then TargetCreateTime = IO.Directory.GetCreationTimeUtc(GetPath(TargetDir, a.Target.Path))
        Select Case a.ActionType
            Case ActionTypeEnum.Same
                LogWrite("Same {0} -> {1}", a.Source.Path, a.Target.Path)
                SetTimeNameAndMoveDir(a.Source.Path, a.Target.Path, SourceCreateTime, TargetCreateTime)
            Case ActionTypeEnum.Delete
                LogWrite("Delete NULL -> {0}", a.Target.Path)
                If Not IO.Directory.Exists(GetPath(BackupDir, a.Target.Path)) Then IO.Directory.CreateDirectory(GetPath(BackupDir, a.Target.Path))
                IO.Directory.SetCreationTimeUtc(GetPath(BackupDir, a.Target.Path), TargetCreateTime)
                Dim AbsTargetPath As String = GetPath(TargetDir, a.Target.Path)
                Dim Files As String() = IO.Directory.GetFiles(AbsTargetPath)
                Dim Dirs As String() = IO.Directory.GetDirectories(AbsTargetPath)
                If (Files Is Nothing OrElse Files.Length = 0) AndAlso (Dirs Is Nothing OrElse Dirs.Length = 0) Then
                    IO.Directory.Delete(AbsTargetPath, True) '对于某些可能生成desktop.ini的文件夹需要剪除
                End If
            Case ActionTypeEnum.Create
                LogWrite("Create {0} -> NULL", a.Source.Path)
                If Not IO.Directory.Exists(GetPath(TargetDir, a.Source.Path)) Then IO.Directory.CreateDirectory(GetPath(TargetDir, a.Source.Path))
                IO.Directory.SetCreationTimeUtc(GetPath(TargetDir, a.Source.Path), SourceCreateTime)
        End Select
        LogWriteLine(" !OK")
    End Sub
    Protected Sub SetTimeNameAndMoveDir(ByVal SourcePath As String, ByVal TargetPath As String, ByVal SourceCreateTime As DateTime, ByVal TargetCreateTime As DateTime)
        Dim AbsSourcePath As String = GetPath(SourceDir, SourcePath)
        Dim AbsTargetPath As String = Nothing
        If CreateTimeAndCharCaseHandling = CreateTimeAndCharCaseHandlingOption.Source OrElse (CreateTimeAndCharCaseHandling = CreateTimeAndCharCaseHandlingOption.Target AndAlso SourceCreateTime < TargetCreateTime) Then
            AbsTargetPath = GetPath(TargetDir, SourcePath)
            If Not IO.Directory.Exists(AbsTargetPath) Then IO.Directory.CreateDirectory(AbsTargetPath)
            IO.Directory.SetCreationTimeUtc(AbsTargetPath, SourceCreateTime)
        Else 'If CreateTimeAndCharCaseHandling = CreateTimeAndCharCaseHandlingOption.Target OrElse (CreateTimeAndCharCaseHandling = CreateTimeAndCharCaseHandlingOption.Target AndAlso SourceCreateTime >= TargetCreateTime) Then
            AbsTargetPath = GetPath(TargetDir, GetPath(GetFileDirectory(SourcePath), GetFileName(TargetPath)))
            If Not IO.Directory.Exists(AbsTargetPath) Then IO.Directory.CreateDirectory(AbsTargetPath)
            IO.Directory.SetCreationTimeUtc(AbsTargetPath, TargetCreateTime)
        End If
    End Sub
#End Region

#Region " 执行PreCopy和PostCopy批处理 "
    Public Function ExecuteCmds(ByVal Name As String, ByVal Cmds As String()) As String
        Dim ret As Boolean = True
        For Each c As String In Cmds
            If c.Trim = "" OrElse c.TrimStart.StartsWith("REM ") OrElse c.TrimStart.StartsWith(":: ") Then Continue For
            ret = False
        Next
        If ret Then Return ""

        Dim Cmd As New Text.StringBuilder
        Cmd.AppendLine("@echo off")
        Cmd.AppendLine("@set SrcDir=" & SourceDir)
        Cmd.AppendLine("@set TarDir=" & TargetDir)
        Cmd.AppendLine("@set NewDir=" & NewDir)
        Cmd.AppendLine("@set BakDir=" & BackupDir)
        Cmd.AppendLine("@set ExcDir=" & ExceptionalDir)
        Cmd.AppendLine("@echo on")
        For Each Line As String In Cmds
            Cmd.AppendLine(Line)
        Next

        ChDir(Application.StartupPath)
        Dim CmdFile As New StreamWriter(Name, False, Text.Encoding.Default)
        CmdFile.WriteLine(Cmd.ToString)
        CmdFile.Close()

        Dim p As Process = New Process()
        p.StartInfo.FileName = Name
        p.StartInfo.RedirectStandardInput = True
        p.StartInfo.RedirectStandardOutput = True
        p.StartInfo.UseShellExecute = False
        p.StartInfo.CreateNoWindow = True
        p.Start()

        Delay(1)

        Dim Output As String = p.StandardOutput.ReadToEnd()
        LogWriteLine(Output)

        p.WaitForExit()
        IO.File.Delete(Name)
        Return Output
    End Function
    '''<summary>等待</summary>
    Public Shared Sub Delay(ByVal DelaySeconds As Double)
        Dim Time As Double = DateAndTime.Timer
        While DateAndTime.Timer - Time < DelaySeconds
            Application.DoEvents()
        End While
    End Sub
#End Region

End Class

Public Enum ActionTypeEnum
    Same
    Refresh
    Revert
    Create
    Delete
End Enum
Public Class ActionFile
    Public Source As File
    Public Target As File
    Public ActionType As ActionTypeEnum
    Sub New(ByVal Source As DataRow, ByVal Target As DataRow, ByVal ActionType As ActionTypeEnum)
        If Not (Source Is Nothing) Then Me.Source = New File(Source)
        If Not (Target Is Nothing) Then Me.Target = New File(Target)
        Me.ActionType = ActionType
    End Sub
End Class
Public Class ActionDir
    Public Source As Dir
    Public Target As Dir
    Public ActionType As ActionTypeEnum
    Sub New(ByVal Source As DataRow, ByVal Target As DataRow, ByVal ActionType As ActionTypeEnum)
        If Not (Source Is Nothing) Then Me.Source = New Dir(Source)
        If Not (Target Is Nothing) Then Me.Target = New Dir(Target)
        Me.ActionType = ActionType
    End Sub
End Class

Public Class File
    Public Name As String
    Public Length As Long
    Public WriteTime As DateTime
    Public Path As String
    Sub New(ByVal d As DataRow)
        Name = d("Name")
        Length = d("Length")
        WriteTime = DateTime.FromBinary(d("WriteTime"))
        Path = d("Path")
    End Sub
End Class
Public Class Dir
    Public Path As String
    Sub New(ByVal d As DataRow)
        Path = d("Path")
    End Sub
End Class