ايران ويج

من میخوام برنامه ای بسازم که داریو های (D,E,F,G,H,I) ازشون یه لیست بگیره (*.*)به طور همزمان یعنی نام درایو ها رو تکی تکی وارد نکنیم .بعد به طور اتوماتیک هر چی رو که لیست کرده حذف کنه.با تشکر

با سلام
باید از چند تا API استفاده بشه :
با API زیر میتونین تمام درایو های منطقی موجود رو پیدا کنین (فلاپی،سی دی رام،فلش مموری،پارتیشنهای هارد و ...)

کد: 
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

و با API زیر میتونین تشخیص بدین که نوع هر درایو چی هست

کد: 
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

اینهم مثالش :
*= اول یه لیست باکس بذارین رو فرم .

کد: 
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Sub FindLogicalDrives()

    Dim strSave As String

    Dim Dr As String

    strSave = String(255, Chr$(0))

    ret& = GetLogicalDriveStrings(255, strSave)

    For i = 1 To 100

        If Left$(strSave, InStr(1, strSave, Chr$(0))) = Chr$(0) Then Exit For

        Dr = Left$(strSave, InStr(1, strSave, Chr$(0)) - 1)

        List1.AddItem Dr & " => " & GetType(GetDriveType(Dr))

        strSave = Right$(strSave, Len(strSave) - InStr(1, strSave, Chr$(0)))

    Next

End Sub

Private Function GetType(Dr As String) As String

Select Case Dr

        Case 2

            GetType = "Removable"

        Case 3

            GetType = "Drive Fixed"

        Case Is = 4

            GetType = "Remote"

        Case Is = 5

            GetType = "Cd-Rom"

        Case Is = 6

            GetType = "Ram disk"

        Case Else

            GetType = "Unrecognized"

    End Select

End Function

Private Sub Form_Load()

FindLogicalDrives

End Sub

و برای جستجوی فایلها باید از این API ها استفاده بشه :

کد: 
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

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

اینم نمونه استفاده :
*=یه کامند یه لیست باکس و دو تا تکست باکس لازم داره که تو تکست اولی آدرس برای جستجو و تو دمی اسم فایل .
*2= برای جستجوی همه فایلها از * استفاده کنید .

کد: 
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

Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

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

Const MAX_PATH = 260

Const MAXDWORD = &HFFFF

Const INVALID_HANDLE_VALUE = -1

Const FILE_ATTRIBUTE_ARCHIVE = &H20

Const FILE_ATTRIBUTE_DIRECTORY = &H10

Const FILE_ATTRIBUTE_HIDDEN = &H2

Const FILE_ATTRIBUTE_NORMAL = &H80

Const FILE_ATTRIBUTE_READONLY = &H1

Const FILE_ATTRIBUTE_SYSTEM = &H4

Const FILE_ATTRIBUTE_TEMPORARY = &H100

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

End Type

Function StripNulls(OriginalStr As String) As String

    If (InStr(OriginalStr, Chr(0)) > 0) Then

        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)

    End If

    StripNulls = OriginalStr

End Function

Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)

    Dim FileName As String ' Walking filename variable...

    Dim DirName As String ' SubDirectory Name

    Dim dirNames() As String ' Buffer for directory name entries

    Dim nDir As Integer ' Number of directories in this path

    Dim i As Integer ' For-loop counter...

    Dim hSearch As Long ' Search Handle

    Dim WFD As WIN32_FIND_DATA

    Dim Cont As Integer

    If Right(path, 1) <> "\" Then path = path & "\"

    ' Search for subdirectories.

    nDir = 0

    ReDim dirNames(nDir)

    Cont = True

    hSearch = FindFirstFile(path & "*", WFD)

    If hSearch <> INVALID_HANDLE_VALUE Then

        Do While Cont

        DirName = StripNulls(WFD.cFileName)

        ' Ignore the current and encompassing directories.

        If (DirName <> ".") And (DirName <> "..") Then

            ' Check for directory with bitwise comparison.

            If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then

                dirNames(nDir) = DirName

                DirCount = DirCount + 1

                nDir = nDir + 1

                ReDim Preserve dirNames(nDir)

            End If

        End If

        Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.

        Loop

        Cont = FindClose(hSearch)

    End If

    ' Walk through this directory and sum file sizes.

    hSearch = FindFirstFile(path & SearchStr, WFD)

    Cont = True

    If hSearch <> INVALID_HANDLE_VALUE Then

        While Cont

            FileName = StripNulls(WFD.cFileName)

            If (FileName <> ".") And (FileName <> "..") Then

                FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow

                FileCount = FileCount + 1

                List1.AddItem path & FileName

            End If

            Cont = FindNextFile(hSearch, WFD) ' Get next file

        Wend

        Cont = FindClose(hSearch)

    End If

    ' If there are sub-directories...

    If nDir > 0 Then

        ' Recursively walk into them...

        For i = 0 To nDir - 1

            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)

        Next i

    End If

End Function

Sub Command1_Click()

    Dim SearchPath As String, FindStr As String

    Dim FileSize As Long

    Dim NumFiles As Integer, NumDirs As Integer

    Screen.MousePointer = vbHourglass

    List1.Clear

    SearchPath = Text1.Text

    FindStr = Text2.Text

    Screen.MousePointer = vbDefault

End Sub

حالا اگه میخواهین خرابکاری کنین که اصلا کار خوبی نیست زمانی که آدرس فایل میخواد به لیست باکس اضافه بشه بجاش دستور حذف فایل رو ارسال کنید .

کد: 
kill fileaddress

ممنون از راهنمایی شما.ولی نتونستم از کدها استفاده کنم چون با vb6 کاملا آشنا نیستم.میشه لطف کنید و سورس کداشو واسه دانلود بذارین.با تشکر فراوان.

arash w8100

hamed_Arfaee

arash w8100