VB制作一个简单的电脑端文件名批量定规则修改工具

没有找到VB6的代码块，直接上到VB.NET里了。

程序代码：

Dim bModifyFlag, bRenameFlag As Boolean
Dim iModifyCount As Integer


Private Sub cmdAddTypeName_Click()
If LTrim(txtTypeName.Text) <> "" Then
Dim i As Integer
Dim bDiffFlag As Boolean
bDiffFlag = False
For i = 0 To cobTypeNameList.ListCount - 1
 If LTrim(txtTypeName.Text) = cobTypeNameList.List(i) Then
    bDiffFlag = True
    Exit For
 End If
Next i
If Not bDiffFlag Then
cobTypeNameList.AddItem (LTrim(txtTypeName.Text))
labActionStatus.ForeColor = vbRed
labActionStatus.Caption = "添加成功！"
bModifyFlag = True
iModifyCount = 0
Else
MsgBox "该后缀名已存在，请勿重复添加！", vbOKOnly, "提交的信息有误!"
End If
End If
End Sub

Private Sub cmdDeleteTypeName_Click()
If cobTypeNameList.ListIndex >= 0 Then
cobTypeNameList.RemoveItem (cobTypeNameList.ListIndex)
labActionStatus.ForeColor = vbBlue
labActionStatus.Caption = "删除成功！"
bModifyFlag = True
iModifyCount = 0
End If
End Sub

Private Sub cmdModifyComfirm_Click()
Dim Flie1Cycle, iCycleNum As Integer
Dim strDirPath, strDirPathCompare As String
iCycleNum = 0
strDirPath = File1.Path
'MsgBox File1.Path
If File1.ListCount > 0 Then
    If cobTypeNameList.Text = "" Or cobTypeNameList.Text = "*.*" Or cobTypeNameList = "==请选择后缀名==" Then
        labModifyStatus.ForeColor = vbRed
        labModifyStatus.Caption = "请选择一种后缀名！"
    ElseIf LTrim(txtRenameName) <> "" And LTrim(txtRenameName) <> "==请填写新文件名==" Then
        For Flie1Cycle = 0 To File1.ListCount - 1
         strDirPathCompare = InStrRev(strDirPath, "\") '判断右侧是否有斜杠
         If strDirPathCompare <> 1 Then
         strDirPath = strDirPath & "\"
         End If
        'MsgBox strDirPath
        If opNum Then
        'a = Replace(File1.List(Flie1Cycle), File1.List(Flie1Cycle), LTrim(txtRenameName) & iCycleNum)
        Name strDirPath & File1.List(Flie1Cycle) As strDirPath & LTrim(txtRenameName) & iCycleNum & cobTypeNameList.Text '重命名文件
        ElseIf opDateNum Then
        Name strDirPath & File1.List(Flie1Cycle) As strDirPath & LTrim(txtRenameName) & Day(Now()) & iCycleNum & cobTypeNameList.Text '重命名文件
        ElseIf opYMDHMS Then
        Name strDirPath & File1.List(Flie1Cycle) As strDirPath & LTrim(txtRenameName) & Year(Now()) & Month(Now()) & Day(Now()) & Hour(Now()) & Minute(Now()) & Second(Now()) & iCycleNum & cobTypeNameList.Text    '重命名文件
        Else
        labModifyStatus.ForeColor = vbRed
        labModifyStatus.Caption = "请选择修改类型！"
        End If
        
        iCycleNum = iCycleNum + 1
        Next Flie1Cycle
    If opNum Or opDateNum Or opYMDHMS Then
    File1.Refresh
    labModifyStatus.ForeColor = vbRed
    labModifyStatus.Caption = "重命名成功！"
    bRenameFlag = True
    bModifyFlag = True
    iModifyCount = 0
    End If
    Else
        labModifyStatus.ForeColor = vbRed
        labModifyStatus.Caption = "请填写有效新文件名！"
    End If
End If
End Sub

Private Sub Dir1_Change()
If Not (cobTypeNameList.Text) = "==请选择后缀名==" Then
File1.Pattern = "*" & cobTypeNameList.Text
Else
File1.Pattern = "*.*"
End If
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1
End Sub

Private Sub File1_DblClick()
MsgBox File1.Path
End Sub

Private Sub Form_Load()
Timer1.Enabled = True
Timer1.Interval = "500"
End Sub

Private Sub Timer1_Timer()
If bModifyFlag Then
'MsgBox iModifyCount
    If iModifyCount Mod 2 = 0 Then
        If Not bRenameFlag Then labActionStatus.Visible = False
        If bRenameFlag Then labModifyStatus.Visible = False
    Else
        If Not bRenameFlag Then labActionStatus.Visible = True
        If bRenameFlag Then labModifyStatus.Visible = True
    End If
iModifyCount = iModifyCount + 1
If iModifyCount >= 6 Then
    labActionStatus.ForeColor = vbBlack
    labActionStatus.Caption = "暂无操作"
    labModifyStatus.ForeColor = vbBlack
    labModifyStatus.Caption = "暂无操作"
    bModifyFlag = False
    bRenameFlag = False
End If
End If
End Sub

Private Sub txtRenameName_Change()
        labModifyStatus.ForeColor = vbBlack
        labModifyStatus.Caption = "暂无操作"
End Sub