⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 form1.frm

📁 VB批量处理RAR文件 可以删除RAR文件里的任何文件 可以添加注释文件到RAR文件里 可以处理RAR文件里的文件夹 等等
💻 FRM
字号:
🔍 
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "批量RAR文件操作"
   ClientHeight    =   4920
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4410
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4920
   ScaleWidth      =   4410
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command6 
      Caption         =   "重新修改有空格的RAR文件名称"
      Height          =   495
      Left            =   195
      TabIndex        =   6
      Top             =   3720
      Width           =   4000
   End
   Begin VB.CommandButton Command4 
      Caption         =   "重命名文件夹【Downcode.com】"
      Height          =   495
      Left            =   200
      TabIndex        =   5
      Top             =   3015
      Width           =   4000
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   405
      Left            =   195
      TabIndex        =   4
      Top             =   4380
      Width           =   4005
      _ExtentX        =   7064
      _ExtentY        =   714
      _Version        =   393216
      BorderStyle     =   1
      Appearance      =   1
   End
   Begin VB.CommandButton Command5 
      Caption         =   "删除【Downcode.com.txt】"
      Height          =   495
      Left            =   200
      TabIndex        =   3
      Top             =   195
      Width           =   4000
   End
   Begin VB.CommandButton Command3 
      Caption         =   "删除【中国源码下载站.url】"
      Height          =   495
      Left            =   200
      TabIndex        =   2
      Top             =   885
      Width           =   4000
   End
   Begin VB.CommandButton Command2 
      Caption         =   "添加注释文件【万码下载站.htm】"
      Height          =   495
      Left            =   200
      TabIndex        =   1
      Top             =   2310
      Width           =   4000
   End
   Begin VB.CommandButton Command1 
      Caption         =   "添加注释文件【10000ma.com】"
      Height          =   495
      Left            =   200
      TabIndex        =   0
      Top             =   1605
      Width           =   4000
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Const GetWinRARPath = "C:\Program Files\WinRAR\WinRAR"

Private Sub Command1_Click() '添加注释 10000ma.txt
ProgressBar1.Value = 0
Dim FilePath As String
Dim I, J
FilePath = App.Path
nCount = 0
bCancel = False
With FP
.sFileNameExt = "*.rar"
.sFileRoot = FilePath
End With
ReDim sAllFiles(1 To 1000000) As String
Call GetAllFilesSpecified(FP)
If nCount > 0 Then
ReDim Preserve sAllFiles(1 To nCount)
ProgressBar1.Max = nCount
For I = 1 To nCount
DoEvents
FilePath = sAllFiles(I)
ProgressBar1.Value = I
Call 注释(FilePath, "10000ma.txt")
Next
End If
End Sub

Sub compress(ByVal SOURCE As String, ByVal TARGET As String)
If Not GetWinRARPath = "" And Dir(SOURCE) > "" Then Shell GetWinRARPath & " a " & TARGET & " " & SOURCE, vbHide
End Sub

Sub decompress(ByVal SOURCE As String, ByVal TARGET As String)
If Not GetWinRARPath = "" And Dir(SOURCE) > "" Then Shell GetWinRARPath & " x " & SOURCE & " " & TARGET, vbHide
End Sub

Sub 注释(RFile As String, SFile As String)
Shell GetWinRARPath & " c -z" & SFile & " " & RFile, vbHide
End Sub

Sub 注释文件(RFile As String, SFile As String)
Shell GetWinRARPath & " c " & RFile & " >" & SFile, vbHide
End Sub

Sub 删除文件(RFile As String, SFile As String)
Shell GetWinRARPath & " d -inul " & RFile & " " & SFile, vbHide
End Sub

Sub 重命名文件夹(RFile As String, SFile As String, RnFile As String)
Dim Str
Str = GetWinRARPath & " rn -ibck -r -or " & RFile & " " & SFile & " " & RnFile
Shell Str, vbHide
End Sub

Sub 添加(RFile As String, SFile As String)
Shell GetWinRARPath & " a " & RFile & " " & SFile, vbHide
End Sub

Private Sub Command2_Click()
ProgressBar1.Value = 0
Dim FilePath As String
Dim I, J
FilePath = App.Path
nCount = 0
bCancel = False
With FP
.sFileNameExt = "*.rar"
.sFileRoot = FilePath
End With
ReDim sAllFiles(1 To 1000000) As String
Call GetAllFilesSpecified(FP)
If nCount > 0 Then
ReDim Preserve sAllFiles(1 To nCount)
ProgressBar1.Max = nCount
For I = 1 To nCount
DoEvents
FilePath = sAllFiles(I)
ProgressBar1.Value = I
Call 添加(FilePath, "万码下载说明.htm")
Next
End If
End Sub

Private Sub Command3_Click() '删除 中国源码下载站.url
Dim FilePath As String
Dim I, J
ProgressBar1.Value = 0
FilePath = App.Path
nCount = 0
bCancel = False
With FP
.sFileNameExt = "*.rar"
.sFileRoot = FilePath
End With
ReDim sAllFiles(1 To 1000000) As String
Call GetAllFilesSpecified(FP)
If nCount > 0 Then
ReDim Preserve sAllFiles(1 To nCount)
ProgressBar1.Max = nCount
For I = 1 To nCount
DoEvents
FilePath = sAllFiles(I)
ProgressBar1.Value = I
Call 删除文件(FilePath, "中国源码下载站.*")
Next
End If
End Sub

Private Sub a() '解压缩
'："c:\program files\winrar\winrar.exe" a -x@d:\cleandesk\list.txt -df -r d:\cleandesk\desk.rar "C:\Documents and settings\USER01\桌面\*.*"，并将该快捷方式命名为“桌面清理”。
End Sub

Private Sub Command4_Click() '重命名文件夹downcode.com
ProgressBar1.Value = 0
Dim FilePath As String
Dim I, J
FilePath = App.Path
nCount = 0
bCancel = False
With FP
.sFileNameExt = "*.rar"
.sFileRoot = FilePath
End With
ReDim sAllFiles(1 To 1000000) As String
Call GetAllFilesSpecified(FP)
If nCount > 0 Then
ReDim Preserve sAllFiles(1 To nCount)
ProgressBar1.Max = nCount
For I = 1 To nCount
DoEvents
FilePath = sAllFiles(I)
ProgressBar1.Value = I
Call 重命名文件夹(FilePath, "downcode.com", "10000ma")
Next
End If
MsgBox "完成"
End Sub

Private Sub Command5_Click() '删除 downcode.com.txt
ProgressBar1.Value = 0
Dim FilePath As String
Dim I, J
FilePath = App.Path
nCount = 0
bCancel = False
With FP
.sFileNameExt = "*.rar"
.sFileRoot = FilePath
End With
ReDim sAllFiles(1 To 1000000) As String
Call GetAllFilesSpecified(FP)
If nCount > 0 Then
ReDim Preserve sAllFiles(1 To nCount)
ProgressBar1.Max = nCount
For I = 1 To nCount
DoEvents
FilePath = sAllFiles(I)
ProgressBar1.Value = I
Call 删除文件(FilePath, "downcode.*")
Next
End If
End Sub

Private Sub Command6_Click()
Err.Clear
On Error Resume Next
ProgressBar1.Value = 0
Dim FSo, Ts
Dim FilePath As String
Dim I, J
FilePath = App.Path
nCount = 0
bCancel = False
With FP
.sFileNameExt = "*.rar"
.sFileRoot = FilePath
End With
ReDim sAllFiles(1 To 1000000) As String
Call GetAllFilesSpecified(FP)
If nCount > 0 Then
ReDim Preserve sAllFiles(1 To nCount)
ProgressBar1.Max = nCount
Set FSo = CreateObject("Scripting.FileSystemObject")
For I = 1 To nCount
DoEvents
FilePath = sAllFiles(I)
ProgressBar1.Value = I
Set Ts = FSo.GetFile(FilePath)
Ts.Name = Replace(Ts.Name, " ", "", 1, -1, 1)
Set Ts = Nothing
Next
End If
Set FSo = Nothing
MsgBox "完成"
End Sub

Private Sub Form_DblClick()
Dim Temp
Dim FSo, Ts
Dim FS As New FileSystemObject
ProgressBar1.Value = 0
Dim FilePath As String
Dim I, J, K
FilePath = App.Path
nCount = 0
bCancel = False
With FP
.sFileNameExt = "*.rar"
.sFileRoot = FilePath
End With
ReDim sAllFiles(1 To 1000000) As String
Call GetAllFilesSpecified(FP)
If nCount > 0 Then
ReDim Preserve sAllFiles(1 To nCount)
ProgressBar1.Max = nCount
For I = 1 To nCount
DoEvents
ProgressBar1.Value = I
FilePath = sAllFiles(I)
J = InStr(1, FilePath, ".rar", 1)
K = InStrRev(FilePath, "\", -1, 1)
FilePath = Mid(FilePath, K + 1, J - K + 3)
Temp = Temp & FilePath & vbNewLine
Next
'保存
Set FSo = CreateObject("Scripting.FileSystemObject")
Set Ts = FSo.CreateTextFile(App.Path & "\List.txt", True)
Ts.WriteLine Temp
Ts.Close
Set FSo = Nothing
Set Ts = Nothing
End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -