查看: 1307  |  回复: 2
本帖产生 1 个 程序强帖 ,点击这里进行查看

zzahkj

木虫 (著名写手)


[交流] VB.net实现删除文件的问题

用VB.net实现删除同一文件夹下相同名称的所有文件,表达不好,还是举个例子吧,比如说删除某一文件夹下有zz.txt,zz.doc,zz.shp 。。。。就是名为zz的全删除,用VB.net编程该如何实现?
回复此楼
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
★ ★ ★ ★ ★ ★
小木虫(金币+0.5):给个红包,谢谢回帖
微尘、梦想(金币+5, 程序强帖+1): 谢谢参与应助! 2011-05-14 19:50:35
http://webservices.ctocio.com.cn/net/182/9255182.shtml
VB.NET版     
Imports System.IO   
Imports System.IO.Directory   
' ======================================================   
' 实现一个静态方法将指定文件夹下面的所有内容copy到目标文件夹下面   
' 如果目标文件夹为只读属性就会报错。   
' ======================================================   
Public Shared Sub CopyDir(ByVal srcPath As String, ByVal aimPath As String)   
Try   
' 检查目标目录是否以目录分割字符\结束,如果不是则添加之   
If aimPath(aimPath.Length - 1) <> Path.DirectorySeparatorChar Then   
aimPath += Path.DirectorySeparatorChar   
End If   
'判断源目录是否存在,不存在则退出.   
If (Not Directory.Exists(srcPath)) Then Exit Sub   
' 判断目标目录是否存在如果不存在则新建之   
If (Not Directory.Exists(aimPath)) Then Directory.CreateDirectory(aimPath)   
' 得到源目录的文件列表,该里面是包含文件以及目录路径的一个数组   
' 如果你指向copy目标文件下面的文件而不包含目录请使用下面的方法   
' string[] fileList = Directory.GetFiles(srcPath);   
Dim fileList() As String = Directory.GetFileSystemEntries(srcPath)   
' 遍历所有的文件和目录   
For Each FileName As String In fileList   
' 先当作目录处理如果存在这个目录就递归Copy该目录下面的文件   
If Directory.Exists(FileName) Then   
CopyDir(FileName, aimPath + Path.GetFileName(FileName))   
' 否则直接Copy文件   
Else   
File.Copy(FileName, aimPath + Path.GetFileName(FileName), True)   
End If   
Next   
Catch ex As Exception   
MessageBox.Show(ex.ToString())   
End Try   
End Sub   
' ======================================================   
' 实现一个静态方法将指定文件夹下面的所有内容Detele   
' 测试的时候要小心*作,删除之后无法恢复。   
' ======================================================   
Public Shared Sub DeleteDir(ByVal aimPath As String)   
Try   
' 检查目标目录是否以目录分割字符结束如果不是则添加之   
If (aimPath(aimPath.Length - 1) <> Path.DirectorySeparatorChar) Then   
aimPath += Path.DirectorySeparatorChar   
End If   
'判断待删除的目录是否存在,不存在则退出.   
If (Not Directory.Exists(aimPath)) Then Exit Sub   
' 得到源目录的文件列表,该里面是包含文件以及目录路径的一个数组   
' 如果你指向Delete目标文件下面的文件而不包含目录请使用下面的方法   
' string[] fileList = Directory.GetFiles(aimPath);   
Dim fileList() As String = Directory.GetFileSystemEntries(aimPath)   
' 遍历所有的文件和目录   
For Each FileName As String In fileList   
If (Directory.Exists(FileName)) Then   
' 先当作目录处理如果存在这个目录就递归Delete该目录下面的文件   
DeleteDir(aimPath + Path.GetFileName(FileName))   
Else   
' 否则直接Delete文件   
File.Delete(aimPath + Path.GetFileName(FileName))   
End If   
Next   
'删除文件夹   
System.IO.Directory.Delete(aimPath, True)   
Catch ex As Exception   
MessageBox.Show(ex.ToString())   
End Try   
End Sub
2楼2011-05-14 16:41:07
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
★ ★ ★
微尘、梦想(金币+3): 谢谢! 2011-05-14 19:50:52
zzahkj(金币+10): 2011-05-15 23:18:29
用kill方法
Option Explicit   Private Sub Command1_Click()  Dim strPathName As String  strPathName = "" strPathName = InputBox("请输入需要删除的文件夹名称∶", "删除文件夹"  If strPathName = "" Then Exit Sub  On Error GoTo ErrorHandle  SetAttr strPathName, vbNormal '此行主要是为了检查文件夹名称的有效性  RecurseTree strPathName  Label1.Caption = "文件夹" & strPathName & "已经删除!"  Exit Sub  ErrorHandle:  MsgBox "无效的文件夹名称:" & strPathName  End Sub  Sub RecurseTree(CurrPath As String)  Dim sFileName As String  Dim newPath As String  Dim sPath As String  Static oldPath As String  sPath = CurrPath & "\"  sFileName = Dir(sPath, 31) '31的含义∶31=vbNormal+vbReadOnly+vbHidden+vbSystem+vbVolume+vbDirectory  Do While sFileName <> ""  If sFileName <> "." And sFileName <> ".." Then  If GetAttr(sPath & sFileName) And vbDirectory Then '如果是目录和文件夹  newPath = sPath & sFileName  RecurseTree newPath  sFileName = Dir(sPath, 31)  Else  SetAttr sPath & sFileName, vbNormal  Kill (sPath & sFileName)  Label1.Caption = sPath & sFileName '显示删除过程  sFileName = Dir End If  Else  sFileName = Dir End If  DoEvents  Loop  SetAttr CurrPath, vbNormal  RmDir CurrPath  Label1.Caption = CurrPath End Sub

[ Last edited by jjdg on 2011-5-14 at 16:42 ]
3楼2011-05-14 16:41:43
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 zzahkj 的主题更新
普通表情 龙 兔 虎 猫 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[硕博家园] 极限拉扯,如何抉择 +11 Isak0320 2026-10-12 15/750 2026-10-14 21:55 by 猫鱼不是鱼
[硕博家园] 中科院海洋所招收海洋材料相关领域博士研究生及研究助理 +3 sujiner 2026-10-08 4/200 2026-10-14 20:40 by qicaiyun
[职场人生] 40+中年人失业后,还能找到好工作吗? +3 xqy2009 2026-10-13 3/150 2026-10-14 20:17 by 43358052
[论文投稿] 二审4个多月了还是Awaiting Reviewer Scores 10+3 纳斯达克ML 2026-10-11 4/200 2026-10-14 17:30 by babero
[有机交流] OpenAI又攻克数学难题了,离AI做有机合成还有多远? +8 wangyl_123 2026-10-10 13/650 2026-10-14 15:12 by zuesli
[教师之家] 课题组会帮你通过考核么? +4 好运来~9527 2026-10-10 7/350 2026-10-13 08:41 by xli1984
[基金申请] 入职后第一次管课题组的专利缴费,对账才发现官费比别人多掏了一倍 +6 13108017953 2026-10-08 6/300 2026-10-12 20:07 by w3w3y3
[公派出国] 售一区SCI文章T0P,我:8O.551.O54,科目全,可十急 +5 qR2AdCWTVtkw 2026-10-09 9/450 2026-10-11 22:34 by XQNyDCa1Tk5n
[公派出国] 售SCI一区文章,我:8O5.5.1.O5.4,科目全,可伽急 +5 qR2AdCWTVtkw 2026-10-09 10/500 2026-10-11 22:26 by XQNyDCa1Tk5n
[考博] 售SCI一区T0P文章,我:8.O55.1.O.54,科目全,可十急 +5 qR2AdCWTVtkw 2026-10-09 9/450 2026-10-11 22:15 by XQNyDCa1Tk5n
[教师之家] 售SCI文章,我:8O5.5.1.O.54,科目齐全,可+急 (EPI+-1)(金币-50) +5 qR2AdCWTVtkw 2026-10-09 10/500 2026-10-11 22:06 by XQNyDCa1Tk5n
[教师之家] 售SCI一区T0P文章,我:8.O.55.1.O.5.4,科目全,可+急 (EPI+-1)(金币-50) +5 qR2AdCWTVtkw 2026-10-09 10/500 2026-10-11 14:25 by VOMexwnDzOFZ
[教师之家] 售SCI文章,我:8O.5.5.1O.54,科目全,可十急 (EPI+-1)(金币-50) +4 qR2AdCWTVtkw 2026-10-09 7/350 2026-10-11 14:05 by VOMexwnDzOFZ
[考研] 售SCI文章,我:8O.5.5.1O.54,科目全,可十急 +5 qR2AdCWTVtkw 2026-10-09 8/400 2026-10-11 13:51 by VOMexwnDzOFZ
[硕博家园] 售SCI-T0P文章,我:8O.5.5.1.O.54,科目齐全,可+急 +5 qR2AdCWTVtkw 2026-10-09 8/400 2026-10-11 13:45 by VOMexwnDzOFZ
[找工作] 售SCI一区T0P文章,我:8O.55.1.O.5.4,科目齐全,可+急 +3 qR2AdCWTVtkw 2026-10-09 7/350 2026-10-11 10:54 by VOMexwnDzOFZ
[找工作] 售SCI一区T0P文章,我:8O.55.1.O.5.4,科目齐全,可+急 +4 qR2AdCWTVtkw 2026-10-09 7/350 2026-10-11 10:34 by VOMexwnDzOFZ
[公派出国] 售SCI一区T0P文章,我:8O.55.1.O.54,科目全,可伽急 +4 qR2AdCWTVtkw 2026-10-09 4/200 2026-10-11 03:14 by M0zrYVSAnxpE
[有机交流] 各位大佬,路线设计求助 +6 zapen 2026-10-08 8/400 2026-10-10 15:59 by zapen
[有机交流] 我应该选哪条合成路线让实验成功率高一些? +5 jing816y 2026-10-08 9/450 2026-10-10 09:05 by zapen
信息提示
请填处理意见