📄 frmbe.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form FrmBe
BorderStyle = 1 'Fixed Single
Caption = "文件比较copy"
ClientHeight = 5970
ClientLeft = 45
ClientTop = 330
ClientWidth = 5280
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "FrmBe.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "FrmBe.frx":0442
ScaleHeight = 5970
ScaleWidth = 5280
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 3000
Left = 3720
Top = 5520
End
Begin VB.CommandButton Command1
BackColor = &H80000009&
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2040
Style = 1 'Graphical
TabIndex = 8
Top = 5520
Width = 855
End
Begin VB.Frame Frame1
BackColor = &H00FFC0FF&
Caption = "说明:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1215
Left = 120
TabIndex = 5
Top = 1440
Width = 4935
Begin VB.CommandButton Cmdcopy
BackColor = &H80000009&
Caption = "Copy"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3480
Style = 1 'Graphical
TabIndex = 6
Top = 360
Width = 855
End
Begin VB.Label Label1
BackColor = &H00FFC0FF&
Caption = "copy将会把文件夹2中不同的内容，拷贝到文件夹1中。以下文本框为内容显示区...."
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 360
TabIndex = 7
Top = 240
Width = 2895
End
End
Begin VB.TextBox TxtDif
BackColor = &H00E0E0E0&
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2895
Left = 120
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 4
Top = 2760
Width = 4935
End
Begin VB.CommandButton cmdView2
BackColor = &H80000009&
Caption = "比较文件夹"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3240
Style = 1 'Graphical
TabIndex = 3
Top = 720
Width = 1335
End
Begin VB.TextBox TxtFile2
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
Locked = -1 'True
TabIndex = 2
Top = 720
Width = 2535
End
Begin VB.TextBox TxtFile1
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
Locked = -1 'True
TabIndex = 1
Top = 120
Width = 2535
End
Begin VB.CommandButton CmdView1
BackColor = &H80000009&
Caption = "源文件夹"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3240
Style = 1 'Graphical
TabIndex = 0
Top = 120
Width = 1335
End
Begin MSComDlg.CommonDialog dialog
Left = 2760
Top = 960
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
End
Attribute VB_Name = "FrmBe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fileName1 As String
Dim fileName2 As String
Dim col1 As New Collection
Dim col2 As New Collection
Dim cold As New Collection
Dim flagWhat As Boolean
Private Sub Cmdcopy_Click()
On Error GoTo err1
Dim i As Integer
Dim cmdStr As String
Dim fileNumber As Integer
If Dir(App.Path & "\cmdStr.bat", vbHidden) <> Empty Then
SetAttr App.Path & "\cmdStr.bat", vbNormal
Kill (App.Path & "\cmdStr.bat")
End If
fileNumber = FreeFile
For i = 1 To cold.Count
cmdStr = cmdStr & "copy " & fileName2 & "\" & cold(i) & " " & fileName1 & vbCrLf
Next
' Open "c:\1\1.txt" For Output As #2
' Close #2
Open App.Path & "\cmdStr.bat" For Output As #fileNumber
Print #fileNumber, cmdStr
Close #fileNumber
Shell App.Path & "\cmdStr.bat"
Timer1.Enabled = True
MsgBox "已成功完成复制任务!", vbInformation, "任务成功完成"
Exit Sub
err1:
MsgBox Err.Description
MsgBox "请检查毕业设计助手的存储路径中是否含有中文!", vbCritical, "错误"
End Sub
Private Function addDifCol()
On Error GoTo err1
Dim i, j, z, find As Boolean
If fileName1 = Empty Or fileName2 = Empty Then
MsgBox "请选择好文件"
Exit Function
End If
'第一个游览为主文件
For i = 1 To col2.Count
'还原
find = False
For j = 1 To col1.Count
Debug.Print col2(i) & " d: " & col1(j)
If col2(i) = col1(j) Then
find = True
Exit For
End If
Next
If find = False Then
cold.add col2(i)
TxtDif.Text = TxtDif.Text & col2(i) & vbCrLf
End If
Next
Exit Function
err1:
MsgBox Err.Description
End Function
Private Sub CmdView1_Click()
On Error GoTo err1
dialog.CancelError = True
dialog.ShowOpen
fileName1 = dialog.filename
fileName1 = Replace(fileName1, dialog.FileTitle, "")
fileName1 = Left(fileName1, Len(fileName1) - 1)
'复原操作
TxtDif.Text = ""
For i = 1 To col1.Count
col1.Remove (1)
Next
add fileName1
TxtFile1.Text = fileName1
Exit Sub
err1:
MsgBox "必顺选择"
End Sub
Public Function add(ByVal Fpath As String, Optional ByVal fType As Integer = 1)
Dim tempFileName As String
tempFileName = Dir(Fpath & "\*.*")
If tempFileName <> Empty And fType = 1 Then col1.add tempFileName
If tempFileName <> Empty And fType = 2 Then col2.add tempFileName
While tempFileName <> Empty
tempFileName = Dir
If fType = 1 Then
col1.add tempFileName
Else
col2.add tempFileName
End If
Wend
If Dir(App.Path & "\cmdStr.bat") <> Empty Then Kill (App.Path & "\cmdStr.bat")
End Function
Private Sub cmdView2_Click()
On Error GoTo err1
If fileName1 = Empty Then
MsgBox "请先选择源文件"
Exit Sub
End If
dialog.CancelError = True
dialog.ShowOpen
fileName2 = dialog.filename
fileName2 = Replace(fileName2, dialog.FileTitle, "")
fileName2 = Left(fileName2, Len(fileName2) - 1)
'复原操作
TxtDif.Text = ""
For i = 1 To col2.Count
col2.Remove (1)
Next
For i = 1 To cold.Count
cold.Remove (1)
Next
add fileName2, 2
TxtFile2.Text = fileName2
'得到不同的文件集合
addDifCol
Exit Sub
err1:
MsgBox "必顺选择"
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
Label1.Caption = "copy将会把比较文件夹中不同的内容，拷贝到源文件夹中。" & vbCrLf & "以下文本框为内容显示区(显示出比较文件夹比源文件夹中多出的文件!)...."
TxtDif.Text = vbCrLf & vbCrLf & " 说明" & vbCrLf & " 毕业设计合成时，常会比较两个文件夹有什么不同的文件，并把新加的文件复制到以前的文件夹中，而且要求不产生文件替换问题，相信这个程序能解决此问题!"
End Sub
Private Sub Timer1_Timer()
SetAttr App.Path & "\cmdStr.bat", vbHidden
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -