[原创]文件批量对比工具(存在问题高手请帮忙解决)在线等

昨晚完成了文件批量比较的工具.这个工具能找出2个目录中相同的文件,或者不存在的一些目录或者文件.但是出了一个有趣的问题不知道是VB编译器的问题还是其他问题大家有兴趣试试如果比较的2个路径是分区符号的话会有点问题,如果是文件夹就没问题:比如比较的路径一是"c:"路径二是"d:"就有问题如果是"c:\windows"和"d:\winnt"就没问题
源码如下供大家共同讨论
模块代码:
Public Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long '获取文件长度函数
                        
Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long '打开文件函数Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '关闭打开的文件Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long '声明sendmessage函数Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
                        (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPublic Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As LongPublic Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPublic Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
                        (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
                        
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As LongPublic Declare Function copyfile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As LongPublic Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End TypePublic Const MaxLFNPath = 260Public Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MaxLFNPath
    cShortFileName As String * 14
End Type
Public Const INVALID_HANDLE_VALUE = -1Public Const LB_SETHORIZONTALEXTENT = &H194 '用于水平滚动条Public apppath As String '全局程序运行、路径Public ags() As String '用于存放命令行参数Public flag3 As StringPublic path_1 As StringPublic path2_ As StringPublic j As LongPublic size As LongPublic filesbuf() As StringPublic filesbuf_() As StringPublic flag_ As IntegerPublic flag1 As IntegerPublic ps As Long '用于存放比较文件数Public shu As IntegerPublic a_ As IntegerPublic x_ As StringPublic y_ As StringPublic fcfile As StringPublic fcfiler As StringPublic sfilenmae As StringPublic dfilenmae As StringPublic Const vbBackslash = "\"Public Const vbKeyDot = 46Public WFD As WIN32_FIND_DATAPublic Type OFSTRUCT '用于打开文件
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName As String * 128
End TypePublic Sub SearchDirs(curpath As String)
    If Right(curpath, 1) <> "\" Then curpath = curpath & "\"
    Dim dirbuf() As String, i, hItem
    Static files As Long
    
    Dim dirs As Long
    Frm_pr.Label1.Caption = "正在搜索: " & curpath '& dirbuf(dirs)
    DoEvents
    hItem = FindFirstFile(curpath & "*.*", WFD)
    If hItem <> INVALID_HANDLE_VALUE Then
        Do
            '检查是不是目录
            If (WFD.dwFileAttributes And vbDirectory) Then
                
                ' 检查是不是  "." or ".."
                If Asc(WFD.cFileName) <> vbKeyDot Then                    If flag1 = 1 Then
                        
                        If Dir(y_ & Replace(curpath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1), x_, "") & "\", vbDirectory) = "" Then
                            frm_fc.List2.AddItem y_ & Replace(curpath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1), x_, "")
                        End If
                    
                    End If
                    dirs = dirs + 1
                    ReDim Preserve dirbuf(1 To dirs)
                    dirbuf(dirs) = curpath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                    
                End If
                
            Else
                
                SetAttr curpath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1), 0
                If flag1 = 1 Then
                    If Dir(y_ & Replace(curpath, x_, "") & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)) = "" Then
                        frm_fc.List2.AddItem y_ & Replace(curpath, x_, "") & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                    Else
                        ReDim Preserve filesbuf(0 To files)
                        ReDim Preserve filesbuf_(0 To files)
                        filesbuf(files) = curpath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                        filesbuf_(files) = y_ & Replace(curpath, x_, "") & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                        files = files + 1
                    End If
                Else
                    If Dir(x_ & Replace(curpath, y_, "") & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)) = "" Then
                        frm_fc.List2.AddItem x_ & Replace(curpath, y_, "") & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                    End If
                End If
            End If        Loop While FindNextFile(hItem, WFD)
        
        Call FindClose(hItem)
    End If    
    For i = 1 To dirs
        SearchDirs dirbuf(i) & vbBackslash
    Next i
        
    
End Sub

解决方案 »

  1.   

    主窗体代码如下:
    Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
        
    Private Sub Form_Initialize() '用于显示XP风格
           InitCommonControls
    End SubPrivate Sub Command3_Click() '导出相同文件的列表
        If List1.ListCount = 0 Then
            MsgBox "没有相同的文件列表", , "提示"
            Exit Sub
        End If
        With CommonDialog1
            On Error GoTo err_
            .CancelError = True
            .DialogTitle = "请选择文件..."
            .Filter = "所有文件 (*.*)|*.*"
            .Flags = &H4
            .ShowOpen
        End With
        Open CommonDialog1.FileName For Output As #3 '打开文件
        Dim i As Integer    For i = 0 To List1.ListCount '依次从LIST1里读取数据写入CommonDialog1.FileName中
            Print #3, List1.List(i)
        Next
        Close #3
    err_:
    End SubPrivate Sub Command4_Click() '导出不同文件的列表
        If List2.ListCount = 0 Then
            MsgBox "没有不同的文件列表", , "提示"
            Exit Sub
        End If
        With CommonDialog2
            On Error GoTo err_
            .CancelError = True
            .DialogTitle = "请选择文件..."
            .Filter = "所有文件 (*.*)|*.*"
            .Flags = &H4
            .ShowOpen
        End With
        Open CommonDialog2.FileName For Output As #4 '打开文件
        Dim i As Integer
        For i = 0 To List2.ListCount '依次从LIST1里读取数据写入CommonDialog2.FileName中
            Print #4, List2.List(i)
        Next
        Close #4
    err_:
    End SubPrivate Sub Command5_Click() '比较文件    Me.Hide
        Frm_pr.Show
        If Me.Text1.Text = "" Then  '如果TEXT1为空或者没有进行操作就提示相应处理
            MsgBox "请输入路径一", , "提示"
            Frm_pr.Hide
            Me.Show
            Me.Text1.SetFocus
            Exit Sub
        End If
        If Me.Text2.Text = "" Then  '如果TEXT2为空或者没有进行操作就提示相应处理
            MsgBox "请输入路径二", , "提示"
            Frm_pr.Hide
            Me.Show
            Me.Text2.SetFocus
            Exit Sub
        End If
        If Me.Text1.Text = Me.Text2.Text Then '如果选择的文件是同一个文件则退出
            MsgBox "对比路径一样请选" & vbNewLine & "择另外一个路径!!", , "提示"
            Frm_pr.Hide
            Me.Show
            Me.Text2.SetFocus
            Exit Sub
        End If
        path_1 = Me.Text1.Text
        path2_ = Me.Text2.Text    If Right(path_1, 1) <> "\" Then path_1 = LCase(path_1 & "\")
        If Right(path2_, 1) <> "\" Then path2_ = LCase(path2_ & "\")
        On Error Resume Next
        If Dir(path_1, vbDirectory) = "" Then
            MsgBox "请检查" & path_1 & "是否存在?", , "提示"
            Unload Frm_pr
            Me.Show
            Me.Text1.SetFocus
            Exit Sub
        End If
        If Dir(path2_, vbDirectory) = "" Then
            MsgBox "请检查" & path2_ & "是否存在?", , "提示"
            Unload Frm_pr
            Me.Show
            Me.Text1.SetFocus
            Exit Sub
        End If    x_ = path_1
        y_ = path2_
        flag1 = 1
        Call SearchDirs(path_1)
        flag1 = 0
        Call SearchDirs(path2_)
        shu = shu + 1
        If shu > 1 Then
            ps = 0
            ReDim Preserve filesbuf((UBound(filesbuf) + 1) / shu - 1)
        End If
        Frm_pr.ProgressBar1.max = UBound(filesbuf) + 1
        If Me.Option1 = True Then '比较方式选择
            Call fc_a '使用系统默认格式
            Frm_pr.ProgressBar1.Value = 0
            Unload Frm_pr
            Me.Show
            If Me.List1.ListCount > 0 Then
                Me.Command3.SetFocus
            Else
                Me.Command4.SetFocus
            End If
        Else
            Call fc_b '使用二进制格式
            Frm_pr.ProgressBar1.Value = 0
            Unload Frm_pr
            Me.Show
            If Me.List1.ListCount > 0 Then
                Me.Command3.SetFocus
            Else
                Me.Command4.SetFocus
            End If
            Me.Command3.SetFocus
        End If
    End SubPrivate Sub Command6_Click() '退出
        Unload Me
        End
    End SubPrivate Sub Form_Load() '初始窗体
        If Right(App.Path, 1) <> "\" Then apppath = App.Path & "\" '对运行目录进行判断
        On Error Resume Next '出错处理    If Command <> "" Then
            Me.Hide
            Frm_pr.Show
        
            ags = Split(Command, " ")
            Dim i As Integer
            If UBound(ags) + 1 < 2 Then End
            If Len(ags(0)) < 3 Then End
            If Len(ags(1)) < 3 Then End
            If InStr(ags(0), ":") = 0 Then End
            If InStr(ags(1), ":") = 0 Then End
           
            If Right(ags(0), 1) <> "\" Then ags(0) = ags(0) & "\"
            If Right(ags(1), 1) <> "\" Then ags(1) = ags(0) & "\"
            If InStr(ags(0), "/") <> 0 Then '对路径一进行处理（如果使用了“/”就把“/”去掉
                ags(0) = Replace(ags(0), "/", "")
            End If
            If Dir(ags(0)) = "" Then
                End
            End If        If InStr(ags(1), "/") <> 0 Then '对路径二进行处理（如果使用了“/”就把“/”去掉
                ags(1) = Replace(ags(1), "/", "")
            End If        If Dir(ags(1)) = "" Then
                End
            End If
            x_ = ags(0)
            y_ = ags(1)
            If UBound(ags) < 1 Then End '如果命令行参数少于2就推出程序        Dim flag As Integer
            flag = 0
            Dim flag1 As Integer
            flag1 = 0
            Dim flag2 As Integer
            flag2 = 0
            For i = 2 To UBound(ags)
                If InStr(ags(i), "/") <> 0 Then '对命令行参数处理
                    ags(i) = Replace(ags(i), "/", "")
                End If
                If InStr(ags(i), "-") <> 0 Then '对命令行参数处理
                    ags(i) = Replace(ags(i), "-", "")
                End If
                If LCase(ags(i)) = "a" Then '如果发现有参数"/a或者-a就置标识为1
                    flag = 1
                End If
                If LCase(ags(i)) = "b" Then '如果发现有参数"/b或者-b就置标识为1
                    flag1 = 1
                End If
                If LCase(ags(i)) = "y" Then '如果发现有参数"/y或者-y就置标识为1
                    flag2 = 1
                End If
                If InStr(LCase(ags(i)), "size:") = 0 Then
                    Size = 8192
                Else
                    Size = Mid(ags(i), 6, Len(ags(i)))
                End If
                If InStr(LCase(ags(i)), "s:") = 0 Then
                    sfilenmae = "same.txt"
                Else
                    sfilenmae = Mid(ags(i), 3, Len(ags(i)))
                End If
                If InStr(LCase(ags(i)), "d:") = 0 Then
                    dfilenmae = "different.txt"
                Else
                    dfilenmae = Mid(ags(i), 3, Len(ags(i)))
                End If
            Next
            If flag2 = 1 Then
                flag3 = "y"
            Else
                flag3 = "n"
            End If
            If flag3 = "y" Then
                If sfilenmae = "same.txt" Then
                    If Dir(apppath & "same.txt") <> "" Then DeleteFile "same.txt"
                Else
                    If Dir(apppath & sfilenmae) <> "" Then DeleteFile "same.txt"
                End If
                If dfilenmae = "different.txt" Then
                    If Dir(apppath & "different.txt") <> "" Then DeleteFile "different.txt"
                Else
                    If Dir(apppath & dfilenmae) <> "" Then DeleteFile "different.txt"
                End If
            End If  
            If flag = 1 And flag1 = 1 Then End
       
        
            If UBound(ags) = 1 Then
                flag3 = "y"
                Call fccmd
                End
            End If
            If flag = 1 Then '判断比较方式
                Call fccmd
                End
            Else
                Call fccmd_
                End
            End If
        End If
        End SubPrivate Sub Text1_GotFocus() '当TEXT1得到焦点就选择在TEXT1里的所有文字
        On Error Resume Next
        Text1.SelStart = 0
        Text1.SelLength = Len(Text1.Text)
    End Sub
      

  2.   

    Private Sub Text2_GotFocus() '当TEXT2得到焦点就选择在TEXT2里的所有文字
        On Error Resume Next
        Text2.SelStart = 0
        Text2.SelLength = Len(Text1.Text)
    End SubPrivate Sub lb() '用于控制LIST1对水平控制条的显示
        Me.ScaleMode = vbPixels
        Dim max As Integer, max_ As Integer
        With List1
            For max_ = 0 To .ListCount - 1
                If Me.TextWidth(.List(max_)) > max Then
                    max = Me.TextWidth(.List(max_)) + 5
                End If
            Next
        End With
                        
        If max > 232 Then
            SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, max, ByVal 0&
        End If
    End SubPrivate Sub lb_() '用于控制LIST2对水平控制条的显示
        Me.ScaleMode = vbPixels
        Dim max As Integer, max_ As Integer
        With List2
            For max_ = 0 To .ListCount - 1
                If Me.TextWidth(.List(max_)) > max Then
                    max = Me.TextWidth(.List(max_)) + 5
                End If
            Next
        End With
                        
        If max > 232 Then
            SendMessage List2.hwnd, LB_SETHORIZONTALEXTENT, max, ByVal 0&
        End If
    End SubPrivate Sub fc_a() '系统默认格式比较    For j = 0 To UBound(filesbuf)
        
            DoEvents        Dim hFile As Long, lenFile As Long, OF As OFSTRUCT, hfile_ As Long, ret As Long, ret_ As Long
            
            If Dir(filesbuf_(j)) <> "" Then
                hFile = OpenFile(filesbuf(j), OF, OF_READ) '打开文件一
                hfile_ = OpenFile(filesbuf_(j), OF, OF_READ) '打开文件二
                ret = GetFileSize(hFile, 0) '获取文件一的长度
                ret_ = GetFileSize(hfile_, 0) '获取文件二的长度
                If ret = ret_ Then '判断文件长度如果一样则继续下面的比较否则退出过程在LIST2中添加文件形
                    If ret = 0 Then
                        List1.AddItem filesbuf(j)
                        ps = ps + 1
                        Frm_pr.ProgressBar1.Value = ps
                    Else
                        Call CloseHandle(hFile)
                        Call CloseHandle(hfile_)
                        Call fc_a_
                    End If
                Else
                    List2.AddItem filesbuf(j)
                    ps = ps + 1
                    Frm_pr.ProgressBar1.Value = ps
                    Call lb_
                    Call CloseHandle(hFile)
                    Call CloseHandle(hfile_)
                End If
            Else
                List2.AddItem filesbuf(j)
                ps = ps + 1
                Frm_pr.ProgressBar1.Value = ps
            End If
        Next
     
    End SubPrivate Sub fc_b() '二进制方式比较
        For j = 0 To UBound(filesbuf)
            DoEvents
            Dim hFile As Long, lenFile As Long, OF As OFSTRUCT, hfile_ As Long, ret As Long, ret_ As Long
            If Dir(filesbuf_(j)) <> "" Then
                hFile = OpenFile(filesbuf(j), OF, OF_READ)
                hfile_ = OpenFile(filesbuf_(j), OF, OF_READ)
                ret = GetFileSize(hFile, 0)
                ret_ = GetFileSize(hfile_, 0)
                If ret = ret_ Then
                    If ret = 0 Then
                        List1.AddItem filesbuf(j)
                        ps = ps + 1
                        Frm_pr.ProgressBar1.Value = ps
                    Else
                        Call CloseHandle(hFile)
                        Call CloseHandle(hfile_)
                        Call fc_b_
                    End If
                Else
                    List2.AddItem filesbuf(j)
                    ps = ps + 1
                    Frm_pr.ProgressBar1.Value = ps
                    Call lb_
                    Call CloseHandle(hFile)
                    Call CloseHandle(hfile_)
                End If
            Else
                List2.AddItem filesbuf(j)
                ps = ps + 1
                Frm_pr.ProgressBar1.Value = ps
            End If
        NextEnd SubPrivate Sub fccmd() '命令行系统默认格式比较
        For j = 0 To UBound(filesbuf)
            DoEvents
            Dim fcstring As String
            Dim fcstring_ As String
            flag_ = 1 '置标识
            If Dir(filesbuf_(j)) <> "" Then
                Dim hFile As Long, lenFile As Long, OF As OFSTRUCT, hfile_ As Long, ret As Long, ret_ As Long
                hFile = OpenFile(filesbuf(j), OF, OF_READ)
                hfile_ = OpenFile(filesbuf_(j), OF, OF_READ)
                ret = GetFileSize(hFile, 0)
                ret_ = GetFileSize(hfile_, 0)
                If ret = ret_ Then
                    flag_ = 1 '表示有可能文件一样
                    Call CloseHandle(hFile)
                    Call CloseHandle(hfile_)                Frm_pr.Label1.Caption = "正在比较 :" & filesbuf(j) & "和" & filesbuf_(j) & "..."
                    Frm_pr.Label1.Refresh
                    Open filesbuf(j) For Input As #1
                    Open filesbuf_(j) For Input As #2
                    Do While (1)
                        DoEvents
                        Line Input #1, fcstring
                        Line Input #2, fcstring_
                        If fcstring <> fcstring_ Then
                            fcfile = filesbuf(j)
                            ps = ps + 1
                            Frm_pr.ProgressBar1.Value = ps
                            flag_ = 0
                            Close #1
                            Close #2
                            Call rr
                            Exit Do
                        End If
                        If fcstring = fcstring_ Then
                            If EOF(1) And EOF(2) Then
                                flag_ = 1
                                fcfiler = filesbuf(j)
                                ps = ps + 1
                                Frm_pr.ProgressBar1.Value = ps
                                Close #1
                                Close #2
                                Call rr
                                Exit Do
                            End If
                        End If
                    Loop
                Else
                    flag_ = 0 '表示文件不一样
                    fcfile = filesbuf(j)
                    Call CloseHandle(hFile)
                    Call CloseHandle(hfile_)
                    Call rr
                End If
            Else
                flag_ = 0 '表示文件不一样
                fcfile = filesbuf(j)
                Call rr
            End If
        Next
        Frm_pr.Refresh
    End Sub
      

  3.   

    Private Sub fccmd_() '用于命令行二进制比较方式
        For j = 0 To UBound(filesbuf_)
            DoEvents
            Dim fcstring() As Byte
            Dim fcstring_() As Byte
            dim i As long
    i = size
            ReDim fcstring(i)
            ReDim fcstring_(i)
            flag_ = 1 '置标识
            If Dir(filesbuf_(j)) <> "" Then
                Dim hFile As Long, lenFile As Long, OF As OFSTRUCT, hfile_ As Long, ret As Long, ret_ As Long
                hFile = OpenFile(filesbuf(j), OF, OF_READ)
                hfile_ = OpenFile(filesbuf_(j), OF, OF_READ)
                ret = GetFileSize(hFile, 0)
                ret_ = GetFileSize(hfile_, 0)
                If ret = ret_ Then
                    flag_ = 1 '表示有可能文件一样
                    Call CloseHandle(hFile)
                    Call CloseHandle(hfile_)
           
                    Frm_pr.Label1.Caption = "正在比较 :" & filesbuf(j) & "和" & filesbuf_(j) & "..."
                    Frm_pr.Label1.Refresh
                    Open filesbuf(j) For Binary As #1
                    Open filesbuf_(j) For Binary As #2
                    Do While (1)
                        DoEvents
                        Get #1, , fcstring
                        Get #2, , fcstring_
                        If fcstring(i) <> fcstring_(i) Then
                            fcfile = filesbuf(j)
                            ps = ps + 1
                            Frm_pr.ProgressBar1.Value = ps
                            flag_ = 0
                            Close #1
                            Close #2
                            Call rr
                            Exit Do
                        End If
                        If fcstring(i) = fcstring_(i) Then
                            If EOF(1) And EOF(2) Then
                                flag_ = 1
                                fcfiler = filesbuf(j)
                                ps = ps + 1
                                Frm_pr.ProgressBar1.Value = ps
                                Close #1
                                Close #2
                                Call rr
                                Exit Do
                            End If
                        End If
                    Loop
                Else
                    flag_ = 0 '表示文件不一样
                    fcfile = filesbuf(j)
                    ps = ps + 1
                    Frm_pr.ProgressBar1.Value = ps
                    Call CloseHandle(hFile)
                    Call CloseHandle(hfile_)
                    Call rr
                End If
            Else
                flag_ = 0 '表示文件不一样
                fcfile = ags(0) & filesbuf(j)
                ps = ps + 1
                Frm_pr.ProgressBar1.Value = ps
                Call rr
            End If
        Next
        Frm_pr.Refresh
    End SubPrivate Sub fc_a_()
        
        Dim fcstring As String
        Dim fcstring_ As String
        Open filesbuf(j) For Input As #1   '打开文件一用于比较
        Open filesbuf_(j) For Input As #2   '打开文件二用于比较
        Frm_pr.Label1.Caption = "正在比较 :" & filesbuf(j) & "和" & filesbuf_(j) & "..."
        Frm_pr.Label1.Refresh
        Do While (1)
            DoEvents '交出控制权因为有时在对大型比较时时间会很长不加这个函数的话会引起象死机的样子
            Line Input #1, fcstring '读取文件一数据
            Line Input #2, fcstring_ '读取文件二数据
            If fcstring <> fcstring_ Then '如果文件一的数据和文件二的数据不一样的话就证明文件不同退出过程
                List2.AddItem filesbuf(j)
                ps = ps + 1
                Frm_pr.ProgressBar1.Value = ps
                Call lb_
                Close #1
                Close #2
                Exit Do
            End If
            If fcstring = fcstring_ Then '如果文件一的数据和文件二的数据一样并且都到尾了的话就证明文件完全一样
                If EOF(1) And EOF(2) Then
                    List1.AddItem filesbuf(j)
                    ps = ps + 1
                    Frm_pr.ProgressBar1.Value = ps
                    Call lb
                    Close #1
                    Close #2
                    Exit Do
                End If
            End If
        LoopEnd SubPrivate Sub fc_b_()
        Dim fcstring() As Byte
        Dim fcstring_() As Byte
        dim i As long
        i = 8192
        ReDim fcstring(i)
        ReDim fcstring_(i)
        Open filesbuf(j) For Binary As #1 '打开文件一用于比较
        Open filesbuf_(j) For Binary As #2  '打开文件二用于比较
        Frm_pr.Label1.Caption = "正在比较 :" & filesbuf(j) & "和" & filesbuf_(j) & "..."
        Frm_pr.Label1.Refresh
        Do While (1)
            DoEvents '交出控制权因为有时在对大型比较时时间会很长不加这个函数的话会引起象死机的样子
            Get #1, , fcstring
            Get #2, , fcstring_
            If fcstring(i) <> fcstring_(i) Then '如果文件一的数据和文件二的数据不一样的话就证明文件不同退出过程
                List2.AddItem filesbuf(j)
                ps = ps + 1
                Frm_pr.ProgressBar1.Value = ps
                Call lb_
                Close #1
                Close #2
                Exit Sub
            End If
            If fcstring(i) = fcstring_(i) Then '如果文件一的数据和文件二的数据一样并且都到尾了的话就证明文件完全一样
                If EOF(1) And EOF(2) Then
                    List1.AddItem filesbuf(j)
                    ps = ps + 1
                    Frm_pr.ProgressBar1.Value = ps
                    Call lb
                    Close #1
                    Close #2
                    Exit Sub
                End If
            End If
        LoopEnd SubSub rr()
        On Error Resume Next '出错处理
        If flag_ = 1 Then
            Open sfilename For Append As #5
            Print #5, fcfiler
            Close #5
        Else
            Open dfilename For Append As #5
            Print #5, fcfile
            Close #5
        End IfEnd Sub另为一个窗体只放控件没任何代码:
      

  4.   

    我想楼主要是使用FSO来的话问题造就解决了。
      

  5.   

    不是这个原因,使用FSO对象好是好但是在一些精简版系统中没WSCRIPT.EXE和相关的DLL支持就不能正常运行,还是不好问题是出在编译器上要去掉一些代码才行
      

  6.   

    现在的WINDOWS系统都有SCRIPT RUNTIME运行库的，至于那个WSCRIPT。EXE和有没有FSO对象支持是两回事
      

  7.   

    楼上误会我的意思了
    我说的是那个DLL叫是**RUN.DLL的而且这个程序出错跟这个扯不上关系.我个人认为是VB编译器的问题
    我也就告诉大家吧问题出在SetAttr curpath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1), 0
    这句上面去掉这句一切OK