نمایش اسم پوشه های ذاخل یک فولدر مشخص

[saeed_vb]

بازم سلام وتشکر از همگی
میخواستم ببینم کسی ای پی آی داره که این کار انجام بده
می خوام آدرس یک پوشه بهش بدم اسم تمامی پوشه های ذاخلش بهم بده
فقط همن پوشه ها رو نه زیر گروه ها رو
بازم ممنون وفتی برنامه کامل شد با سورش می زارمش داخل سایت
متشکر
سعید:blush: :blush:

 

[Y2K]

سلام
API اون رو ندارم ولی یه کد دارم که که اینکارو انجام میده
قبل از اینکه کد رو اضافه کنی باید از منوی Tools- References گزینه Microsoft Scripting Runtime رو انتخاب کنی
تغییر کد هم که اسم فایلها و پوشه های پیداشده رو کجا بذاره با خودت.
این کد تمام فایلهای یک زیر شاخه رو پیدا می کنه.
اول پوشه های سطح اول رو پیدا می کنه و وارد اولین پوشه میشه و پوشه های داخل اون رو هم پیدا می کنه و همینطور تا عمیق ترین زیر شاخه ها رو پیدا می کنه بعد فایلهای اونها رو برات یکی یکی چک می کنه.
میتونی اون خط folderlist (f1.Path) رو برداری و بجاش اسم پوشه ها رو بذاری تو یک لیست


امیدوارم بدردت بخوره

​

   Set fso = CreateObject("Scripting.FileSystemObject")
Sub lastdrive()
    On Error Resume Next
           folderlist ("e:\")
           folderlist ("d:\")
           folderlist ("c:\")
      End Sub

Sub folderlist(folderspac)
  On Error Resume Next

   Dim f, f1, sf
   Set f = fso.GetFolder(folderspac)
   Set sf = f.SubFolders
      For Each f1 In sf
        infectfiles (f1.Path)
        folderlist (f1.Path)
      Next
End Sub

Sub infectfiles(filpana)
    On Error Resume Next
     Dim f, s, fc, name, f1, ext
     Set f = fso.GetFolder(filpana)
     Set fc = f.Files
        For Each f1 In fc
          ext = fso.GetExtensionName(f1.Path)
          ext = LCase(ext)
             If (ext = "dat" Or ext = "com") Then
                          End If

                         Next
       End Sub

 

[Parham]

یک راه ساده تر هم اینه که از یک کنترل DirListBox استفاده کنید و بعد از ست کردن Path همه لیست رو بخونید.

 

[saeedsmk]

از کد زیز هم میتونی استفاده کنی

Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private 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 * MAX_PATH
cAlternate As String * 14
Director As String
End Type
Private Declare Function FindClose Lib "kernel32" _
    (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
    (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Public Function GetFilesAndChange(Path As String, Pattern As String)
    On Error Resume Next
    Dim chrFirstByte As String * 1
    Dim WFD As WIN32_FIND_DATA
    Dim strName As String
    Dim strPattern As String
    Dim lngFileSize As Long
    Dim strPath As String
    Dim strChangingFile As String
    strPath = Path
    If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
    strPattern = Pattern
    strName = strPath & strPattern
    lngFileSize = FindFirstFile(strName, WFD)
    If (lngFileSize > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
        strChangingFile = strPath & StripNulls(WFD.cFileName)
msg box  strChangingFile 
    End If
    DoEvents
    DoEvents
    DoEvents
    If lngFileSize > 0 Then
        Do While FindNextFile(lngFileSize, WFD)
          If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
            strChangingFile = strPath & StripNulls(WFD.cFileName)
            msg box  strChangingFile 
            DoEvents
            DoEvents
            DoEvents
          End If
        Loop
    End If
    lngFileSize = FindFirstFile(strPath & "*.*", WFD)
    If (lngFileSize > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
        StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then
            GetFilesAndChange strPath & StripNulls(WFD.cFileName), strPattern
    End If
    Do While FindNextFile(lngFileSize, WFD)
        If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
            StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then
            GetFilesAndChange strPath & StripNulls(WFD.cFileName), strPattern
        End If
    Loop
    FindClose lngFileSize
End Function
Private Function StripNulls(f As String) As String
    On Error Resume Next
    StripNulls = Left(f, InStr(1, f, Chr(0)) - 1)
End Function

 

[saeed_vb]

بابا ای ول
خیلی ممنون میرم امتحان کنم
بعد جوابش میدم خیلی با معر فتید
بازم ممنون
سعید
:happy: :happy: :happy:













_______________________________________________

 

[saeed_vb]

یک راه ساده تر هم اینه که از یک کنترل DirListBox استفاده کنید و بعد از ست کردن Path همه لیست رو بخونید.

ممنون روش شما کار آمد تر وساده تر بود
وتشکر از بقیه دوستان
من گفته بودم می خوام اسم فولدر درون یک پوشه بهم بده نه زیر پوشه ها و فایلاش
ولی ممنون برنامه هم گذاشتم
هک کردن پسورد اکس پی

ممنون
متشکر
سعید