آژانس هواپیماییexchanging

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

شروع موضوع توسط saeed_vb ‏27 فوریه 2006 در انجمن Visual Basic 6

  1. saeed_vb

    saeed_vb Registered User

    تاریخ عضویت:
    ‏9 دسامبر 2005
    نوشته ها:
    650
    تشکر شده:
    8
    محل سکونت:
    همین ورا
    بازم سلام وتشکر از همگی
    میخواستم ببینم کسی ای پی آی داره که این کار انجام بده
    می خوام آدرس یک پوشه بهش بدم اسم تمامی پوشه های ذاخلش بهم بده
    فقط همن پوشه ها رو نه زیر گروه ها رو
    بازم ممنون وفتی برنامه کامل شد با سورش می زارمش داخل سایت
    متشکر
    سعید:blush: :blush:
     
  2. Y2K

    Y2K Registered User

    تاریخ عضویت:
    ‏20 فوریه 2006
    نوشته ها:
    592
    تشکر شده:
    1
    محل سکونت:
    Location
    سلام
    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
    
     
  3. Parham

    Parham Registered User

    تاریخ عضویت:
    ‏24 سپتامبر 2003
    نوشته ها:
    1,039
    تشکر شده:
    1
    یک راه ساده تر هم اینه که از یک کنترل DirListBox استفاده کنید و بعد از ست کردن Path همه لیست رو بخونید.
    ;)
     
  4. saeedsmk

    saeedsmk مدیر بازنشسته

    تاریخ عضویت:
    ‏6 سپتامبر 2003
    نوشته ها:
    1,519
    تشکر شده:
    4
    از کد زیز هم میتونی استفاده کنی
    کد:
    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
    
    
     
  5. saeed_vb

    saeed_vb Registered User

    تاریخ عضویت:
    ‏9 دسامبر 2005
    نوشته ها:
    650
    تشکر شده:
    8
    محل سکونت:
    همین ورا
    بابا ای ول
    خیلی ممنون میرم امتحان کنم
    بعد جوابش میدم خیلی با معر فتید
    بازم ممنون
    سعید
    :happy: :happy: :happy:













    _______________________________________________
     
  6. saeed_vb

    saeed_vb Registered User

    تاریخ عضویت:
    ‏9 دسامبر 2005
    نوشته ها:
    650
    تشکر شده:
    8
    محل سکونت:
    همین ورا

    ممنون روش شما کار آمد تر وساده تر بود
    وتشکر از بقیه دوستان
    من گفته بودم می خوام اسم فولدر درون یک پوشه بهم بده نه زیر پوشه ها و فایلاش
    ولی ممنون برنامه هم گذاشتم
    هک کردن پسورد اکس پی
    :rolleyes: :rolleyes:
    ممنون
    متشکر
    سعید
     
  7. appbannerkhuniresbanner