View Full Version : پیدا کردن پوشه در تمام سیستم
  
xrezax
پنج شنبه 23 اردیبهشت 1395, 00:36 صبح
با سلام و عرض ادب
دوستان بنده چندتا پوشه دارم توی یکی از درایوها به نامهای mahmood45854. 654mahmood56+. dfgmahmood465ssds
حالا میخوام برنامه ای باشه که هر چی پوشه که توی اسمش mahmood باشه رو توی کل هارد جستجو کنه و لیست کنه.
خیلی ضروری هست . میخوام بوسیله API انجام بدم.
ممنون میشم کد را بزارین.
Fery666
شنبه 25 اردیبهشت 1395, 15:48 عصر
با سلام . 
ببینید این کد بدرد شما میخوره : 
Private Sub Command1_Click()
List1.Clear
Static running As Boolean
Dim AllDirs As New Collection
Dim next_dir As Integer
Dim dir_name As String
Dim sub_dir As String
Dim i As Integer
Dim txt As String
    If running Then
        running = False
 
    Else
        running = True
        MousePointer = vbHourglass
       
   
        DoEvents
        
        next_dir = 1
        AllDirs.Add "C:\" ' Start here.
        
        Do While next_dir <= AllDirs.Count
            ' Get the next directory to search.
            dir_name = AllDirs(next_dir)
            next_dir = next_dir + 1
            
            ' Read directories from dir_name.
            sub_dir = Dir$(dir_name & "\", vbDirectory)
            
            Do While sub_dir <> ""
                ' Add the name to the list if
                ' it is a directory.
                
                If UCase$(sub_dir) <> "PAGEFILE.SYS" And _
                    sub_dir <> "." And sub_dir <> ".." _
                Then
                
               
                
                    sub_dir = dir_name & "\" & sub_dir
                    
                     If LCase(InStrRev(sub_dir, Text1.Text) <> 0) Then
                    List1.AddItem sub_dir
                    End If
                    
                    On Error Resume Next
                    If GetAttr(sub_dir) And vbDirectory _
                        Then AllDirs.Add sub_dir
                End If
                sub_dir = Dir$(, vbDirectory)
               
            Loop
             
            DoEvents
            If Not running Then Exit Do
        Loop
    
        ' Update the display.
        txt = ""
        For i = 1 To AllDirs.Count
            txt = txt & AllDirs(i) & vbCrLf
        Next i
        
      Me.Caption = txt
        MousePointer = vbDefault
        
        running = False
    End If
    
End Sub
تمام پوشه و فایل هایی که قسمتی از اسمش توی تکست باکس بنویسید رو پیدا میکنه .
xrezax
دوشنبه 27 اردیبهشت 1395, 01:57 صبح
مشکلش اینه که هنگ میکنه. نمیشه کاری کرد هنگ نکنه؟
Fery666
سه شنبه 28 اردیبهشت 1395, 16:45 عصر
مشکلش اینه که هنگ میکنه. نمیشه کاری کرد هنگ نکنه؟
من چند بار تست کردم هنگ نمیکنه اونم با رم پایین توی ویندوز مجازی . 
ولی خواستی میتونی توی حلقه ها DoEvents  بذاری .
xrezax
جمعه 31 اردیبهشت 1395, 11:30 صبح
من میخوام فقط پوشه بگرده. کار به فایل ندارم. فقط پوشه ها رو بگرده و پوشه مورد نظر رو لیست کنه. و آخر کار یه اررور بده که کار تموم شده.
دوستان کسی نظر ندارد؟
 
vBulletin® v4.2.5, Copyright ©2000-1404, Jelsoft Enterprises Ltd.