VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 627|回复: 3

[求助] vb问题一个文本框,一个按钮,一个列表框的问题

[复制链接]
发表于 2018-12-6 09:22:31 | 显示全部楼层 |阅读模式
一个按钮,一个文本框,一个列表框,效果:在文本框输入关键词,点击按钮,获得文本框关键词,并在当前程序所在文件夹搜索全部文件,包括子文件夹内,然后把包含关键词的文件(文件名包含关键词)都显示在列表框,鼠标点击哪个文件名,就打开这个文件,这个该怎么写,谢谢

点评

海!外直播 t.cn/RxlBL8F 禁闻视频 t.cn/RJvO78a 史书这样评说:他们耗尽地下的矿产,浑浊地面的河流,污秽天上的云彩,沦丧了中华的道德,小孩不敢独自出门,老人倒地无人扶,官匪横行霸道,金钱权力是惟一图腾,善良诚实勤   发表于 2018-12-11 17:31
发表于 2018-12-17 01:33:20 | 显示全部楼层
=====================================================全盘文件查找============================================================================================================
'api 模块
Option Explicit

Declare Function MoveWindow Lib "user32" _
                       (ByVal hwnd As Long, _
                        ByVal x As Long, ByVal y As Long, _
                        ByVal nWidth As Long, ByVal nHeight As Long, _
                        ByVal bRepaint As Long) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                        (ByVal hwnd As Long, ByVal wMsg As Long, _
                         ByVal wParam As Long, lParam As Any) As Long

Public Const LB_INITSTORAGE = &H1A8

Public Const LB_ADDSTRING = &H180

Public Const WM_SETREDRAW = &HB
Public Const WM_VSCROLL = &H115
Public Const SB_BOTTOM = 7

Declare Function GetLogicalDrives Lib "kernel32" () As Long

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
                        (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Public Const INVALID_HANDLE_VALUE = -1
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
                        (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Public Const MaxLFNPath = 260

Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MaxLFNPath
        cShortFileName As String * 14
End Type

‘程序代码
'一个 List1  一个 Picture1    ( Picture1.align=2  )





'通用声明

Option Explicit

Dim PicHeight%, hLB&, FileSpec$, UseFileSpec%
Dim TotalDirs%, TotalFiles%, Running%

Dim WFD As WIN32_FIND_DATA, hItem&, hFile&

Const vbBackslash = "\"
Const vbAllFiles = "*.*"
Const vbKeyDot = 46

‘窗口启动
Private Sub Form_Load()
    ScaleMode = vbPixels
    PicHeight% = Picture1.Height
    hLB& = List1.hwnd
   
End Sub


’窗口刷新
Private Sub Form_Resize()
    MoveWindow hLB&, 0, 0, ScaleWidth, ScaleHeight - PicHeight%, True
End Sub


‘菜单 文件的查找
Private Sub mnuFindFiles_Click()
If Running% Then: Running% = False: Exit Sub
Dim drvbitmask&, maxpwr%, pwr%
On Error Resume Next
FileSpec$ = "*.mp3"
If Len(FileSpec$) = 0 Then Exit Sub
Running% = True
UseFileSpec% = True
List1.Clear
drvbitmask& = GetLogicalDrives()
If drvbitmask& Then
maxpwr% = Int(Log(drvbitmask&) / Log(2))
For pwr% = 0 To maxpwr%
If Running% And (2 ^ pwr% And drvbitmask&) Then _
Call SearchDirs("G:\")
Next
End If
'菜单名称)
mnuFindFiles.Caption = "&Find File(s)..."
Picture1.Cls
Picture1.Print "总共找到了 "; List1.ListCount; " 个文件"
End Sub
'菜单2 文件夹的查找

Private Sub mnuFolderInfo_Click()
   If Running% Then: Running% = False: Exit Sub
    Dim searchpath$
    On Error Resume Next
    searchpath$ = "C:\"
    Running% = True
    mnuFolderInfo.Caption = "停止(&S)"
    mnuFindFiles.Enabled = False
    List1.Clear

    TotalDirs% = 0
    TotalFiles% = 0
    Call SearchDirs(searchpath$)
   
    Running% = False
    mnuFolderInfo.Caption = "设置文件夹(&F)..."
    mnuFindFiles.Enabled = True
    Picture1.Cls
    Picture1.Print "文件夹: " & TotalDirs% & "  文件: " & TotalFiles%, "文件夹设置: " & searchpath$
End Sub

’图象框

Private Sub SearchDirs(curpath$)

     Dim dirs%, dirbuf$(), i%
       '==================
   Picture1.Cls

    Picture1.Print curpath$
  DoEvents
  '是否显示状态  进程
'==========================
  
    If Not Running% Then Exit Sub
   
    hItem& = FindFirstFile(curpath$ & vbAllFiles, WFD)
    If hItem& <> INVALID_HANDLE_VALUE Then
        
        Do
         
            If (WFD.dwFileAttributes And vbDirectory) Then
               
            If Asc(WFD.cFileName) <> vbKeyDot Then
                    TotalDirs% = TotalDirs% + 1
                   If (dirs% Mod 10) = 0 Then ReDim Preserve dirbuf$(dirs% + 10)
                    dirs% = dirs% + 1
                    dirbuf$(dirs%) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                End If
            
             ElseIf Not UseFileSpec% Then
                TotalFiles% = TotalFiles% + 1
            End If
        Loop While FindNextFile(hItem&, WFD)
         
   
    End If
'''''''''''''
   If UseFileSpec% Then
        
        Call SearchFileSpec(curpath$)
      
    End If
   
  For i% = 1 To dirs%: SearchDirs curpath$ & dirbuf$(i%) & vbBackslash: Next i%
  
End Sub

‘通用  照常复制
Private Sub SearchFileSpec(curpath$)
  hFile& = FindFirstFile(curpath$ & FileSpec$, WFD)
    If hFile& <> INVALID_HANDLE_VALUE Then
        Do
            If Not Running% Then Exit Sub
            SendMessage hLB&, LB_ADDSTRING, 0, _
                ByVal curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
       Loop While FindNextFile(hFile&, WFD)
    End If
End Sub
回复 支持 反对

使用道具 举报

发表于 2018-12-26 22:22:17 | 显示全部楼层
不错高手学习了
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2019-3-26 06:00

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表