Suggerimenti codice

Mauro VB Homepage - Programmi Questa sezione è dedicata a programmi perfettamente funzionanti sino al sistema operativo XP. Questi software non sono per vari motivi compatibili col nuovo sistema operativo Windows Vista oppure sono superati da altri programmi più recenti.
Si è ritenuto di renderli ancora disponibili anche se non viene garantita alcuna implementazione futura sugli stessi.

Espandi tutto | Chiudi tutto

Elenco tips

Cercare l'eseguibile associato ad una estensione

A volte può essere utile sapere qual'è l'eseguibile, il programma, che è associato ad una determinata estensione. Ci viene incontro la funzione API FinExecutable.

In un modulo dichiariamo le seguenti costanti e la sottostante funzione: Private Declare Function FindExecutable Lib "shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal sResult As String) As Long

Private Const MAX_PATH As Long = 260
Private Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_PATH_NOT_FOUND As Long = 3
Private Const ERROR_FILE_SUCCESS As Long = 32 'costante personale
Private Const ERROR_BAD_FORMAT As Long = 11

Public Function CercaExe(nome As String) As String
Dim success As Long
Dim pos As Long
Dim sResult As String
Dim msg As String

sResult = Space$(MAX_PATH)

success = FindExecutable(nome, vbNullString, sResult)

Select Case success
Case ERROR_FILE_NO_ASSOCIATION: msg = "Nessuna associazione"
Case ERROR_FILE_NOT_FOUND: msg = "File non trovato"
Case ERROR_PATH_NOT_FOUND: msg = "Percorso non trovato"
Case ERROR_BAD_FORMAT: msg = "Formato errato"

Case Is >= ERROR_FILE_SUCCESS:
pos = InStr(sResult, Chr$(0))
If pos Then
msg = Left$(sResult, pos - 1)
End If
End Select
CercaExe = msg
End Function
A questo punto dalla vostra applicazione richiamate il file che volete aprire come segue: Dim Eseguibile As String
Eseguibile = CercaExe("d:\temp\readme.pdf")
La stringa restituita sarà il percorso dell'eseguibile associato al file che avrete passato come argomento della funzione CercaExe.

Formattazione di numeri

Una funzione commentata per formattare i numeri aggiungendo i separatori delle migliaia anche ai numeri decimali. Questa funzione supera alcuni limiti della funzione Format di VB. Funzione fornita da Claudio Gucchierato. Private Function FormattaNumero(ByVal n As Double) As String
'Questa funzione formatta un numero aggiungendo i separatori delle migliaia anche ai numeri decimali (esempio: 1.000.000,234567)
'Questo codice, contrariamente alla funzione nativa di VB "Format(Numero, "#,##0.##")", non visualizza la virgola finale se il numero non contiene
'decimali. Inoltre il numero viene sempre formattata nella sua completa lunghezza senza dover utilizzare, come per la funzione "Format", i relativi "segnaposto" (#)
'NB non è detto che in giro si possa trovar di meglio!

On Error GoTo errore
Dim tmpLong As Long
Dim strNumber As String
Dim LunghParteIntera As Long
Dim strTmp As String

strNumber = CStr(n) 'converto il valore numerico passato come argomento della funzione, in una stringa

tmpLong = Int(n) 'prendo solo la parte intera del valore numerico passato come argomento della funzione

LunghParteIntera = Len(CStr(tmpLong)) 'calcolo la lunghezza della parte intera

strTmp = CStr(tmpLong)

If strTmp = "0" Then
FormattaNumero = strTmp & Right(strNumber, Len(strNumber) - LunghParteIntera)
Else
FormattaNumero = Format(strTmp, "#,#") & Right(strNumber, Len(strNumber) - LunghParteIntera)
End If

Exit Function
errore:
If Err.Number = 6 Then MsgBox "Numero troppo grande!", vbCritical, "Errore di overflow"
End Function
Ecco un semplice esempio di utilizzo. Text1.text= FormattaNumero(12345678.1234) Nel caso di numero troppo grande (overflow) viene restituito un messaggio di errore.

Utilizzare l'autocompletamento nelle vostre applicazioni

Con il Internet Explorer 5 e versioni successive è disponibile una nuova interessante caratteristica dell'interfaccia denominata "autocompletamento" (autocomplete).

Tramite l'autocompletamento Windows vi suggerisce, completandoli appunto, i percorsi dei file o gli URL che avete usato di recente. Potete utilizzare questa caratteristica anche nella vostre applicazioni, attraverso un controllo textbox o un combobox, ma è estendibile a qualunque altro controllo. L'unica limitazione è che questa funzionalità è disponibile soltanto se avete installato Internet Explorer 5.0 o successiva (di solito ormai presente su tutti i computer).

Create un nuovo progetto inserendo nel form un TextBox denominato "Text1" e aggiungete un modulo globale.
Il codice del modulo
In un modulo globale .BAS inserite il seguente codice:
Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SHAutoComplete Lib "Shlwapi.dll" (ByVal hWndEdit As Long, ByVal dwFlags As Long) As Long

'Costanti di sitema
' Attualmente utilizzate (SHACF_FILESYSTEM | SHACF_URLALL)
Private Const SHACF_DEFAULT As Long = &H0
' Questa costante include il File System e il resto della shell (Desktop\My Computer\Control Panel\)
Private Const SHACF_FILESYSTEM As Long = &H1
' URL presenti nella Cronologia
Private Const SHACF_URLHISTORY As Long = &H2
' URl presenti nella lista degli URL recenti
Private Const SHACF_URLMRU As Long = &H4
' Sia i File System e gli URL presenti nella Cronologia dell'utente

Private Const SHACF_URLALL As Long = (SHACF_URLHISTORY Or SHACF_URLMRU)

Public Function DoAutocomplete(ObjX As Object) As Long

Dim hWndEdit As Long

If TypeOf ObjX Is TextBox Then
' Imposta l'handle del textbox nel quale si digita
hWndEdit = ObjX.hWnd
ElseIf TypeOf ObjX Is ComboBox Then
' Recupera i campi editati scrivendoli nel combo box
hWndEdit = FindWindowEx(ObjX.hWnd, 0, "EDIT", vbNullString)
Else
' Nessun campo editato
DoAutocomplete = 0
Exit Function
End If

' Applica la funzionalità di autocompletamento
DoAutocomplete = SHAutoComplete(hWndEdit, SHACF_DEFAULT)

End Function
Il codice nel form
Per utilizzare il codice è sufficiente richiamarlo nell'evento Form_Load del form, passandogli come parametro il nome del controllo che si intende utilizzare ai fini dell'autocompletamento:
DoAutoComplete Text1 Ciò permetterà all'oggetto Text1di avere la funzionalità di autocompletamento.

Conclusione

Potete cambiare facilmente la funzionalità di autocompletamento, modificando SHACF_DEFAULT con la costante SHACF_FILESYSTEM nella funzione DoAutocomplete.
In tal modo l'autocompletamento sarà ristretto alla sola digitazione dei percorsi dei file sul computer locale, escludendo gli indirizzi internet.

Prevenire i crash alla chiusura dell'applicazione

Risoluzione del problema spinoso con alcune versioni di ComCtl32.DLL e di VB UserControls

Alcune versioni della versione 6.0 di ComCtl32.DLL causano un arresto alla chiusura del programma quando sono caricati gli stili visivi di XP in un'applicazione. Ciò accade specialmente quando si usano i controlli utente di VB. Questo articolo prevede due soluzioni al problema.

Problema
Il 40% circa dei miei progetti che supportano ComCtl32 per applicare gli stili visivi di XP ha cominciato improvvisamente ad arrestarsi quando un'applicazione veniva chiusa. Ciò è stato anche segnalato da molti utenti via mail che lamentavano dei problemi di arresto apparentemente inspiegabili. Dopo ore di ricerca, si è scoperto quanto segue:

  1. Nei progetti che hanno incluso User Controls di Visual Basic.
  2. Quando il progetto richiama la ComCtl32.DLL v6.0 (usando un file o una risorsa manifest).
  3. Nel fare funzionare la versione eseguibile del progetto.
Dopo che molti tentativi per far funzionare applicativi differenti compilati in VB, si è provato con un'applicazione che conteneva soltanto un singolo UserControl senza una singola linea di codice in esso: e ancora si è verificato l'arresto. Quindi il problema non si poteva certo risolvere modificando il codice. VB non è stato progettato per supportare gli stili visivi di XP ed il service pack non era in grado di risolvere il problema.

Due modi di risolvere il problema
Ci sono due modi di risolvere questo problema. Il primo è una metodo "più corretto", mentre il secondo è frutto di invenzione che può essere applicato generalmente a qualunque tipo di programma che provoca un arresto alla chiusura.

1. La soluzione ufficiale
Microsoft riconosce questo problema nell'articolo knowledge base KBID 309366 . Purtroppo, la causa del problema non è spiegata e la loro risoluzione suggerita non funziona. Tuttavia, pescando all'interno dell'articolo si rilevano delle informazioni che danno origine ad una soluzione. Tale soluzione deve usare la chiamata alla funzione LoadLibrary delle API della Shell32.DLL durante l'inizializzazione evento nel form che contiene il controllo: Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" ( ByVal hLibModule As Long) As Long
Private m_hMod As Long

Private Sub Form_Initialize()
m_hMod = LoadLibrary("shell32.dll")
InitCommonControls
End Sub

Private Sub Form_Unload(Cancel As Integer)
FreeLibrary m_hMod
End Sub
Una volta fatto questo, gli arresti non si sono più verificati. Sembra che lo stesso codice possa essere usato direttamente all'interno propri UserControl, negli eventi _Initialize e _Terminate, avendo ovviamente accesso al codice sorgente del controllo.

2. Ignorare l'errore e procedere
Ignorare l'errore non è la soluzione più elegante, ma può essere facile e questa tecnica può venire utile nella risoluzione degli altri problemi.

In questo caso non stiamo usufruendo delle risorse, tutto sta terminando e chiudendosi nell'ordine corretto, ma sorge il problema a causa del tempo di esecuzione di VB, cosa che accade soltanto quando VB pulisce dopo che tutto il codice di esecuzione è terminato.

Così, notando che l'arresto accade soltanto dopo che l'applicativo ha terminato il proprio lavoro, sappiamo che il processo sta chiudere tutte le istanze aperte. Poiché ogni applicazione funziona in un relativo proprio spazio di memoria, Windows sta cercando di riordinare la memoria stessa dove l'applicativo ha lasciato traccia. Quindi è questa traccia in memoria che continua ad interferire con le altre applicazioni, a meno che VB non abbia installato qualcosa nel sistema, cosa che è da considerare come altamente improbabile.

Di conseguenza possiamo risolvere questo problema semplicemente ignorandolo . L'unico problema in questo modo è che l'applicazione continua a inviare messaggi al sistema e danno origine alla nota finestra che invita a trasmettere le informazioni del Microsoft sul problema:

Fortunatamente, Windows offre un modo per evitare questi avvisi, attraverso il trattamento delle eccezioni strutturato delle API. Mentre questa api permette di intercettare questi messaggi e mantenere il funzionamento della vostra applicazione, in questo caso non ci preoccupiamo a tale proposito, poiché tutto il nostro codice ha terminato di funzionare e desideriamo solo arrestare la visualizzazione di questo messaggio. Fate questo chiamando la funzione API SetErrorMode: Private Declare Function SetErrorMode Lib "kernel32" ( _
ByVal wMode As Long) As Long

Private Const SEM_FAILCRITICALERRORS = &H1
Private Const SEM_NOGPFAULTERRORBOX = &H2
Private Const SEM_NOOPENFILEERRORBOX = &H8000&

...

' Previene tutte le finestre di dialogo e i message box di errore del sistema (UAE):
SetErrorMode SEM_NOGPFAULTERRORBOX
Ciò indirizza Windows a non visualizzare la finestra di messaggio di errore. Ora tutto quello che dobbiamo fare è richiamare questa funzione attraverso l'ultima linea del codice eseguito dall'applicazione. Notate che potreste richiamare la funzione con la prima linea di codice, ma in tal caso tutto il UAE realmente connesso con il codice non verrebbe gestito dall'applicazione e ciò comporterebbe una esecuzione in condizioni non ideali.

Inoltre è stato aggiunto un certo codice in modo da non fare la chiamata all'IDE, poiché il problema si presenta soltanto negli eseguibili compilati: Private Declare Function SetErrorMode Lib "kernel32" ( ByVal wMode As Long) As Long

Private Const SEM_NOGPFAULTERRORBOX = &H2&

Private m_bInIDE As Boolean

Public Sub UnloadApp()
If Not InIDE() Then
SetErrorMode SEM_NOGPFAULTERRORBOX
End If
End Sub

Public Property Get InIDE() As Boolean
Debug.Assert (IsInIDE())
InIDE = m_bInIDE
End Property

Private Function IsInIDE() As Boolean
m_bInIDE = True
IsInIDE = m_bInIDE
End Function
Determinare dove e quando richiamare questa funzione è cosa specifica per ogni applicazione, tuttavia funzionerà nella maggior parte dei casi aggiungendo la seguente linea di codice a ciascuna evento _Terminate dei vostri form: Private Sub Form_Terminate()
If (Forms.Count = 0) Then
UnloadApp
End If
End Sub
Se questo non funziona nel vostro applicativo, dovete verificare in quale punto si verifica il problema, in modo da richiamare il codice in quel punto.

Applicazione dimostrativa
Nell'esempio allegato Project1.exe è un progetto di VB che contiene un controllo utente vuoto compilato dentro. Quando fate funzionare questo progetto con un file manifest, si genera l'errore in chiusura. Se ponete un segno di spunta a "Unload Cleanly" tuttavia, il metodo UnloadApp è richiamato in modo da non generare l'errore. Naturalmente, l'errore nella realtà si genera, ma il sistema non se ne cura più.

Conclusione
Applicando le nuove caratteristiche alle applicazioni più vecchie si possono riscontrare problemi inattesi, poiché non sono state progettate per il nuovo sistema operativo. Tuttavia, non è sempre pratico aggiornare il codice all'ultima versione ed a volte i lavori di "rappezzo" sono necessari.

ComCtl32.DLL di Microsoft fornisce un gran numero di caratteristiche eccellenti ma le versioni aggiornate di questa DLL hanno causato problemi con applicazioni pe esistenti. Questo stato di cose sembra continuare, malgrado la disponibilità di nuovi service packs.

Le soluzioni proposte al problema dei UAE (il famoso errore "Invia a Microsoft...") per le applicazioni di VB che usano gli stili visivi di XP descritti in questo articolo non sono ideali, ma sono molto facili da applicarsi e comunque sono funzionanti.


Liberamente tradotto da un articolo di Steve McMahon

Aggiungere lo stile XP alla vostra applicazione Visual Basic

Quando fate funzionare un'applicazione Visual Basic su una macchina di XP, noterete che anche se il form ha la barra del titolo in stile XP, i controlli sul form sono ancora nel vecchio stile Windows. Tuttavia, non è cmplesso adattare un'applicazione ad usare i nuovi stili. In alcuni casi, potete applicare tale stile alle applicazioni senza codice supplementare!

Il nuovo stile XP
Gli stili visivi di Windows XP sono forniti dalle versioni 6 della ComCtl32.dll o successiva. (già nel vecchio Windows 95 quella libreria creava l'effetto 3D dei controlli). La differenza sostanziale dalle versioni precedenti di questa DLL, è che la versione 6 non è redistribuibile, per cui possono utilizzare tale stile solo i sistemi operativi che hanno questa versione installata. Attualmente solo Windows XP.ComCtl32 non applica lo stile XP ai controlli delle applicazioni per default. Per abilitarlo, occorre accertarsi che la vostra applicazione richiami la ComCtl32.dll (richiamando la api InitCommonControls della libreria ComCtl32 ed inoltre dovete inserire un file detto "manifest" come specifica che viene richiamato dalla nuova versione degli stili.

Manifest
I manifest fanno parte delle tecnologie introdotte da Microsoft per tentare di risolvere i conflitti di versioni delle DLL (citati normalmente come "hell" delle DLL) così comuni nello sviluppo di Windows. Potete avere maggiori informazioni su queste tecnologie e sui manifest negli articolo tecnico di Windows XP "How To Build and Service Isolated Applications and Side-by-Side Assemblies for Windows XP" sulla MSDN. Tuttavia, ai fini di questo articolo ciò che dovete sapere è come usare la versione 6 dei common control per realizzare un documento di XML riconosciuto come manifest da ComCtl32.Il manifest è un documento XML richiesto per utilizzare gli stili visivi di XP, ed strutturato come segue: <?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
 <assemblyIdentity
   version="1.0.0.0"
   processorArchitecture="X86"
   name="Nome del prodotto"
   type="win32" />
 <description>Descrizione della tua applicazione</description>
 <dependency>
  <dependentAssembly>
   <assemblyIdentity
     type="win32"
     name="Microsoft.Windows.Common-Controls"
     version="6.0.0.0"
     processorArchitecture="X86"
     publicKeyToken="6595b64144ccf1df"
     language="*" />
   </dependentAssembly>
  </dependency>
</assembly>
Si noti che l'attributo nome e la descrizione dell'elemento sono essenzialmente testo libero.

Accertare il collegamento dell' applicazione alla ComCtl32
Se create un manifest, ma la vostra applicazione non richiama la ComCtl32.dll, la stessa non riuscirà a caricare lo stile voluto ( a volte senza il messaggio di errore). Dovete richiamare almeno la funzione InitCommonControls prima caricare tutti gli elementi grafici e controlli presenti nella vostra applicazione. Può accadere a volte che non dobbiate fare alcunché perché la vostra applicazione richiami la ComCtl32.dll (per esempio, se tra le librerie incluse nel progetto ci sono già le Common Control), tuttavia, per essere sicuri che tutto funzioni è meglio dichiarare InitCommonControls prima della visualizzazione delle qualsiasi form.

Questo è il codice che dovrete implementare all'inizio della vostra applicazione assicurandovi così di richiamare la ComCtl32.dll:
Private Type tagInitCommonControlsEx
   lngSize As Long
   lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Private Const ICC_USEREX_CLASSES = &H200

Public Function InitCommonControlsVB() As Boolean
   On Error Resume Next
   Dim iccex As tagInitCommonControlsEx
   ' Ensure CC available:
   With iccex
       .lngSize = LenB(iccex)
       .lngICC = ICC_USEREX_CLASSES
   End With
   InitCommonControlsEx iccex
   InitCommonControlsVB = (Err.Number = 0)
   On Error Goto 0
End Function

Public Sub Main()
   InitCommonControlsVB

   '   
   ' Avvia qui la tua applicazione:
   ' 

End Sub
Realizzare il Manifest
Ci sono due modi per creare e richiamare il manifest: il modo più semplice (ma meno elegante) deve includere il manifesto sul disco per un eseguibile. Diciamo che la vostra applicazione è denominata TimeSlot.exe . Allora denominerete il file XML manifest come

TimeSlot.exe.manifest

nella stessa cartella dell'eseguibile. TimeSlot.exe caricherà automaticamente lo stile di XP. Se cambiate nome al file manifest prima del funzionamento dell'applicazione, gli stessi stili non verranno caricati.

Un metodo più completo è quello di compilare il manifest come risorsa nella vostra applicazione. Per fare questo, il manifest deve comparire come tipo RT_manifest delle risorse (24) con identificatore CREATEPROCESS_MANIFEST_RESOURCE_ID. Per un motivo bizzarro, dovete anche accertarvi che il file XML risultante sia di lunghezza multipla uniforme di 4 byte. Per esempio, se il vostro file è 597 byte dovete aggiungere gli spazi del riempimento per comporre un file di 600 byte prima della compilazione. Tale risorsa verrà inglobata utilizzando uno script del compilatore delle risorse e RC.exe

Alcune note
Gli stili di XP non si applicano durante lo sviluppo, a design time, ma solo esecuzione. Controllate quindi il vostro eseguibile. I pulsanti di opzione non applicano correttamente lo stile una volta disposti su una struttura, specialmente con VB6. Dovete disporre i vostri pulsanti di opzione su un controllo picture.
I bordi 3D su PictureBoxes, immagini ed e così via non vengono disegnati nel nuovo stile di XP, perché si tratta di una singola linea fatta di combinazioni di colore.


Liberamente tradotto da un articolo di Steve McMahon

Ordinare una matrice di numeri

Spesso capita di dover ordinare in ordine crescente i numeri presenti all'interno di una matrice. Proponiamo qui una semplice funzione di ordinamento.

Ecco la funzione, i cui parametri sono il nome della matrice da ordinare, nonché il valore minimo e il valore massimo all'interno della matrice: ovvero è possibile ordinare solo un intervallo specifico di numeri della matrice stessa. Solitamente il minimo ed il massimo coincidono con quelli della matrice stessa. Public Sub QuickSortVariants(vArray As Variant, inLow As Long, inHi As Long)

Dim pivot As Variant
Dim tmpSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long

tmpLow = inLow
tmpHi = inHi

pivot = vArray((inLow + inHi) \ 2)

While (tmpLow <= tmpHi)

While (vArray(tmpLow) < pivot And tmpLow < inHi)
tmpLow = tmpLow + 1
Wend

While (pivot < vArray(tmpHi) And tmpHi > inLow)
tmpHi = tmpHi - 1
Wend

If (tmpLow <= tmpHi) Then
tmpSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = tmpSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If

Wend

If (inLow < tmpHi) Then QuickSortVariants vArray, inLow, tmpHi
If (tmpLow < inHi) Then QuickSortVariants vArray, tmpLow, inHi

End Sub
Ecco un semplice esempio di utilizzo. Popolo una matrice con dei numeri casuali che faccio poi ordinare con la funzione suddetta. Dim Numeri(1 To 10) As Integer
Numeri(1) = 10
Numeri(2) = 17
Numeri(3) = 32
Numeri(4) = 8
Numeri(5) = 23
Numeri(6) = 33
Numeri(7) = 11
Numeri(8) = 21
Numeri(9) = 50
Numeri(10) = 16
Call QuickSortVariants(Numeri, LBound(Numeri), UBound(Numeri))
For i = 1 To 10
test = test & Numeri(i) & " "
Next i
MsgBox test
Al termine visualizzo il risultato in un message box.

Lanciare un file utilizzando ShellExecute

Molti domandano come aprire un file esterno, associato ad un qualunque programma, da Visual Basic.

In un modulo dichiariamo la seguente funzione: Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As_
String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Const SW_NORMAL = 1
A questo punto dalla vostra applicazione richiamate il file che volete aprire come segue: Dim X As Long
X = ShellExecute(hWnd, "Open", "C:\nomecartella\nomefile.doc", vbNullString, vbNullString, SW_NORMAL)
In questo caso si apre direttamente un documento di Word. Con lo stesso sistema potere aprire una pagina Internet o inviare una mail. Dim X As Long
X = ShellExecute(hWnd, "Open", "http://www.maurorossi.net", vbNullString, vbNullString, SW_NORMAL)

'oppure

Dim X As Long
X = ShellExecute(hWnd, "Open", "mailto:rossimt@sistel.it?subject=Prova&body=Testo da inviare", vbNullString, vbNullString, SW_NORMAL)
Con lo stesso metodo potete anche lanciare un exe, o un file di qualunque estensione.
(Il quarto parametro è per gli eventuali comandi della riga di comando, il quinto per la directory di origine, in questo caso sono entrambi nulle).

Generare una matrice di numeri casuali univoci

Mi è stato chiesto molte volte come generare una sequenza di numeri univoci in un intervallo definito. E' un classico sistema utilizzato per simulare estrazioni del lotto o per la generazione di calendari di tipo sportivo.

In un modulo dichiariamo la seguente funzione: Public Function RandomNumbers(Upper As Integer, _
Optional Lower As Integer = 1, _
Optional HowMany As Integer = 1, _
Optional Unique As Boolean = True) As Variant

On Error GoTo LocalError
If HowMany > ((Upper + 1) - (Lower - 1)) Then Exit Function
Dim x As Integer
Dim n As Integer
Dim arrNums() As Variant
Dim colNumbers As New Collection

ReDim arrNums(HowMany - 1)
With colNumbers
'First populate the collection
For x = Lower To Upper
.Add x
Next x
For x = 0 To HowMany - 1
n = RandomNumber(0, colNumbers.Count + 1)
arrNums(x) = colNumbers(n)
If Unique Then
colNumbers.Remove n
End If
Next x
End With
Set colNumbers = Nothing
RandomNumbers = arrNums
Exit Function
LocalError:
'Justin (just in case)
RandomNumbers = ""
End Function

Public Function RandomNumber(Upper As Integer, _
Lower As Integer) As Integer
'Generates a Random Number BETWEEN the LOWER and UPPER values
Randomize
RandomNumber = Int((Upper - Lower + 1) * Rnd + Lower)
End Function
Questa funzione genera una matrice di numeri casuali compresi tra un minimo ed massimo predefiniti. E' stata aggiunta poi la variabile Unique per decidere se tale matrice deve essere di numeri univoci (True) oppure gli stessi possono essere ripetuti (False). Ecco un esempio di come richiamare la funzione: x = RandomNumbers(100, 1, 20, True)
For n = LBound(x) To UBound(x)
      Debug.Print x(n);
Next n
In questo caso si stampa il risultato nella finestra di debug, ma può essere sfruttato in qualunque modo.

Salvare immagini i formato JPG utilizzando GDI+

Molto spesso si ha la necessità, anche per motivi di spazio, di salvare le immagini in formato JPG. Questa procedura, senza l'utilizzo di dll aggiuntive, sfrutta le chiamate alle librerie GDI+, presenti nei sistemi XP o comunque di ultima generazione, per effettuare questa operazione.

In un modulo dichiariamo la seguente funzione: Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Type GdiplusStartupInput
     GdiplusVersion As Long
     DebugEventCallback As Long
     SuppressBackgroundThread As Long
     SuppressExternalCodecs As Long
End Type

Private Type EncoderParameter
     GUID As GUID
     NumberOfValues As Long
     type As Long
     Value As Long
End Type

Private Type EncoderParameters
     Count As Long
     Parameter As EncoderParameter
End Type

Private Declare Function GdiplusStartup Lib &quot;GDIPlus&quot; ( token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib &quot;GDIPlus&quot; ( ByVal token As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib &quot;GDIPlus&quot; ( ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib &quot;GDIPlus&quot; ( ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib &quot;GDIPlus&quot; ( ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib &quot;ole32&quot; ( ByVal str As Long, id As GUID) As Long

' Salva in JPG

Public Sub SaveJPG( ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 80)
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long

' Inizializza GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI)

If lRes = 0 Then

' Crea la bitmap GDI+  dall'handle dell'immagine
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)

If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters

' Inizializza la codifica GUID
CLSIDFromString StrPtr(&quot;{557CF401-1A04-11D3-9A73-0000F81EF32E}&quot;), tJpgEncoder

' Inizializza la codifica dei parametri
tParams.Count = 1
With tParams.Parameter ' Qualità
' Imposta la Qualità GUID
CLSIDFromString StrPtr(&quot;{1D5BE4B5-FA4A-452D-9CDD-5DB3505E7EB}&quot;), .GUID
.NumberOfValues = 1
.type = 1
.Value = VarPtr(quality)
End With

' Salva l'immagine
lRes = GdipSaveImageToFile( lBitmap, StrPtr(filename), tJpgEncoder, tParams)

' Elimina la bitmap
GdipDisposeImage lBitmap

End If
' Chiude il processo GDI+
GdiplusShutdown lGDIP

End If

If lRes Then
     Err.Raise 5, , &quot;Non posso salvare l'immagine. Errore GDI+:&quot; &amp; lRes
End If

End Sub
Per salvare infine l'immagine in formato JPG è sufficiente richiamare la seguente routine (dove Picture1 sarà il controllo picture nel quale è stata caricata l'immagine e può essere visibile o nascosto): SaveJPG Picture1, "C:\Percorso\Nomefile.jpg", 80 L'ultimo parametro è la qualità dell'immagine, da non confondersi con la compressione che non è parametrizzabile.
Questa procedura si ricorda è valida su sistemi con OS Windows XP o comunque che abbiano installate le liberie GDI+.

Utilizzare TransferDatabase in presenza di password

TransferDatabase è un comando spesso utilizzato sia in VBA di Access che in VB per importare o esportare tabelle da un database all'altro. Questa semplice procedura presenta delle difficoltà (come riscontrato da Microsoft stessa) se il database di origine è protetto da password. Per ovviare a tale problema la procedura da eseguire è quella di creare una nuova istanza di Access, aprendo il database interessato e passandogli la relativa password, per poi eseguire l'operazione voluta.

Nota: se si utilizza da Visual Basic inserire il riferimento a Microsoft Access 9 (o quello installato).

In un modulo dichiariamo la seguente funzione: Public Function BackupTabelle(DBorigine As String, dbDestinazione As String, dbPassword As String, tabellaOrigine As String, tabellaDestinazione As String)
Dim oAcc As Access.Application
Dim td As Integer

  Set oAcc = New Access.Application
  Set db = oAcc.DBEngine.OpenDatabase(DBorigine, False, False, &quot;;PWD=&quot; &amp; dbPassword)
 oAcc.OpenCurrentDatabase DBorigine
 oAcc.DoCmd.TransferDatabase acExport, &quot;Microsoft Access&quot;, dbDestinazione, acTable, tabellaOrigine, tabellaDestinazione, False, False
  db.Close
  Set db = Nothing
End Function
Per rilevare l'indice selezionato di una matrice di Option Button sarà sufficiente dichiarare nella nostra routine: Call BackupTabelle("C:\Percorso\origine.mdb", "C:\Percorso\destinazione.mdb", "password", "Nometabella", "Nometabella") A questo punto la procedura viene eseguita senza intoppi.

Rilevare l'indice selezionato di una matrice di Option button

Succede molto spesso che si debbano creare dei form con diverse matrici di Option Button o Check Button per dar modo all'utente di selezionare diverse opzioni all'interno di un proprio programma. Solitamente si rileva tale condizione con un ciclo For... Next. Descriviamo una semplice routine per evitare di scrivere decine di righe di codice.

In un modulo dichiariamo la seguente funzione: Public Function CeckOption(Opt As OptionButton) As Long
   Dim c As Long
   For c = 0 To Opt.Count
         If Opt(c).Value = True Then CeckOption = c: Exit For
   Next c
End Function
Per rilevare l'indice selezionato di una matrice di Option Button sarà sufficiente dichiarare nella nostra routine: Call CeckOption(Opt) dove Opt sarà il nome della matrice di controlli interessata (Opt(0), Opt(1)....).
Ovviamente con poche modifiche tale routine sarà valida anche per una matrice di Check Button.

Salvare le impostazioni di un programma

Per salvare le impostazioni di una applicazione esistono sostanzialmente tre sistemi:
1) Scrivere tali valori in un file .INI
2) Scrivere in un file di testo (.txt, o qualsiasi estensione)
3) Scrivere nel registro di configurazione di Windows.

Ovviamente il terzo sistema è quello più frequentemente usato da chi programma in VB, anche perchè supportato da alcuni semplici omandi già inglobati in Visual Basic. Si tratta dei comandi: GetSetting, SaveSetting,DeleteSetting, il cui costrutto è: GetSetting(appname, section, key[, default]) - legge dal registro
SaveSetting(appname, section, key, setting) - scrive nel registro
DeleteSetting(appname, section[, key]) - elimina le voci di registro
dove appname è il nome del progetto o dell'applicazione (es. "MioProgramma")
section è il nome della sezione (es. "Impostazioni")
key è il nome della chiave (es. "Posizione")
default (opzionale) è il valore predefinito.
Nella guida in linea di Visual Basic potrai trovare gli esempi.

Altro sistema è quello di scrivere file .INI (era molto usato con Windows 3.1).
In questo caso occorre dichiarare in un modulo le relative funzioni delle API di Windows che leggono e scrivono nei file INI: Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
(queste scrivono in un file .ini personale, mentre se usi GetProfileSting e WriteProfileString leggi e scrivi nel file Win.ini).

lpApplicationName è la sezione del file INI (quelle scritte tra parentesi quadre)
lpKeyName è la chiave (quello che sta davanti al segno =)
lpDefault è l'eventuale valore di default ("" se vuoto)
lpReturnedString è il valore restituito dalla lettura (quello che sta dopo =)
lpFileName è il nome e percorso del file INI (es. App.path &\"miofile.ini")

In scrittura è sufficiente scrivere la funzione nel seguente modo: i% = WritePrivateProfileString("Impostazioni", "Posizione", "35,42", "Miofile.ini") (se non si specifica il percorso Miofile.ini viene scritto nella directory C:\WINDOWS)

In lettura occorre convertire il valore integer in string, come nell'esempio:
Dim R1 As String
R1 = Space$(31)
num = Trim(Str(n))
i% = GetPrivateProfileString("Impostazioni", "Posizione", "", R1, 30, "Miofile.ini")
R1 = Left$(R1, i%)
R1 = LTrim$(RTrim$(R1))
(30 è la massima lunghezza della stringa - lo puoi decidere tu)

Ultimo sistema è quello di usare il vecchio metodo Input/Output in un file di testo.
In scrittura:
(suupongo di avere due listbox L1 e L2 e voglio registrare affiancati i valori con loi stesso indice) Open App.Path + "\lista.dat" For Output As #1
R = 0: S = L1.ListCount - 1
Do While R <= S
L1.ListIndex = R
Write #1, L1, L2
R = R + 1
Loop
Close #1
In lettura: Open App.Path + "\miofile.dat" For Input As #1
Do While Not EOF(1)
Input #1, A, B
L1.AddItem A
L2.AddItem B
Loop
Close #1
dove A, B sono i valori restituiti, che faccio scrivere separati nelle due listbox L1,L2.

Il problema dell'apice con SQL

Supponiamo di avere un database contenente delle tabelle tra cui una chiamata DIPENDENTI contenente diversi campi. Uno di questi campi si chiama COGNOME, dove, naturalmente, sono memorizzati i cognomi dei dipendenti di una ditta X. Se eseguiamo una query (utilizzando un Data Control) utilizzando il seguente metodo: Dim StringaDaRicercare as String
StringaDaRicercare = Text1.Text
Data1.RecordSource = "Select * from Dipendenti where _
Cognome = '" & StringaDaRicercare & "';"
Data1.Refresh
e nel controllo Text1.Text inseriamo un cognome che ha nel suo contenuto degli apostrofi, ad esempio - D'Alessandro - , otterremo un errore, in quanto l'apostrofo presente tra la lettera D e la lettera A del cognome viene considerato come parte dell'istruzione della query, e non come elemento della stringa da ricercare. Per eseguire quindi correttamente la query, bisogna sostituire il singolo apostrofo in un consecuzione di due apostrofi. Quindi prima di passare una stringa ad una query, possiamo processarla con la seguente funzione, che scansiona la stringa passatagli come argomento ricercando in essa gli apostrofi, sostituendoli in tal caso con una consecuzione doppia di Chr$(39): Dim StringaDaRicercare as String
Function StringaPerQuery(stringa As String) As String
Dim lun_str As Integer, k0 As Long, k1 As Integer
Dim car As String, strbuff As String
k0 = InStr(stringa, Chr$(39))
If k0 > 0 Then
strbuff = Mid$(stringa, 1, k0 - 1)
lun_str = Len(stringa)
For k1 = k0 To lun_str
car = Mid$(stringa, k1, 1)
If car = Chr$(39) Then car = Chr$(39) & Chr$(39)
strbuff = strbuff & car
Next k1
End If
StringaPerQuery = strbuff
End Function
Da richiamare come segue: Dim StringaDaRicercare as String
StringaDaRicercare = StringaPerQuery (Text1.Text) 'chiama la funzione...
Data1.RecordSource = "Select * from Dipendenti where _
Cognome = '" & StringaDaRicercare & "'"
Data1.Refresh

Associare un'estensione ad un programma

Per associare un'estensione di file ad un determinato programma, occorre creare le opportune voci nel registro di configurazione.
Prendiamo ad esempio:
si deve creare in HKEY_CLASSES_ROOT due distinte voci, una ".PIP" e una "File PIPPO" Public Function Registra (strKey As String, strValueName As String, strData As String)
  Dim lResult As Long
  Dim hKey As Long

  lResult = OSRegCreateKey(HKEY_CLASSES_ROOT, strKey, hKey)
  If lResult = ERROR_SUCCESS Then
  lResult = OSRegSetValueEx(hKey, strValueName, 0&amp;, REG_SZ, ByVal strData, Len(strData) + 1)
          lResult = OSRegCloseKey(hKey)
  End If
End Function
Tramite questa semplice funzione sarà possibile registrare la nostra estensione ed associarla al programma voluto nel seguente modo: Registra ".PIP", "", "PIPPO File"
Registra "PIPPO File\shell\open\command", "", App.Path & "\pippo.exe %1"
Registra "PIPPO File\DefaultIcon", "", App.Path & "\pippo.exe,0"
La prima riga associa l'eseguibile Pippo.exe ai files .PIP, mentre la seconda associa l'icona per i files .PIP

Per quanto riguarda il lancio automatico da parte della tua applicazione dei file con una determinata estensione (es: .PIP) è necessario che su Form_Load la nostra applicazione vada a leggere l'eventuale riga di comando: If Command &lt;&gt; &quot;&quot; Then
   'fai eseguire l'operazione voluta
End If

Verificare i duplicati in un combobox

Per verificare di non caricare eventuali nomi duplicati in un combobox: Function CheckDup(MyValue As Variant, MyCombo As ComboBox) As Boolean
  For i = 0 To MyCombo.ListCount - 1
   If MyCombo.List(i) = MyValue Then
   CheckDup = True
   Exit Function
   End If
  Next i
  CheckDup = False
End Function 

Verificare se una connessione è in corso

Questo modulo racchiude una semplice funzione per verificare se una connessione ad Internet è in corso oppure no. Public Declare Function RasEnumConnections Lib &quot;RasApi32.dll&quot; Alias &quot;RasEnumConnectionsA&quot; (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long

Public Declare Function RasGetConnectStatus Lib &quot;RasApi32.dll&quot; Alias &quot;RasGetConnectStatusA&quot; (ByVal hRasCon As Long, lpStatus As Any) As Long
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32

Public Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type


Public Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Public Function IsConnected() As Boolean

Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95

TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize

RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)

If RetVal &lt;&gt; 0 Then
     MsgBox &quot;ERROR&quot;
     Exit Function
End If

Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)

If Tstatus.RasConnState = &amp;H2000 Then
     IsConnected = True
Else
     IsConnected = False
End If
End Function

Verificare se un file esiste

Molto spesso è necessario verificare se un determinato file è presente o meno nel sistema. Ecco una semplice routine di verifica: Public Sub VerifyFile(FileName As String)
On Error Resume Next
'Apre lo specifico file
Open FileName For Input As #1
'Gestione dell'eventuale errore
If Err Then
MsgBox ("Il file " & FileName & " non è stato trovato.")
Exit Sub
End If
Close #1
End Sub
All'interno del programma sarà poi sufficiente richiamare la funzione dichiarando il file da ricercare: Call VerifyFile("MyFile.txt")

Disabilitare il Multitasking in Windows 98

Per disabilitare la combinazione di tasti ALT+TAB (o il corrispondente tasto Win95)occorre dichiarare la seguente funzione e costante: Private Declare Function SystemParametersInfo Lib "user32" _
Alias "SystemParametersInfoA" (ByVal uAction As Long, _
ByVal uParam As Long, lpvParam As Any, _
ByVal fuWinIni As Long) As Long

Private Const SPI_SCREENSAVERRUNNING = 97
Per disabilitare il multitasking è sufficiente dichiarare: Dim ret As Integer
Dim pOld As Boolean
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
Per abilitare nuovamente il multitasking dichiarare: Dim ret As Integer
Dim pOld As Boolean
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)

Aggiungere un collegamento sul desktop in Win 98

E' semplice creare un collegamento del proprio programma sul desktop.Il segreto per creare un collegamento con Visual Basic è in questadichiarazione del VB4 setup kit Declare Function fCreateShellLink Lib "STKIT432.DLL" _
(ByVal lpstrFolderName as String ,ByVal lpstrLinkName as String _
ByVal lpstrLinkPath as String ,ByVal lpstrLinkArgs as String ) As Long
Il primo parametro chiede dove piazzare il collegamento (shortcut) relativo alla cartella dei programmi del Menu di Avvio. Il secondo parametro è il name o il testo che appare con il collegamento. Di seguito viene il percorso del file; il parametro finale supporta ogni argomento. Pertanto, per piazzare il collegamento sul desktop, inserisci questo codice: iLong = fCreateShellLink("..\..\Desktop", "Collegamento a Program", "C:\Path\Program.exe","")

Chiamata automatica all'Accesso Remoto in Windows 98

Questa porzione di codice si usa per lanciare la connessione a Internet da una applicazione VB in Windows 98: Private Sub StartConnection()
Dim X
X = Shell("rundll32.exe rnaui.dll,RnaDial " & Nome_Connessione, 1)
DoEvents
SendKeys "{enter}", True
DoEvents
End Sub
dove Nome_Connessione è il nome che avete dato alla vostra connessione all'Accesso remoto.

Convertire un nome lungo di file in formato DOS

La funzione sottostante converte i nomi di file o do path lunghi in modalità DOS (non più di 8 caratteri): Declare Function GetShortPathName Lib "KERNEL32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Function GetShortFileName(ByVal FileName As String) As String
Dim rc As Long
Dim ShortPath As String
Const PATH_LEN& = 164
ShortPath = String$(PATH_LEN + 1, 0)
rc = GetShortPathName(FileName, ShortPath, PATH_LEN)
GetShortFileName = Left$(ShortPath, rc)
End Function
Dove FileName é il path o il nome del file da convertire e ritorna un nome DOS compatibile, pertanto si dichiarerà: Dim Lblshort, LongName as string
Lblshort = GetShortFileName(LongName)