IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası
  sohbet

Yeni Konu aç Cevapla
 
LinkBack Seçenekler Stil
Alt 21 Temmuz 2008, 18:20   #1
Çevrimiçi
Yardımcı Admin
Kullanıcıların profil bilgileri misafirlere kapatılmıştır.
IF Ticaret Sayısı: (0)
IF Ticaret Yüzdesi:(%)
Dosya ve Klasörleri Listeleme




Alıntıdır

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
Public nodename As String


Public Sub LogPath(strPARENT As String)
 
Dim gotfiles As Integer
 Dim i 
As Integer
 Dim cnt 
As Integer
 Dim lngTopIndex 
As Long
 Dim lngPathIndex 
As Long
 Dim strNextPath 
As String
 Dim nodx 
As Object
 Dim strtsrch 
As Integer
 Dim srchstr 
As String
 Dim strPaths
(0) As String

 Set objFSO 
= New FileSystemObject

 
If Not objFSO.FolderExists(strPARENTThen Exit Sub

 lngTopIndex 
0
 lngPathIndex 
0
 lngFNAMEScntr 
0
 cnt 
1

 strPaths
(0) = IFBACKSLASH(strPARENT)

 

 
frmgetfiles.TV.LineStyle tvwRootLines
 i 
objFSO.GetFolder(strPaths(lngPathIndex)).SubFolders.Count

  Set objFolders 
objFSO.GetFolder(strPaths(lngPathIndex)).SubFolders
  
For Each objFolder In objFolders
    
    On Error Resume Next

     
If firstpass 0 Then
      Set nodx 
frmgetfiles.TV.Nodes.Add(nodenametvwChildfrmgetfiles.cmbdrives.Text "\" & objFolder.Name, objFolder.Name)
      firstpass = 1
      DoEvents
     Else
      Set nodx = frmgetfiles.TV.Nodes.Add(nodename, tvwChild, nodename & "
\" & objFolder.Name, objFolder.Name)
      DoEvents
     End If
     

  Next objFolder
On Error GoTo errorhandler

strtsrch = InStr(1, frmgetfiles.cmbfiletypes.Text, "
*") + 2
If Not Mid(frmgetfiles.cmbfiletypes.Text, strtsrch, 1) = "
*" Then
 srchstr = Mid(frmgetfiles.cmbfiletypes.Text, strtsrch, 3)
Else
 srchstr = "
*"
End If


Set objFiles = objFSO.GetFolder(strPaths(lngPathIndex)).Files
     frmgetfiles.lstfiles.Clear
      For Each objFile In objFiles
      
       If UCase(Right(objFile.Path, 3)) = UCase(srchstr) Or srchstr = "
*" Then
        DoEvents
        frmgetfiles.lstfiles.AddItem objFile.Name
       End If
      Next objFile

  
exitit:
  gotfiles = 0
  
  
errorhandler:
  frmgetfiles.Enabled = True
End Sub

Private Function IFBACKSLASH(strX As String) As String
 IFBACKSLASH = IIf(Right(strX, 1) = "
\", strX, strX & "\")
End Function

Private Sub cmbdrives_Click()
 Screen.MousePointer = 11
  firstpass = 0
  frmgetfiles.TV.Nodes.Clear
  nodename = Me.cmbdrives.Text
  Set nodx = frmgetfiles.TV.Nodes.Add(, , nodename, nodename)
  LogPath nodename
  frmgetfiles.TV.Nodes.Item(nodename).Expanded = True
  DoEvents
  Screen.MousePointer = 0
End Sub


Private Sub cmbfiletypes_Click()
 LogPath nodename
End Sub


Private Sub cmdclose_Click()
 Unload Me
End Sub

Private Sub Command1_Click()

End Sub

Private Sub cmdsave_Click()
 For i = 0 To frmgetfiles.lstfiles.ListCount - 1
 If frmgetfiles.lstfiles.Selected(i) = True Then
   'use the following line to save each file name to where ever you are storing these filenames
   'Example:
    MsgBox nodename & "
\" & frmgetfiles.lstfiles.List(i)
 End If
Next i
End Sub


Private Sub Form_Load()
 Dim itype As Long
 Dim i As Integer
 Dim tmpdrive As String
 Dim found As Boolean
 Dim fs As FileSystemObject
 Dim drv As Drive
 
 Set fs = CreateObject("
scripting.filesystemobject")
 
  For i = 65 To 90
  On Error Resume Next
   Me.cmbdrives.AddItem fs.GetDrive(Chr(i) & "
:")
  Next i
  
  Me.cmbfiletypes.AddItem "
Text Files (*.txt)"
  Me.cmbfiletypes.AddItem "
All Files (*.*)"
  
  
  
  Me.cmbfiletypes.ListIndex = 0
 
  Me.cmbdrives.ListIndex = 0
  nodename = Me.cmbdrives.Text
  frmgetfiles.TV.Nodes.Clear
  Set nodx = frmgetfiles.TV.Nodes.Add(, , nodename, nodename)
  LogPath nodename
 
  frmgetfiles.TV.Nodes.Item(nodename).Expanded = True
  firstpass = 1
 
  
  Exit Sub
  
End Sub


Private Sub lstfiles_Click()
 Me.cmdsave.Enabled = True
End Sub

Private Sub TV_NodeClick(ByVal Node As MSComctlLib.Node)
  On Error GoTo errorhandler
 
 
 Screen.MousePointer = 11
 nodename = Node.Key
 
 DoEvents
 frmgetfiles.Enabled = False
 LogPath Node.Key
 ';arrayfilenames, arraypointers,
 DoEvents
 
 frmgetfiles.TV.Nodes.Item(Node.Key).Expanded = True
 Screen.MousePointer = 0
 frmgetfiles.Enabled = True
 Exit Sub
 
errorhandler:
 Screen.MousePointer = 0
 frmgetfiles.Enabled = True
 
End Sub 


__________________
[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]

[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]
 
Alıntı ile Cevapla

IRCForumlari.NET Reklamlar
sohbet odaları sohbet odaları Benimmekan Mobil Sohbet
Cevapla

Etiketler
dosya, klasörleri, listeleme


Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 
Seçenekler
Stil

Yetkileriniz
Konu Acma Yetkiniz Yok
Cevap Yazma Yetkiniz Yok
Eklenti Yükleme Yetkiniz Yok
Mesajınızı Değiştirme Yetkiniz Yok

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-Kodu Kapalı
Trackbacks are Kapalı
Pingbacks are Açık
Refbacks are Açık


Benzer Konular
Konu Konuyu Başlatan Forum Cevaplar Son Mesaj
hedef dosyanın path (yolu) dosya adı ve dosya uzantısını bulmak hAte PHP 0 11 Kasım 2014 05:06
Silinemeyen Dosya ve Klasörleri Silmek Luis Windows 6 26 Nisan 2010 13:15