Newsgroup: it.comp.lang.visual-basic
Titolo: [?][Bug] Dir$() per directory

Sto cercando di elencare tutte le subdir della mia dir App.Path
Ho scritto questa funzioncina:
Public Function Directory(ByVal Index As Long) As String
    Dim D As String
    Dim i As Long
    i = 1
    D = Dir$(App.Path & "\", vbDirectory)
    Do While (Left$(D, 1) = ".") ' salto . e ..
        D = Dir$
    Loop
    Do While (Len(D) > 0) And (i < Index)
        i = i + 1
        D = Dir$
    Loop
    Directory = D
End Function
Con questa credevo di fare Directory(1) e avere la prima subdir di App.Path,
Directory(2) e avere la seconda e così via...
Solo che sembra che VB se ne freghi altamente di vbDirectory e mi dà
l'intero elenco di App.Path, files compresi!
Possibile che mi debba controllare per ogni file il FileAttr()?
Sono io che sbaglio qualcosa?
Ciao


Fatti un regalo, butta al cesso Dir che č veramente pessima.
Dopo la firma una classettina un po' rude, ma funzionante, per la gestione
dei file, nonchč delle dir. con poco lavoro ti puň fare tutto quello di cui
hai bisogno
Ciao
Alfonso
___________________________________________________________
Option Explicit
'tipi per api
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
Private Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent 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(269) As Byte
        cAlternate(14) As Byte
End Type
'enum per funzioni interne
Public Enum Accessofile
READWRITE = 1
ReadOnly = 2
WRITEONLY = 3
Append = 4
End Enum
Public Enum lockfile
    LOCKREADWRITE = 1
    LOCKREAD = 2
    LOCKWRITE = 3
    SHAREDFILE = 4
End Enum
Public Enum SeekFile
FILE_BEGIN = 0
FILE_END = 2
FILE_CURRENT = 1
End Enum
' api di win32
Private Declare Function SetFileAttributes Lib "kernel32" Alias
"SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As
Long) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA"
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA"
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA"
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal
dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal
dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal
hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal
lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead
As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long,
ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long,
lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function cReadFile Lib "kernel32" Alias "ReadFile" (ByVal
hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long,
lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function cWriteFile Lib "kernel32" Alias "WriteFile" (ByVal
hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long,
lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA"
(ByVal lpFileName As String) As Long
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal
lpExistingFileName As String, ByVal lpNewFileName As String, ByVal
bFailIfExists As Long) As Long
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal
lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long,
ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal
dwMoveMethod As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As
Long) As Long
Private Declare Function CreateDirectory Lib "kernel32" Alias
"CreateDirectoryA" (ByVal lpPathName As String, ByVal lpSecurityAttributes
As Long) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long)
As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long)
As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hObject As Long,
ByVal lpDword As Long) As Long
'variabili d 'istanza
Dim HandleFile As Integer
Dim NomeFile As String
Dim PathFile As String
Dim Aperto As Boolean
Dim Scrittura As Boolean
'costanti
Const MAX_PATH = 260
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const FILE_SHARE_ALL = &H3
Const FILE_SHARE_NO = &H0
Const OPEN_ALWAYS = 4
Const OPEN_EXISTING = 3
Const CREATE_ALWAYS = 2
Const CREATE_NEW = 1
Const TRUNCATE_EXISTING = 5
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_FLAG_WRITE_THROUGH = &H80000000
Friend Function Apri(saccesso As Accessofile, slock As lockfile) As Boolean
Dim bRetVal As Boolean
Dim iI, nVolte As Integer
Dim ulAccess As Long, ulLock As Long, Errore As Long
Dim sTemp As String
Dim lLetti As Long
Select Case saccesso
    Case ReadOnly
        ulAccess = GENERIC_READ
        Scrittura = False
    Case WRITEONLY
        ulAccess = GENERIC_WRITE
        Scrittura = True
    Case READWRITE
        Scrittura = True
        ulAccess = GENERIC_READ Or GENERIC_WRITE
    Case Append
        ulAccess = GENERIC_WRITE
        Scrittura = True
End Select
Select Case slock
    Case LOCKREADWRITE
        ulLock = FILE_SHARE_NO
    Case LOCKREAD
        ulLock = FILE_SHARE_WRITE
    Case LOCKWRITE
        ulLock = FILE_SHARE_READ
    Case SHAREDFILE
        ulLock = FILE_SHARE_ALL
End Select
sTemp = PathFile & NomeFile
HandleFile = CreateFile(sTemp, ulAccess, ulLock, 0, OPEN_ALWAYS,
FILE_ATTRIBUTE_NORMAL, 0)
Errore = Err.LastDllError
If Not IsNull(HandleFile) And Not HandleFile = -1 Then
    bRetVal = True
    Aperto = True
Else
    bRetVal = False
End If
Apri = bRetVal
End Function
Function Cancella() As Boolean
Cancella = (DeleteFile(PathFile & NomeFile) > 0)
End Function
Function CancellaEx(sFile As String) As Boolean
CancellaEx = (DeleteFile(sFile) > 0)
End Function
Function CancellaMulti(Path As String, Mask As String) As Boolean
Dim lpFindFileData As WIN32_FIND_DATA
Dim hHandle As Long
Dim bResult As Boolean
bResult = True
hHandle = FindFirstFile(Path & Mask, lpFindFileData)
If hHandle <> -1 Then
    If lpFindFileData.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY Then
            Me.CancellaEx (Path & StrConv(lpFindFileData.cFileName,
vbUnicode))
        End If
    Do While bResult
        bResult = FindNextFile(hHandle, lpFindFileData)
        If bResult And lpFindFileData.dwFileAttributes <>
FILE_ATTRIBUTE_DIRECTORY Then
            Me.CancellaEx (Path & StrConv(lpFindFileData.cFileName,
vbUnicode))
        End If
    Loop
    FindClose (hHandle)
End If
CancellaMulti = True
End Function
Sub Chiudi()
CloseHandle (HandleFile)
Aperto = False
End Sub
Function Copia(sSource As String, sDestination As String) As Boolean
Copia = (CopyFile(sSource, sDestination, False) > 0)
End Function
Function CreaDir(Path As String) As Boolean
CreaDir = (CreateDirectory(Path, 0) > 0)
End Function
Function Esiste() As Boolean
Esiste = EsisteEx(PathFile & NomeFile)
End Function
Function EsisteEx(sFile As String) As Boolean
Dim lpFindFileData As WIN32_FIND_DATA
Dim hHandle As Long
Dim bResult As Boolean, bEsiste As Boolean
bResult = True
bEsiste = False
hHandle = FindFirstFile(sFile, lpFindFileData)
If hHandle <> -1 Then
    bEsiste = lpFindFileData.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY
    Do While bResult And Not bEsiste
        bResult = FindNextFile(hHandle, lpFindFileData)
        bEsiste = bResult And lpFindFileData.dwFileAttributes <>
FILE_ATTRIBUTE_DIRECTORY
    Loop
    FindClose (hHandle)
End If
EsisteEx = bEsiste
End Function
Function EsisteDir(sFile As String) As Boolean
Dim lpFindFileData As WIN32_FIND_DATA
Dim hHandle As Long
Dim bResult As Boolean, bEsiste As Boolean
bResult = True
bEsiste = False
hHandle = FindFirstFile(sFile, lpFindFileData)
If hHandle <> -1 Then
    bEsiste = lpFindFileData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY
    FindClose (hHandle)
End If
EsisteDir = bEsiste
End Function
Sub Flush()
If Scrittura Then
    FlushFileBuffers (HandleFile)
End If
End Sub
Function cLeggi(cBuffer() As Byte, lQuanti As Long) As Long
Dim lLetti As Long, lDumb As Long
lDumb = cReadFile(HandleFile, cBuffer(0), lQuanti, lLetti, 0)
cLeggi = lLetti
End Function
Function Leggi(sBuffer As String, lQuanti As Long) As Long
Dim lLetti As Long, lDumb As Long
lDumb = ReadFile(HandleFile, sBuffer, lQuanti, lLetti, 0)
Leggi = lLetti
End Function
Function Lunghezza() As Long
Lunghezza = LunghezzaEx(PathFile + NomeFile)
End Function
Function LunghezzaEx(sFile As String) As Long
If Aperto Then
   LunghezzaEx = GetFileSize(HandleFile, 0)
Else
   LunghezzaEx = FileLen(sFile)
End If
End Function
Function Rinomina(sSource As String, sDestination As String) As Boolean
Rinomina = (MoveFile(sSource, sDestination) > 0)
End Function
Function Scrivi(sBuffer As String, lQuanti As Long) As Long
Dim lScritti As Long, lDumb As Long
lDumb = WriteFile(HandleFile, sBuffer, lQuanti, lScritti, 0)
Scrivi = lScritti
End Function
Function cScrivi(sBuffer() As Byte, lQuanti As Long) As Long
Dim lScritti As Long, lDumb As Long
lDumb = cWriteFile(HandleFile, sBuffer(0), lQuanti, lScritti, 0)
cScrivi = lScritti
End Function
Function SeekFile(lQuantiBytes As Long, Dadove As SeekFile) As Long
Dim lPosizione As Long
lPosizione = SetFilePointer(HandleFile, lQuantiBytes, 0, Dadove)
SeekFile = lPosizione
End Function
Function SetFile(sFile As String)
NomeFile = sFile
End Function
Function SetPath(sPath As String)
PathFile = sPath
End Function
Private Sub Class_Initialize()
Aperto = False
End Sub
Private Sub Class_Terminate()
If Aperto Then
   Me.Chiudi
End If
End Sub
Public Function ScriviStringa(sBuffer As String) As Long
Dim lScritti As Long, lDumb As Long
lDumb = WriteFile(HandleFile, sBuffer, Len(sBuffer), lScritti, 0)
ScriviStringa = lScritti
End Function
Function SetAttributi(Path As String) As Boolean
Dim lpFindFileData As WIN32_FIND_DATA
Dim hHandle As Long
Dim bResult As Boolean
bResult = True
hHandle = FindFirstFile(Path & "*.*", lpFindFileData)
If hHandle <> -1 Then
    If lpFindFileData.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY Then
            SetFileAttributes Path & StrConv(lpFindFileData.cFileName,
vbUnicode), FILE_ATTRIBUTE_NORMAL
    End If
    Do While bResult
        bResult = FindNextFile(hHandle, lpFindFileData)
        If bResult And lpFindFileData.dwFileAttributes <>
FILE_ATTRIBUTE_DIRECTORY Then
            SetFileAttributes Path & StrConv(lpFindFileData.cFileName,
vbUnicode), FILE_ATTRIBUTE_NORMAL
        End If
    Loop
    FindClose (hHandle)
End If
SetAttributi = True
End Function
Public Property Get GetPathFile() As String
GetPathFile = PathFile & NomeFile
End Property

 End Function
in genere uso l'oggetto Scripting.FileSystemObject
Guarda qua :
dim oScripting as object
dim Folder as object
dim subFolder as object
set oScripting = CreateObject("Scripting.FileSystemObject")
set Folder = oScripting.GetFolder(app.path)
for each subFolder in Folder.subFolders
    Debug.print subFolder.name
    Debug.Print subFolder.Path
next
per quanto riguarda il presunto Bug...
ufficialmente non lo è :
(da MSDN)
vbDirectory    16    Specifies directories or folders in addition to files
with no attributes.
Ciao
Enrico


Ah, ecco!
Mi sembrava infatti che una volta ho dovuto filtrare tutti gli altri...
Proverň domani.
Per quanto riguarda il FSO, non mi č mai piaciuto...
Ciao

 wrote in message
news:e2H77.20266$Pb6....@news1.tin.it...

c'e' un motivo preciso, oppure č solo questione di gusti ?
ciao
Enrico

 SOTTO :((((((((((((((((
Scusa, Alfonso, hai avuto una visione sulla via di Damasco o cedi a causa di
forza maggiore (leggasi "Pal")...
:-)
ciao
ugo

 ugo
ovviamente e' una cortesia nei miei cfr.
mi picco di esserne convinto :)
ma non temere, quegli smiley inversi me li sta facendo pagare carissimi.
il seguito a fra un po', se sopravvivo...

 c'e' un motivo preciso, oppure č solo questione di gusti ?
Preferisco occuparmi io delle cose "a basso livello", piuttosto che delegare
la cosa a un componente com (di scripting aggiuntivo per di piů, che
potrebbe non essere installato).
Poi la gestione dei files č spesso piů semplice nel metodo standard.
Ciao

 End if
If (GetAttr(D) And vbDirectory) <> 0 Then
    ' è una directory
End if
Devo dormire di più la sera...
Ciao

 ha scritto nel messaggio
news:9jofls$r73$1...@lacerta.tiscalinet.it...

Il punto č:
resto della mia idea, ma visto che c'č stata una specie di rivolta, e che
non mi piace fare il bastian contrario a tutti i costi, per buona convivenza
mi piego, seppur MOLTO insoddisfatto.
C'č poi un discorso umanitario: non vorrei confondere ULTERIORMENTE le idee
a Pal, la situazione č gia delicata Ado, Dao, Rdo, classi, metodi, proprietą
:)))
Ciao
Alfonso

 Alfonso

 Devo dormire di più la sera...
me lo dico sempre anch'io... da troppo tempo, ormai  :o
Faber

 ha scritto nel messaggio
news:9jsj2l$1d6cd$1...@ID-66268.news.dfncis.de...
Problemi di data? Sei nell'anno 13486, come hai fatto?
_____________________________________________
James Tiberius Kirk, matricola SC 937-076 CEC
  Nato a Riverside, nello Iowa, USA, Terra
            il 1277.1 (26/03/2233)

 Problemi di data? Sei nell'anno 13486, come hai fatto?
uh? di che data parli?
scusami se era una battuta e non l'ho capita, infatti ora vado a nanna
:P
Faber