Questa è la sezione dedicata ad alcuni aspetti della programmazione Visual Basic e Visual Basic for Application.

Sarà una sezione molto vasta che raccoglierà suggerimenti, esempi di programmazione ecc.

Naturalmente sei chiamato a collaborare inviandomi richieste, suggerimenti, esempi applicativi.

NB. Se hai trovato questa pagina attraverso un motore di ricerca è probabile che non sia visibile per intero, clicca qui per visualizzarla al meglio (solo per i browser compatibili con il multi-frame).

INSERISCI NEI PREFERITI - http://www.visualbasic.subito.cc - INSERISCI NEI PREFERITI

Informazioni di Sistema

Con informazioni di sistema intendo:

• Informazioni disco
• Informazione delle variabili di sistema

Informazioni disco

Vediamo come reperire le informazioni del disco.

Iniziamo con le dichiarazioni delle funzioni (API) utilizzate:

Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByValnBufferLength As Long, ByVal lpBuffer As String) As Long
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

copiare queste tre dichiarazioni in un file bas insieme alle dichiarazioni delle variabili:

Public Type Dischi
lettera As String * 3
STotale As Double
SOccupato As Double
SLibero As Double
Etichetta As String * 11
Nserie As Double
End Type
Public disco As Dischi

e alle funzioni (function):

Sub InfoDrive(l As String)
'sub che restituisce la variabile disco contenente i sequenti campi:
'per ottenere i Mb dividere \1024 \1024
Dim nSectors As Long
Dim nBytes As Long
Dim nFreeClusters As Long
Dim nTotalClusters As Long
Dim afflags As Long, imaxcomp As Long, slabel As String, iserial As Long
slabel = String$(cMaxPath, 0)
Call GetDiskFreeSpace(l, nSectors, nBytes, nFreeClusters, nTotalClusters)
Call GetVolumeInformation(l, slabel, cMaxPath, iserial, imaxcomp, afflags, sNullStr, 0)
disco.lettera = l
disco.STotale = Format(nSectors, "@") * Format(nBytes, "@") * (Format((nTotalClusters / 1), "@"))
disco.SLibero = Format(nSectors, "@") * Format(nBytes, "@") * Format(nFreeClusters, "@")
disco.SOccupato = Format(nSectors, "@") * Format(nBytes, "@") * Format((nTotalClusters - nFreeClusters), "@")
On Local Error Resume Next
disco.Etichetta = Trim(Left(slabel, InStr(slabel, Chr$(0)) - 1))
If Err <> 0 Then Err = 0: disco.Etichetta = ""
disco.Nserie = iserial
End Sub

Sub InfoDrives(lista As ListBox)
allDrives$ = Space$(64)
r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
allDrives$ = Left$(allDrives$, r&)
lista.AddItem ("Informazioni relative ai dischi presenti")
Do
pos% = InStr(allDrives$, Chr$(0))
If pos% Then
JustOneDrive$ = Left$(allDrives$, pos%)
allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
InfoDrive (JustOneDrive$)
lista.AddItem ("Disco " & disco.Etichetta & " [" & Str(disco.Nserie) & " ]")
lista.AddItem ("Disco " & disco.lettera & " contiene " & disco.STotale & " byte di cui liberi " & disco.SLibero
End If
Loop Until allDrives$ = ""
End Sub

Nella form principale posizionare una listbox che deve essere passata alla procedura InfoDrivers. ad esempio, il contenuto di un command potrebbe essere:

Call InfoDrives(List1)

in questo modo si ottiene un risultato del genere:

Source infodrives (zip) - 3 KB

Scarica Source

Attenzione: La funzione InfoDrives potrebbe non rilevare correttamente l'etichetta dei dischi sotto win2000 per un probabile cambiamento alle api interessate. per il resto funziona correttamente.

Informazione delle variabili di sistema (computer ed utente)

Per informazioni delle variabili di sistema, intendo le seguenti informazioni:

• Cartella di sistema
• Cartella temporanea
• Tipo e numero di processori
• Tipo di tastiera
• Computer name
• User name
• Unità di disco fisso, rimovibile, ram, cdrom, ecc

Riportare l'intera lista di dichiarazioni è troppo lungo quindi preferisco allegare il source (ben documentato) di un esempio che sfrutta queste funzioni. Il programma ha il seguente output:

Attenzione: ho riportato, nel report finale, solo alcune informazioni. In realtà le funzioni sono in grado di rintracciare molte più informazioni.

Source infopc (zip) - 15 KB

Scarica Source

Scrivere/Leggere registro di Windows

Conoscere bene il registro di windows, ritengo sia uno dei compiti essenziali del programmatore di Visual Basic. Prima di tutto, perché rappresenta una miniera di informazioni: è in questo che windows 'nasconde' tutte le sue impostazioni, secondo è qui che un programmatore dovrebbe registrare le impostazioni del proprio programma (ad esempio le opzioni o le impostazioni di visualizzazione). Per ora non ho l'intenzione di illustrare dettagliatamente come si compone il registro, quindi mi rivolgo ai programmatori che già hanno avuto a che fare con il registro e che vogliono poter leggere o scrivere delle voci.

La prima funzione si chiama PrendiStrRegistro e serve per reecuperare appunto una stringa contenuta in una chiave di registro. Utilizza le seguenti funzioni API:

RegOpenKeyEx

RegQueryValueEx

RegQueryValueExStr

RegCloseKey

per le dichiarazioni di queste funzioni utilizzare direttamente

'legge una stringa nel registro
'le scelte possibili sono:
'0 - se la chiave ricercata non esiste restituisce stringa ""
'1 - se la chiave ricercata non esiste genera errore API
'2 - se la chiave ricercata non esiste avverte l'utente con msgbox
Function PrendiStrRegistro(scelta As Integer, sKey As String, Sitem As String, Optional ByVal hroot As EROOTKEY = HKEY_CLASSES_ROOT) As String
Dim e As Long, hkey As Long, s As String
' apre una sottochiave
e = RegOpenKeyEx(hroot, sKey, 0, KEY_QUERY_VALUE, hkey)
If e <> 0 Then
If scelta = 0 Then
PrendiStrRegistro = ""
Exit Function
End If
If scelta = 1 Then ApiRaiseIf e
If scelta = 2 Then
Avverti = MsgBox("La chiave " & sKey & "non è presente nel registro", vbCritical, "Attenzione")
PrendiStrRegistro = ""
Exit Function
End If
End If
Dim ert As EREGTYPE, C As Long
'prende la lunghezza e controlla che sia una stringa
e = RegQueryValueEx(hkey, Sitem, 0&, ert, 0&, C)
If e <> 0 Then
If scelta = 0 Then
PrendiStrRegistro = ""
Exit Function
End If
If scelta = 1 Then ApiRaiseIf e
If scelta = 2 Then
Avverti = MsgBox("La chiave " & Sitem & "non è presente nel registro", vbCritical, "Attenzione")
PrendiStrRegistro = ""
Exit Function
End If
End If
If C <> 0 Then
s = String$(C - 1, 0)
'legge la stringa
e = RegQueryValueExStr(hkey, Sitem, 0&, ert, s, C)
If e <> 0 Then
If scelta = 0 Then
PrendiStrRegistro = ""
Exit Function
End If
If scelta = 1 Then ApiRaiseIf e
If scelta = 2 Then
Avverti = MsgBox("Non è possibile leggere la chiave " & Sitem, vbCritical, "Attenzione")
PrendiStrRegistro = ""
Exit Function
End If
End If
End If
RegCloseKey hkey
PrendiStrRegistro = s
End Function

un esempio di dichiarazione:

stringa = Trim(PrendiStrRegistro(0, URLRegistro, "chiave", RootRegistroLong))

Per scrivere nel registro si possono utilizzare delle funzioni API, io generalmente però prediligo un altro sistema molto più semplice. Vi riporto un esempio reale. Quello che segue è una subroutin utilizzata dal programma CdAudio99 (presente nel gruppo Download) per registrare le voci di configurazione:

Public Sub configura()
comando = "regedit /e """ & percorso & "\rip.reg""" & " hkey_classes_root\audiocd"
Shell (comando)
'scrivi file
nomefile = percorso & "\ins.reg"
Open nomefile For Output As #1 ' Apre il file per l'input.
Print #1, "REGEDIT4"
Print #1, "[HKEY_CURRENT_USER\Software\CdAudio99]"
Print #1, "@=" & """Leonardo Bandini"""
Print #1, "[HKEY_CLASSES_ROOT\audiocd]"
Print #1, "@=" & """CD audio """
Print #1, """EditFlags""" & "=hex:02,00,00,00"
Print #1,
Print #1, "[HKEY_CLASSES_ROOT\audiocd\DefaultIcon]"
Print #1, "@=" & """C:\\WIN95B\\SYSTEM\\shell32.dll,40"""
Print #1,
Print #1, "[HKEY_CLASSES_ROOT\audiocd\shell]"
Print #1, "@=" & """play"""
Print #1,
Print #1, "[HKEY_CLASSES_ROOT\audiocd\shell\play]"
Print #1, "@=" & """&Esegui"""
Print #1,
Print #1, "[HKEY_CLASSES_ROOT\audiocd\shell\play\command]"
' scrivere il percorso con due \\
per = Left(percorso, 1)
totc = Len(percorso)
For i = 2 To (totc - 1)
p = Left(Right(percorso, totc + 1 - i), 1)
If p = "\" Then p = "\\"
per = per & p
Next i
per = per & Right(percorso, 1)
Print #1, "@=""" & per & "\\cdaudio.exe"""
Print #1, """FolderAvvio""=""" & per & """"
MsgBox ("Questo è il primo avvio di CdAudio99, il programma ha automaticamente aggiunto delle voci nel registro di configurazione. Queste voci saranno rimosse automaticamente al momento della eventuale disinstallazione.")
primoavvio = True
m = Str(Month(Now))
g = Str(Day(Now))
If m < 10 Then m = "0" & m
If g < 10 Then g = "0" & g
Call cripta(g, m, 1)
Print #1, """TempAgg""=""" & default_interv & """"
Print #1, """ScrolTempo""=""" & defaultTAT & """"
Close #1
comando = "regedit /i /s """ & percorso & "\ins.reg"""
Shell (comando)
'*************************************************
'MsgBox "Le nuove informazioni sono state scritte nel registro", 48, "Attenzione"
C = percorso & "\ins.reg"
Kill C
'*******************************************************
Load Form7
End Sub

in sostanza scrive un file di testo, particolarmente formattato, salvato in formato: file.reg, che può essere immesso nel registro o facendo doppio click su di esso, oppure in realtime (direttamente dall'esecuzione di un programma) con il comando seguente:

comando = "regedit /i /s """ & percorso & "\ins.reg"""
Shell (comando)

Per maggiore completezza di trattazione, e soprattutto perché illustrare tutte le procedure occorrerebbe troppo spazio, ho deciso di allegare un modulo (file in formato .mod) contenente tutte queste funzioni ampiamente commentate per il loro utilizzo.

Source leg_scr_reg (zip) - 57,8 KB

Scarica Source

Nuova versione del sorgente aggiornata il 22/12/00

Copia file con barra di avanzamento

Ecco a grande richiesta una alternativa a filecopy pesantemente limitato.
Questa funzione è capace di aprire un file in binario e di copiarlo visualizzando una barra di avanzamento. Ecco, a grande richiesta, il source:

Function CopiaFile(origine As String, destinazione As String, prbarra As Object) As Long
prbarra.Max = 100
prbarra.Min = 0
Const BUFSIZE = 1024 'set the buffer size
Static Buf$
Dim BTest!, FSize! 'declare the needed variables
Dim Chunk%, F1%, F2%
LunghezzaFileDestinazione = 0
prbarra.Value = 0
Open origine For Binary As #1 ' Apre il file.
Flunghezza = LOF(1) ' Ottiene la lunghezza del file.
Open destinazione For Binary As #2 ' Apre il file.
BTest = Flunghezza - LOF(2)
Do
If BTest < BUFSIZE Then
Chunk = BTest
Else
Chunk = BUFSIZE
End If
Buf = String(Chunk, " ")
Get 1, , Buf
Put 2, , Buf
BTest = Flunghezza - LOF(2)
prbarra.Value = (100 - Int(100 * BTest / Flunghezza)) 'advance the progress bar as the file is copied
Loop Until BTest = 0
Close 1 'closes the source file
Close 2 'closes the destination file
End Function

oltre alla source della function rendo disponibile la source di un esempio che la utilizza:

Limitare Esecuzione di un programma

In questo modo intendo dotare un programma di una caratteristica essenziale

controllare al momento dell'esecuzione se ci sono altre istanze dello stesso.

Molti programmi, hanno la necessità, di dover essere lanciati una sola volta.

Con questa procedura: limitaAvvio, il programma controlla se vi sono altre istanze di se stesso e a seconda della configurazione, opera in tre modi diversi:

• Avvia una successiva istanza (0)
• Termila la nuova istanza con un messaggio configurabile (1)
• Termina la sua istanza passando il controllo alla prima (2)

Ma ecco la procedura:

'Controlla se c'è già una istanza attiva
'se tipo = 0 default avvia una successiva istanza
'se tipo = 1 termina la nuova istanza con un messaggio
'se tipo = 2 passa il controllo alla prima
'N.B. bisogna dichiarare LimitaAvvio nel form_load principale
Sub LimitaAvvio(tipo As Integer, mio As Object, messaggio As String)
On Local Error GoTo errore
If tipo = 0 Then Exit Sub
If tipo = 1 Then
If App.PrevInstance Then
MsgBox messaggio
End
End If
Exit Sub
End If
If tipo = 2 Then
If App.PrevInstance Then
Dim stitle As String
stitle = mio.Caption
mio.Caption = Hex$(mio.hwnd)
AppActivate stitle
End
End If
Exit Sub
End If
errore:
End
End Sub

Questa procedura apparentemente molto semplice, è di notevole importanza, e non necessita di nessuna dichiarazione preventiva.

Unica accortezza è quella di lanciarla nel form di avvio.

esempio

form_load()

call LimitaAvvio(2,me,"")

end sub

In questo modo il programma cessa la nuova istanza e passa alla prima il controllo.

Form in primo piano

Questa sezione è in realtà un insieme di suggerimenti per lavorare bene con le finestre.

Una grande necessità è quella di fare in modo che una finestra sia sempre in primo piano rispetto alle altre, ecco che vi viene in aiuto FinestraOnTop:

' - Form sempre in primo piano
'Inserire la seguente dichiarazione e le costanti in un modulo Bas
'Routine per impostare un form Always On Top:
Public Sub FinestraOnTop(X As Form, Y As Boolean)
'SWP_NOACTIVATE = &H10
'SWP_SHOWWINDOW = &H40
'HWND_TOPMOST = -1
'HWND_NOTOPMOST = -2
Select Case Y
Case Is = True
SetWindowPos X.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW
Case Is = False
SetWindowPos X.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Select
End Sub

in questo modo sarà sufficiente richiamarla in questo modo:

call FinestraOnTop (me,"true")

per fare in modo che la finestra rimanga sopra le altre.

Esempio Database semplice con DbGrid

Segue un piccolo esempio di gestione di un database costituito da un insieme di records al massimo di 800/1000 records. Data la grande richiesta ho deciso di pubblicare il source di questo esempio. In realtà è una parte del source del programma TempoInternet 2000, scaricabile gratuitamente nella sezione Download. Si tratta del modulo che riproduce a video i records dei collegamenti. Mi sono servito per la riproduzione dell'oggetto DbGrid.

Nel souce è compreso il sub per la ricerca, e per l'iserimento.

Al momento dell'apertura del progetto si potrebbero presentare dei problemi dovuti ad una diversa registrazione dell'oggetto DbGrid. In questo caso leggere il file leggimi.txt contenuto nel pacchetto zippato.

Il file contente il database si chiama registro.dat e deve essere copiato nella radice della partizione C, oppure è necessario modificare il contenuto della variabile "filereg" presente nel modulo variabili.bas.

Questo perché in fase di Debug la cartella corrente si posiziona di default nella cartella in cui è stato installato VB, e quindi per non appesantire il codice ho ritenuto opportuno adottare questa semplificazione.

Source esempioDB (zip) - 46 KB

Scarica Source

Provvederò prossimamente a farne una versione più commentata. Mi scuso per eventuali bug possibili, dovuti dalla mancanza di tempo.

Numeri Casuali, Attesa ...

Ecco alcune semplici ma comode procedure che possono svolgere alcuni compiti ricorrenti:

Estrarre un numero Casuale

Public Function NumeroCaso(inf As Double, sup As Double) As Double
Randomize
NumeroCaso = Int(((sup) * Rnd) + inf) ' Genera un valore casuale
' compreso tra 1 e numerotracce-1.
End Function

Questa procedura non fa altro che estrarre un numero casuale compreso tra inf e sup.

Attesa di un tempo preciso

'Versione molto più precisa di pausa tempo con precisione
'maggiore del millesimo di secondo

Dichiarazione API utilizzate:

Declare Function QueryPerformanceFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (lpFrequency As LARGE_INTEGER) As Long
Declare Function QueryPerformanceCounter Lib "kernel32" Alias "QueryPerformanceCounter" (lpPerformanceCount As LARGE_INTEGER) As Long

Public Sub PausaTempoM(p As Currency)
' Imposta la durata.
inizio = TimerApi ' Imposta l'ora di inizio.
Do While TimerApi < inizio + p
DoEvents ' Passa il controllo ad altri
' processi.
Loop
End Sub

'Questa funzione restituisce il tempo trascorso con notevole precisione
'è preferibile usarla al posto di timer

Public Function TimerApi() As Single
Static secfreq As Currency, secstart As Currency
If secfreq = 0 Then QueryPerformanceFrequency secfreq
QueryPerformanceCounter secstart
If secfreq Then
TimerApi = secstart / secfreq
Else
TimerApi = 0
End If
End Function

In questo modo si utilizza una funzione api per attendere un certo tempo.

Perché utilizzare questa procedura? Prima di tutto è precisa al millesimo di secondo, secondo rispetta l'idea di multitasking, cioè non occupa risorse durante l'attesa. Avete mai provato a vere cosa succede alle risorse (uso CPU) durante altre procedure di attesa? fatelo e rimarrete sconcertati.

Un'altro modo per attendere un certo numero di secondi senza scomodare le API, però ottenendo un risultato peggiore a livello di prestazioni:

'espressamente creata per attendere p secondi

Public Sub PausaTempo(p As Integer)
Dim formaperti
' Imposta la durata.
inizio = Timer ' Imposta l'ora di inizio.
Do While Timer < inizio + p
formaperti = DoEvents ' Passa il controllo ad altri

' processi.
Loop
End Sub

Notare la presenza di DoEvents necessario per far "respirare" la CPU durante i cicli Do-While, Do-Until. Io quale utilizzo? certamente la prima.

Selezionare la stampante


Ecco un argomento che ha sollevato non pochi problemi. Come si fa ad enumerare le stampanti presenti nel sistema? Ma soprattutto come si inviano documenti ad una stampante non predefiniti? I problemi che sono sorti sono dovuti ad un baco di VB5 risolto con l'ormai necessario Service Pack 3.

Ecco un esempio semplice che spiega come risolvere questi problemi. Naturalmente procuratevi, se non lo avete già fatto (oppure se non avete VB6), l'ultimo service pack. Ma veniamo al source.

questo è il semplice programmino:

Prima di tutto dobbiamo enumerare in un combobox tutte le stampanti:

'processo di enumerazione delle stampanti.
'trasferisce i nomi delle stampanti all'oggetto combo

Dim X As Printer
For Each X In Printers
Combo1.AddItem X.DeviceName
'Set Printer = X
If X.TrackDefault = True Then
' Imposta la stampante come predefinita di sistema.
'Set Printer = X
' Interrompe la ricerca di una stampante.
Combo1.Text = X.DeviceName
'Exit For
End If
Next
'fine del processo di enumerazione

poi il codice da abbinare al combobox:

Dim X As Printer
For Each X In Printers
If X.DeviceName = Combo1.Text Then
' Imposta la stampante come predefinita di sistema.
Debug.Print X.DriverName
Set Printer = X
Exit For
End If
Next

ed ecco fatto adesso sarà sufficiente spedire dati alla stampante per ottenere il risultato voluto:

Printer.Print "la stampante selezionata è la seguente " & Printer.DeviceName
Printer.Print "Leonardo Bandini - https://www.leonardobandini.it"
Printer.Print Text1.Text
Printer.EndDoc

Source stampanti (zip) - 8 KB

Scarica Source

Ricerca veloce di files nell'hd

Avete mai avuto la necessità di compiere una ricerca di un file (o un gruppo di files ) nell'hd o in una partizione di esso? Vi siete percaso inbattuti nel comando Dir$ e avete quindi :-) pensato ad una soluzione?. Ecco quà presentata una soluzione valida e veloce per creare un programma di ricerca di files. Ovviamente ci vengono in aiuto delle funzioni API, vediamole:

Le API sono le segiuenti:

• FindFirstFile
• FindNextFile
• FindClose

Le cui dichiarazioni sono le seguenti:

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Ma veniamo al difficile e cioè come combinare opportunamente queste tre funzioni per creare una funzione ricorsiva veloce che svolga il nostro compito.

Prima di tutto, bisogna creare una funzione che trovi tutte le cartelle e le processi una ad una. La mia si chiama Scovadir vediamo come funziona:

Public Function scovadir(filenome As String, InizioDir As String) As Boolean
Static SfileNome As String
Static Sfnome As String
Static f As WIN32_FIND_DATA
Dim hfile As Long
Static fboolean As Boolean
If InizioDir = Empty Then InizioDir = CurDir
'scrivi indirizzo
Form1!txtpath.Text = Trim(InizioDir)
Form1.Refresh
'trova il primo file
'scova tutti i files della cartella corrente tutte le volte
'che viene invocata scovadir
hfile = FindFirstFile(InizioDir & "*.*", f)
'se la cartella non esiste oppure i dirritti non consentono
'l'apertura di questa cartella non viene processata
If hfile <> Invalid_Handle_Value Then
Call scovatuttifile(filenome, InizioDir)
Do
DoEvents
If AnnullaRicerca = True Then Exit Function
Sfnome = TagliaNull(f.cFileName)
'prendo solo le cartelle valide
If f.dwFileAttributes = vbDirectory Or f.dwFileAttributes = vbDirectory + vbHidden Or f.dwFileAttributes = vbDirectory + vbReadOnly Or f.dwFileAttributes = vbDirectory + vbArchive Or f.dwFileAttributes = vbDirectory + vbSystem Or (f.dwFileAttributes - vbDirectory) < (vbSystem + vbArchive + vbHidden + vbReadOnly) Then
'trova una cartella e vi entra
'avvia procedimento ricorsivo
If (Sfnome) <> "." And (Sfnome) <> ".." Then
Call scovadir(filenome, InizioDir & (Sfnome) & "\")
End If
End If
Loop While FindNextFile(hfile, f)
End If
fboolean = FindClose(hfile)
End Function

Operazioni in dettaglio della funzione:

1) ottiene, utilizzando l'API FindFirstFile, l'handle del primo file di una cartella: hfile = FindFirstFile(InizioDir & "*.*", f)

2) Processa uno ad uno, con un ciclo do - loop tutti i file, passando di file in file con FindNextFile che ottiene l'handle del file successivo FindNextFile(hfile, f)

3) cerca tra tutti gli handle quelli che corrispondono a cartelle, cioè: f.dwFileAttributes = vbDirectory. Ma attenzione perché ci sono le cartelle nascoste, archivio, di sistema. Ognuna di queste cartelle ha una proprietà diversa. Esempio:

Cartella in lettura: vbDirectory + vbReadOnly. Come vedete le varie proprietà si sommano alla proprietà base.

4) una volta riconosciuta una cartella si richiama ricorsivamente la funzione, ripartendo quinda dal punto 1.

Tutte le volte che entriamo in una cartella nuova, dobbiamo anche lanciare la sub, che trova tutti i files: Scovatuttifile, della quale riporto solo un passo:

Public Sub scovatuttifile(filenome As String, InizioDir As String)
'scova tutti i files contenuti in una cartella
'notare l'utilizzo di dichiarazioni static per
'alleggerire l'uso di memoria.
Dim hfile As Long
Static SfileNome As String
Static Sfnome As String
Static f As WIN32_FIND_DATA
Static fboolean As Boolean
'trova il primo file
hfile = FindFirstFile(InizioDir & "*.*", f)
If hfile <> Invalid_Handle_Value Then fboolean = True
Do
DoEvents
If AnnullaRicerca = True Then Exit Sub
Sfnome = TagliaNull(f.cFileName)
'per ora solo il nome di un file preciso
'escludo cartelle di ogni genere
If Not (f.dwFileAttributes = vbDirectory) And Not (f.dwFileAttributes = vbDirectory + vbHidden) And Not (f.dwFileAttributes = vbDirectory + vbArchive) And Not (f.dwFileAttributes = vbDirectory + vbSystem) And Not ((f.dwFileAttributes - vbDirectory) < (vbSystem + vbHidden + vbReadOnly)) Then
'diversifico secondo il tipo di ricerca impostato
'tutti i files: - *.*
If filenome = "*.*" Then
contatrovati = contatrovati + 1
mTotRighe = contatrovati
arrayricerca(contatrovati).percorso = InizioDir
arrayricerca(contatrovati).dimensione = f.nFileSizeLow \ 1024 + 1
arrayricerca(contatrovati).nomefile = Sfnome
Else
'tipo di ricerca:
'0) prova* - tutti i file che iniziano per prova ,
'1) *prova - tutti i files che finiscono per prova
'2) *prova* - tutti i files che contengono prova
'3) prova*prova - tutti i files che iniziano e finiscono con prova

...

Come vedete questa risulta molto simile alla prima:

1) Ottiene l'handle del primo file

2) Processa tutti i file, scartando le cartelle

3) Se il file corrisponde ai criteri di ricerca lo passa ad un array: arrayricerca.

Public Type filetrovato
nomefile As String
percorso As String
dimensione As Long
End Type
Public arrayricerca() As filetrovato

Terminata la ricerca di tutti i files e cartelle, i dati presenti dentro la matrice arrayricerca vengono passati dentro una matrice dinamica UserData, e da qui riprodotti su schermo attraverso l'ormai noto DbGrid. (Vedi Esempio di database semplice con DbGrid).

Ulteriori suggerimenti:

1) notate l'utilizzo di dichiarazioni di variabili Static, questo per non appesantire l'utilizzo di memoria.

2) alla fine delle due function vi è una riga interessante:

fboolean = FindClose(hfile) questo serve per liberare l'handle aperto precedentemente, questo per evitare, insieme al passo 1) di riempire lo stack.

Ma adesso ecco l'esempio completo di utilizzo di queste funzioni. Il programma completo di source si chiama cercafile:

Come potrete osservare se scaricate questo esempio, la ricerca effettuata in questo modo è molto veloce. Nel mio caso è addirittura notevolmente più veloce del "Trova Files" di Windows. Le opzioni di modifica nome e cancella file sono state eliminate dal progetto perché facilmente realizzabili. Il source è sufficientemente commentato, ma se volete ulteriori spiegazioni non esitate a scrivermi.

Nel progetto, come ho detto, è presente un oggetto DbGrid. Pertanto potrebbe generarsi un problema all'apertura dello stesso, dovuto alla diversa registrazione dell'oggetto DbGrid. Se così fosse nel pacchetto compresso è presente un file: Leggimi.txt, in cui ho riportato l'eventuale soluzione al problema.

Source di Ricerca Files - 34 Kb

Cercafiles.zip

Nel Source è compreso anche un algoritmo per effettuare ricerche complesse, tipo:

prova* - tutti i file che iniziano con prova;

*prova - tutti i file che terminano con prova

*prova* - tutti i files che contengono nel nome la stringa prova

ecc.

Disattivare il tasto di chiusura di un form

Dopo un argomento un po' ostico, come quello precedente, ecco un semplice quanto utile codice per disattivare il tasto di chiusura di un form.

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If TieniAperto = False Then
If UnloadMode = vbFormControlMenu Then
Cancel = True
End If
End If
End Sub

In questo modo è possibile chiudere il form solo se la variabile booleana TieniAperto risulta: false.

avevo detto che era semplice!.

Vai alla seconda pagina della rubrica dedicata alla programmazione Visual Basic