| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1944 人关注过本帖
标题:求助,关于删除电脑所有盘同名应用程序代码!
只看楼主 加入收藏
事业男儿
Rank: 2
等 级:论坛游民
帖 子:317
专家分:14
注 册:2007-4-25
结帖率:82.19%
收藏
已结贴  问题点数:20 回复次数:5 
求助,关于删除电脑所有盘同名应用程序代码!
在网上找到的代码,运行后发现只能删除我的文档和桌面指定的文件,而放在D.E.F.G盘里的同名文件都不能删除,请问怎么改一下才能删除,代码如下。
程序代码:
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private i As Integer
Private MyFile As String

Private Sub Command1_Click()
Dim m, d$

    On Error Resume Next
    d = String(256, Chr(0))
    GetLogicalDriveStrings Len(d), d
    i = 0
    MyFile = ""
    For m = 1 To 100 '搜索整个磁盘
     If Left$(d, InStr(1, d, Chr$(0))) = Chr$(0) Then Exit For
        Text1.Text = "正在搜索:" & Left$(d, InStr(1, d, Chr$(0)) - 1)
        OutFile Left$(d, InStr(1, d, Chr$(0)) - 1), "\b.exe" '不加斜杠是模糊查找
    d = Right$(d, Len(d) - InStr(1, d, Chr$(0)))
    Next
    Text1.Text = "搜索结果:" & vbCrLf & MyFile '文本框设为多行显示被找到的文件清单
   MsgBox "一共找到并删除:" & i & " 个文件"
End Sub

Private Sub OutFile(ByVal MyFolder As String, ByVal MyFileName As String)
Dim fs, F, f1, S, sf, f2, mf
Dim L As Integer

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(MyFolder)
    Set sf = F.SubFolders
    For Each f1 In sf
        OutFile f1, MyFileName
        DoEvents
    Next
    
    L = Len(MyFileName)
    Set mf = F.Files
    For Each f2 In mf
        If Right(f2, L) = MyFileName Then
            Kill MyFile & f2 '删除文件
            i = i + 1
            MyFile = MyFile & f2 & vbCrLf
        End If
        DoEvents
    Next
End Sub

搜索更多相关主题的帖子: color 应用程序 网上 
2016-01-05 22:10
HVB6
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:15
帖 子:331
专家分:561
注 册:2013-10-30
收藏
得分:10 
以下代码是检查计算机硬盘盘符的(已排除C盘),您把它组织到您的代码中。
Private Sub Command1_Click()
   Dim f, d, s As String
   Set f = CreateObject("Scripting.FileSystemObject")
  For Each d In f.Drives
    If d.DriveType = 2 And d.Path <> "C:" Then
        msgbox d.Path
    End If
  Next
End Sub
2016-01-06 08:44
事业男儿
Rank: 2
等 级:论坛游民
帖 子:317
专家分:14
注 册:2007-4-25
收藏
得分:0 
还是不懂
2016-01-06 17:51
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:10 
程序代码:
Option Explicit

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private i As Integer
Private MyFile As String

Private Sub Command1_Click()
Dim m&, d$, s$()

    On Error Resume Next
    d = String(256, Chr(0))                 '盘符缓冲区
    GetLogicalDriveStrings Len(d), d        '取盘符列表
    m = InStrRev(d, "\")                    '最后一个 \ 的位置
    d = Left(d, m)                          '保留有的字符
    s = Split(d, Chr(0))                    '分解成数组
    
    i = 0                                   '计数变量
    For m = 0 To UBound(s)                  '遍类数组
        If Len(s(m)) > 0 Then               '数据有效
            Call OutFile2(s(m), "b.exe")    '调用子程序进行检索是否存在
        End If
    Next m
    
    Text1.Text = "搜索结果:" & vbCrLf & MyFile '文本框设为多行显示被找到的文件清单
   MsgBox "一共找到并删除:" & i & " 个文件"
End Sub

Private Sub OutFile2(ByVal MyFolder As String, ByVal MyFileName As String)
'    On Error Resume Next
Dim fs As Object, f As Object
Dim sf As Object
    Set fs = CreateObject("Scripting.FileSystemObject")     '创建FSO
If Right(MyFolder, 1) <> "\" Then                           '路径最后添加 \
    MyFolder = MyFolder & "\"
End If

Set f = fs.GetFolder(MyFolder)
For Each sf In f.Files                      '所有的文件
    If sf.Name = MyFileName Then            '不支持通配符的比较,如果需的,那么就要写正则表达式
        'Kill MyFolder & MyFileName '删除文件
        i = i + 1
        MyFile = MyFile & MyFolder & MyFileName & vbCrLf
    End If
Next

For Each sf In f.SubFolders                 '所有的目录
    Call OutFile2(sf.Path, MyFileName)      '递归调用自己
Next

End Sub


太久了没用FSO,所以练练手。

[此贴子已经被作者于2016-1-6 19:47编辑过]


授人于鱼,不如授人于渔
早已停用QQ了
2016-01-06 19:45
事业男儿
Rank: 2
等 级:论坛游民
帖 子:317
专家分:14
注 册:2007-4-25
收藏
得分:0 
回复 4楼 风吹过b
版主:我测试后能够找到要删除的文件位置,但是不能删除,请问怎么调节一下?
图片附件: 游客没有浏览图片的权限,请 登录注册
2016-01-07 19:08
事业男儿
Rank: 2
等 级:论坛游民
帖 子:317
专家分:14
注 册:2007-4-25
收藏
得分:0 
问题已经搞定'Kill MyFolder & MyFileName '删除文件这句没有用起来,谢谢版主。
2016-01-07 19:27
快速回复:求助,关于删除电脑所有盘同名应用程序代码!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.042474 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved