Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private 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函数
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Const LB_SETHORIZONTALEXTENT = &H194
Public apppath As String
Dim ags() As String
Public filepath As String
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName As String * 128
End Type
Private Sub Form_Initialize()
InitCommonControls
End Sub
Private Sub Command1_Click()
With CommonDialog1
On Error GoTo err_
.CancelError = True
.DialogTitle = "请选择文件..."
.Filter = "所有文件 (*.*)|*.*"
.Flags = &H4
.ShowOpen
End With
Me.Text1.Text = CommonDialog1.FileName
err_:
End Sub
Private Sub Command2_Click()
With CommonDialog2
On Error GoTo err_
.CancelError = True
.DialogTitle = "请选择文件..."
.Filter = "所有文件 (*.*)|*.*"
.Flags = &H4
.ShowOpen
End With
Me.Text2.Text = CommonDialog2.FileName
err_:
End Sub
Private 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
Print #3, List1.List(i)
Next
Close #3
err_:
End Sub
Private 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
Print #4, List2.List(i)
Next
Close #4
err_:
End Sub
Private Sub Command5_Click()
If Me.Text1.Text = "" Or Me.Text1.Text = "请输入文件一" Then
MsgBox "请输入文件 1或者" & vbNewLine & "浏览选择一个文件", , "提示"
Me.Text1.SetFocus
Exit Sub
End If
If Me.Text2.Text = "" Or Me.Text2.Text = "请输入文件二" Then
MsgBox "请输入文件 2或者" & vbNewLine & "浏览选择一个文件", , "提示"
Me.Text2.SetFocus
Exit Sub
End If
If Me.Text1.Text = Me.Text2.Text Then
MsgBox "对比文件是同一个文件" & vbNewLine & "请选择另外一个文件!!!", , "提示"
Me.Text2.SetFocus
Exit Sub
End If
If Me.Option1 = True Then
Call fc_a
Else
Call fc_b
End If
End Sub
Private Sub Command6_Click()
Unload Me
End
End Sub
Private Sub Form_Load()
If Command <> "" Then
Me.Hide
End If
If Right(App.Path, 1) <> "\" Then apppath = App.Path & "\"
ags = Split(Command, " ")
Dim i As Integer
On Error Resume Next
If InStr(ags(0), "/") <> 0 Then
ags(0) = Replace(ags(0), "/", "")
End If
If Command() <> "" Then
If Dir(ags(0)) = "" Then
End
End If
End If
If InStr(ags(1), "/") <> 0 Then
ags(1) = Replace(ags(1), "/", "")
End If
If Command() <> "" Then
If Dir(ags(1)) = "" Then
End
End If
End If
If Command <> "" And UBound(ags) < 2 Then End
Dim flag As Integer
flag = 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
flag = 1
Else
flag = 0
End If
Next
If Command <> "" And flag = 1 Then
Call fccmd
Else
Call fccmd_
End If
End Sub
Private Sub Text1_GotFocus()
On Error Resume Next
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub Text2_GotFocus()
On Error Resume Next
Text2.SelStart = 0
Text2.SelLength = Len(Text1.Text)
End Sub
Private Sub lb()
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 Sub
Private Sub lb_()
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 Sub
Private Sub fc_a()
Dim fcstring As String
Dim fcstring_ As String
Dim hFile As Long, lenFile As Long, OF As OFSTRUCT, hfile_ As Long, ret As Long, ret_ As Long
hFile = OpenFile(Me.Text1.Text, OF, OF_READ)
hfile_ = OpenFile(Me.Text2.Text, OF, OF_READ)
ret = GetFileSize(hFile, 0)
ret_ = GetFileSize(hfile_, 0)
If ret = ret_ Then
Call CloseHandle(hFile)
Call CloseHandle(hfile_)
Else
List2.AddItem Me.Text1.Text
Call lb_
Call CloseHandle(hFile)
Call CloseHandle(hfile_)
Exit Sub
End If
Open Me.Text1.Text For Input As #1
Open Me.Text2.Text For Input As #2
Do While (1)
DoEvents
If Not EOF(1) And EOF(2) Then
List2.AddItem Me.Text1.Text
Call lb_
Close #1
Close #2
Exit Sub
End If
If Not EOF(2) And EOF(1) Then
List2.AddItem Me.Text1.Text
Call lb_
Close #1
Close #2
Exit Sub
End If
Input #1, fcstring
Input #2, fcstring_
If fcstring = fcstring_ Then
If EOF(1) And EOF(2) Then
List1.AddItem Me.Text1.Text
Call lb
Close #1
Close #2
Exit Sub
End If
End If
If fcstring <> fcstring_ Then
List2.AddItem Me.Text1.Text
Call lb_
Close #1
Close #2
Exit Sub
End If
Loop
Close #1
Close #2
End Sub
Private Sub fc_b()
Dim Filestring As Byte
Dim Filestring_ As Byte
Dim hFile As Long, lenFile As Long, OF As OFSTRUCT, hfile_ As Long, ret As Long, ret_ As Long
hFile = OpenFile(Me.Text1.Text, OF, OF_READ)
hfile_ = OpenFile(Me.Text2.Text, OF, OF_READ)
ret = GetFileSize(hFile, 0)
ret_ = GetFileSize(hfile_, 0)
If ret = ret_ Then
Call CloseHandle(hFile)
Call CloseHandle(hfile_)
Else
List2.AddItem Me.Text1.Text
Call lb_
Call CloseHandle(hFile)
Call CloseHandle(hfile_)
Exit Sub
End If
Open Me.Text1.Text For Binary As #1
Open Me.Text2.Text For Binary As #2
Do While (1)
DoEvents
If Not EOF(1) And EOF(2) Then
List2.AddItem Me.Text1.Text
Call lb_
Close #1
Close #2
Exit Sub
End If
If Not EOF(2) And EOF(1) Then
List2.AddItem Me.Text1.Text
Call lb_
Close #1
Close #2
Exit Sub
End If
Get #1, , Filestring
Get #2, , Filestring_
If Filestring = Filestring_ Then
If EOF(1) And EOF(2) Then
List1.AddItem Me.Text1.Text
Call lb
Close #1
Close #2
Exit Sub
End If
End If
If Filestring <> Filestring_ Then
List2.AddItem Me.Text1.Text
Call lb_
Close #1
Close #2
Exit Sub
End If
Loop
End Sub
Private Sub fccmd()
Dim fcfile As String
Dim fcfiler As String
Dim fcstring As String
Dim fcstring_ As String
Dim flag As Integer
flag = 1
Dim hFile As Long, lenFile As Long, OF As OFSTRUCT, hfile_ As Long, ret As Long, ret_ As Long
hFile = OpenFile(ags(0), OF, OF_READ)
hfile_ = OpenFile(ags(1), OF, OF_READ)
ret = GetFileSize(hFile, 0)
ret_ = GetFileSize(hfile_, 0)
If ret = ret_ Then
flag = 1
Call CloseHandle(hFile)
Call CloseHandle(hfile_)
Else
flag = 0
fcfile = ags(0)
Call lb_
Call CloseHandle(hFile)
Call CloseHandle(hfile_)
GoTo rr:
End If
Open ags(0) For Input As #1
Open ags(1) For Input As #2
Do While (1)
DoEvents
If Not EOF(1) And EOF(2) Then
fcfile = ags(0)
flag = 0
Close #1
Close #2
Exit Do
End If
If Not EOF(2) And EOF(1) Then
fcfile = ags(0)
flag = 0
Close #1
Close #2
Exit Do
End If
Input #1, fcstring
Input #2, fcstring_
If fcstring = fcstring_ Then
If EOF(1) And EOF(2) Then
flag = 1
fcfiler = ags(0)
Close #1
Close #2
Exit Do
End If
End If
If fcstring <> fcstring_ Then
fcfile = ags(0)
flag = 0
Close #1
Close #2
Exit Do
End If
Loop
Close #1
Close #2
rr:
If flag = 1 Then
Open apppath & "same.txt" For Append As #5
Print #5, fcfiler
Close #5
Else
Open apppath & "different.txt" For Append As #5
Print #5, fcfile
Close #5
End If
End
End Sub
Private Sub fccmd_()
Dim fcfile As String
Dim fcfiler As String
Dim fcstring As Byte
Dim fcstring_ As Byte
Dim flag As Integer
flag = 1
Dim hFile As Long, lenFile As Long, OF As OFSTRUCT, hfile_ As Long, ret As Long, ret_ As Long
hFile = OpenFile(ags(0), OF, OF_READ)
hfile_ = OpenFile(ags(1), OF, OF_READ)
ret = GetFileSize(hFile, 0)
ret_ = GetFileSize(hfile_, 0)
If ret = ret_ Then
flag = 1
Call CloseHandle(hFile)
Call CloseHandle(hfile_)
Else
flag = 0
fcfile = ags(0)
Call lb_
Call CloseHandle(hFile)
Call CloseHandle(hfile_)
GoTo err:
End If
Open ags(0) For Binary As #10
Open ags(1) For Binary As #20
Do While (1)
DoEvents
If Not EOF(10) And EOF(20) Then
fcfile = ags(0)
flag = 0
Close #10
Close #20
Exit Do
End If
If Not EOF(20) And EOF(10) Then
fcfile = ags(0)
flag = 0
Close #10
Close #20
Exit Do
End If
Get #10, , fcstring
Get #20, , fcstring_
If fcstring = fcstring_ Then
If EOF(10) And EOF(20) Then
flag = 1
fcfiler = ags(0)
Close #10
Close #20
Exit Do
End If
End If
If fcstring <> fcstring_ Then
fcfile = ags(0)
flag = 0
Close #10
Close #20
Exit Do
End If
Loop
Close #10
Close #20
err:
If flag = 1 Then
Open apppath & "same.txt" For Append As #50
Print #50, fcfiler
Close #50
Else
Open apppath & "different.txt" For Append As #50
Print #50, fcfile
Close #50
End If
End
End Sub
ssss
