Realizzazione di un sistema multiprocesso in VB6
a cura di Rodolfo Calzetti e Maurizio Brasca (requisiti: Conoscenza Programmazione Orientata agli Oggetti)

Una semplice esperienza mostra che la chiamata ad un metodo di un oggetto Activex blocca tutti i processi del programma chiamante ivi inclusi gli eventi di un timer.
Ciò potrebbe non essere ammissibile nei casi in cui il processo chiamato impieghi del tempo per essere portato a termine.
E non rappresenta una soluzione quella di rinunciare agli Activex includendo tutto il codice sorgente in un eseguibile standard, poiché certe funzionalità potrebbero essere contenute in componenti Activex forniti da altri.

Ecco un esempio di programma Visual Basic mono processo, per il quale abbiamo utilizzato ADO come componente Activex nel quale la chiamata di un metodo
blocca gli eventi di un timer (si suppone che la query in esso effettuata abbia una durata sensibile):

Option Explicit
Dim I As Double
  
Private Sub Command1_Click()
  Dim DbConn As ADODB.Connection
  Dim Rec As ADODB.Recordset
  Command1.Enabled = False
  Set DbConn = New ADODB.Connection
  Set Rec = New ADODB.Recordset
  DbConn.Open "Provider=SQLOLEDB;Data Source=SVILUPPO;Initial" + _
              "Catalog=MioDB;User ID=sa;Password=;"
  Rec.Open "Select * from MiaTabella where Campo='Pippo'", DbConn
  Rec.Close
  Set Rec = Nothing
  Set DbConn = Nothing
  Command1.Enabled = True
  End Sub

Private Sub Timer1_Timer()
  I = I + 1
  Label1 = I
End Sub

Per ovviare a questi inconvenienti ci siamo avvalsi di uno schema che, più in generale, permette di tenere sotto controllo più programmi come se fossero un'entità sola mediante un eseguibile Activex che agisca da collante.
L'uso di più eseguibili è dettato dalla necessità di avere altri processi VB6 disponibili, qualora il primo sia bloccato dall'esecuzione di una chiamata a un metodo di un oggetto Activex. L'eseguibile Activex "collante" è il metodo più conveniente per far comunicare tra loro eseguibili separati.

Scendendo maggiormente nel dettaglio, supponiamo che E sia il nostro programma mono processo iniziale che implementi delle funzioni Funz1, Funz2, ...
Per poter trasformare E in un programma multithreading conviene fare prima una operazione "preparatoria" per rendere lo schema che stiamo proponendo più universale e versatile.
Si implementa una funzione ChiamataProcesso che abbia come parametri due documenti in formato XML, chiamiamoli XmlDocIn (documento input) e XmlDocOut (documento output).

XmlDocIn potrebbe avere una struttura del tipo:

<xml><parametri Funzione="Funz3" Arg1="5" Arg2="Pippo" /></xml>

Nel documento XmlDocIn si definisce un parametro Funzione assegnandogli il nome convenzionale (alias) indicante una delle funzioni FunzK.
Il documento XmlDocIn specifica anche i parametri da passare alla funzione.
Nel corpo della funzione ChiamataProcesso una Select Case fatta sulla variabile Funzione effettuerà una chiamata alla FunzK opportuna.

Public Sub ChiamataProcesso(XmlDocIn as DOMDocument30, XmlDocOut as DOMDocument30)

  Dim Funzione As String
  Dim Arg1 As Integer
  Dim Arg2 As String
  Funzione = XmlDocIn
  Select Case Funzione
    Case "Funz1": Funz1 Arg1, Arg2
    Case "Funz2": Funz2 Arg1, Arg2
  End Select
End Sub

Con ciò abbiamo un'interfaccia standard per poter attivare le funzionalità del nostro programma.

Il secondo passo sarà quello di prendere il codice della funzione ChiamataProcesso e di tutte le FunzK e farne un programma T a sé stante.
In particolare ChiamataProcesso diventerà un metodo pubblico, che chiameremo Run, del form F di avvio del programma T stesso.

Supponiamo anche di prevedere di lanciare un determinato numero n di volte T e di avere, quindi, di esso n istanze T1, T2, ..., Tn di T.

Il terzo passo sarà quello di fare un eseguibile Activex A che implementa due classi pubbliche: ClasseGlobale e ClasseServizio.
In qualche modo legheremo un oggetto G di tipo ClasseGlobale al nostro eseguibile iniziale E e un oggetto S (S1, S2, ..., Sn) di tipo ClasseServizio a ciascun form F delle istanze di T (T1, T2, ..., Tn).

Riassumendo:
Sia E un eseguibile standard il quale ha la necessità di effettuare chiamate a più funzioni e che esse siano eseguite contemporaneamente in processi separati.
L'implementazione effettiva delle funzioni è fatta in n eseguibili standard T1, T2, ..., Tn lanciati come n istanze di un programma T.
L'insieme dei T1, T2, ..., Tn rappresenta il nostro pool di thread.
L'esecuzione di una funzione si effettua chiamando un metodo pubblico del form F di uno degli eseguibili T (F.Run).

Un eseguibile Activex G implementa due classi pubbliche:

Il funzionamento dello schema è il seguente:

A questo punto per chiamare una funzione in un processo separato T dovremo:

  1. Farci rilasciare un puntatore t a un thread libero mediante un metodo G.AllocaThread
    Potrebbe sembrare inutile la conoscenza di tale puntatore, ma poiché l'esito e i dati in uscita dovranno essere restituiti mediante un evento di fine funzione
    (G_FineProcesso) dobbiamo avere questa informazione per distinguere un ritorno da un altro.
  2. Alzare un flag semaforo Attesa(t) (da abbassarsi al termine dell'evento FineProcesso)
  3. Chiamare un metodo G.Attivazione a cui si passi il puntatore al thread (t) e i parametri di attivazione della funzione
    1. Nella funzione G.Attivazione si chiama il metodo F.Run del form di interfaccia appartentente al processo Tt e tramite il metodo stesso si passano i parametri per l'attivazione del servizio
    2. Il metodo F.Run abilita un timer con la proprietà Interval settata a un millesimo di secondo e si memorizzano i parametri di attivazione. Questo è un
      punto cruciale poichè la F.Run che bloccherebbe i processi di E dura pochissimo; la funzione effettiva viene chiamata dall'evento timer che, asincrono, ci permette di disaccoppiare i processi di E da quelli di T.
    3. Nell'evento timer si disabilita il timer stesso e si chiama la funzione finale. Al termine si chiama il metodo G.ScatenaFineProcesso nel quale si esegue
      la RaiseEvent dell'evento FineProcesso in E
    4. Nell'evento FineProcesso si memorizzano i dati passati e si abbassa il flag semaforo Attesa(t)
  4. Attendere in un loop (con DoEvents) che il flag Attesa(t) sia basso
  5. Reperire la variabile di ritorno passata via evento FineProcesso

Queste operazioni possono essere incapsulate in una funzione di E.

I codici di esempio

La form del nostro eseguibile di esempio consta di due pulsanti (uno per funzione) e d'una label nella quale un Timer si occupa di scrivere il momento corrente, al puro scopo didattico di mostrare che nessun processo 'blocca' l'esecuzione dell'eseguibile principale (né di alcun altro).
Il codice iniziale di questa form effettua la dichiarazione delle variabili di modulo e la loro inizializzazione.

Option Explicit


Dim WithEvents G As ClasseGlobale

Dim FlagAttesa() As Boolean
Dim VettXmlOut() As String


Private Sub Form_Load()

     Set G = New ClasseGlobale
     G.Inizializza


     ReDim FlagAttesa(G.MaxProc)
     ReDim VettXmlOut(G.MaxProc)

End Sub

L'oggetto G viene istanziato e si inizializza:

Option Explicit

Public ObjGlobale         As ClasseGlobale
Public MaxProcessi        As Integer
Public ExeServizio        As String
Public AllocazioneServizi As String


Type StructServizio
     ObjForm     As Object
     ObjServizio As ClasseServizio
End Type


Public VettServizi() As StructServizio
 
Private Sub Class_Initialize()

     MaxProcessi = 3
     ExeServizio = App.Path + "\thread.exe"
     
     ReDim VettServizi(1 To MaxProcessi)
     
     AllocazioneServizi = String$(MaxProcessi, "N")
     
End Sub

Ed attiva n processi (3), attendendo che ciascuno di essi sia caricato, registrato e pronto ad agire

Public Sub Inizializza()

     Dim I As Long
     
     Set ObjGlobale = Me
     
     For I = 1 To UBound(VettServizi)
     
          Shell ExeServizio + Str$(I), vbNormalNoFocus
          
          Do
               DoEvents
          Loop While VettServizi(I).ObjForm Is Nothing
          
          Do
               DoEvents
          Loop Until VettServizi(I).ObjForm.Pronto
               
     Next I
     
End Sub

L'applicazione 'Processo' contiene una Shape circolare (semaforo verde-rosso) ed il Timer per eseguire le funzioni richieste, simulando un più o meno lungo tempo di elaborazione.
Ciascuno dei processi istanzia un oggetto ClasseServizio, si registra e si dichiara 'pronto'.

Option Explicit


Public Indice As Long
Public Pronto As Boolean


Dim S As Object
Dim InputXmlIn As String


Private Sub Form_Load()

     Indice = Val(Command$)
     
     Set S = CreateObject("CollanteActiveX.ClasseServizio")
     
     S.Registrazione Me
     
     Me.Pronto = True
     
     Shape1.FillColor = vbGreen

End Sub

L'oggetto S riceve l'indice del processo cui appartiene, ed imposta i membri della relativa struttura StructServizio nel vettore dei servizi creato nell'oggetto G. 

Option Explicit

Dim IndiceProcesso As Long

Public Sub Registrazione(Frm As Object)

     IndiceProcesso = Frm.Indice
     
     Set VettServizi(IndiceProcesso).ObjForm = Frm
     Set VettServizi(IndiceProcesso).ObjServizio = Me
     
End Sub

Ciascuno dei due pulsanti dell'applicazione E chiama la funzione ChiamataProcesso passandogli i parametri XmlDocIn e XmlDocOut (qui indicati come semplici stringhe); ricevuto di nuovo il controllo del flusso di programma, espone in una MessageBox il risultato.

Private Sub BtFunzione1_Click()

     Dim Buffer As String
     
     ChiamataProcesso "Stringa1", Buffer
     
     MsgBox Buffer

End Sub

Private Sub BtFunzione2_Click()

     Dim Buffer As String
     
     ChiamataProcesso "Stringa2", Buffer
     
     MsgBox Buffer

End Sub

La funzione ChiamataProcesso alloca il processo, alza il flag di attesa, attiva il processo, attende che il flag venga abbassato, ...

Public Sub ChiamataProcesso(XmlDocIn As String, XmlDocOut As String)

     Dim PtThread As Long
     
     PtThread = G.AllocaThread
     
     FlagAttesa(PtThread) = True
     
     G.AttivaProcesso PtThread, XmlDocIn
     
     Do
          DoEvents
     Loop Until FlagAttesa(PtThread) = False
     
     XmlDocOut = VettXmlOut(PtThread)
     
     G.RilasciaThread PtThread

End Sub

Il metodo AllocaThread cerca tra i processi in esecuzione il primo libero e ne restituisce l'indice. (nota)

Public Function AllocaThread() As Long
     
     Dim PtThread As Long
     
     Do
          PtThread = InStr(AllocazioneServizi, "N")
          DoEvents
     Loop Until PtThread > 0
     
     Mid$(AllocazioneServizi, PtThread) = "S"
     
     AllocaThread = PtThread
     
End Function

Il metodo AttivaProcesso passa il parametro di ingresso al processo indicato, chiamandone il metodo Run che attiva il Timer del processo cui appartiene, nel cui evento Timer viene effettivamente svolta l'operazione richiesta dall'eseguibile E. Nell'esempio, ci si limita a fare 'semaforo rosso' ("sono occupato!") e ad attendere un ipotetico tempo di esecuzione a seconda della funzk da eseguire.
Alla fine, viene impostato il risultato da restituire, tramite il metodo FineServizio dell'oggetto S, e il semaforo 'torna verde' ("sono di nuovo a disposizione").

Private Sub Timer1_Timer()

     Dim StrDocOut As String
     Dim T As Single
     
     Shape1.FillColor = vbRed
     
     Timer1.Enabled = False
     
     Select Case InputXmlIn
          
          Case "Stringa1"
               
               T = Timer
     
               Do
                    DoEvents
               Loop Until Abs(Timer - T) > 5
               
               StrDocOut = "Prima risposta"
     
          Case "Stringa2"
               
               T = Timer
     
               Do
                    DoEvents
               Loop Until Abs(Timer - T) > 10
               
               StrDocOut = "Seconda risposta"
               
          Case Else
               StrDocOut = "Comando sconosciuto"
     
     End Select
     
     S.FineServizio StrDocOut
     
     Shape1.FillColor = vbGreen

End Sub

Il metodo FineServizio dell'oggetto servizio 'riferisce' quanto di competenza al proprio oggetto ClasseGlobale:

Public Sub FineServizio(StrDocOut As String)

     ObjGlobale.ScatenaFineServizio IndiceProcesso, StrDocOut

End Sub

Il metodo ScatenaFineServizio dell'oggetto G scatena l'evento fine del servizio indicato passando anche il risultato.

Friend Sub ScatenaFineServizio(PtThread As Long, StrXmlOut As String)

     RaiseEvent FineServizio(PtThread, StrXmlOut)

End Sub

Nell'eseguibile E, tale evento permette di impostare il relativo elemento del vettore risultati e di abbassare il flag di attesa.

Private Sub G_FineServizio(PtThread As Long, StrXmlOut As String)

     VettXmlOut(PtThread) = StrXmlOut
     FlagAttesa(PtThread) = False

End Sub

... A questo punto, la funzione ChiamataProcesso riceve il risultato del processo attivato, rilascia il processo, che cosė č pronto a ricevere un altro eventuale input.

Public Sub RilasciaThread(PtThread As Long)

     Mid$(AllocazioneServizi, PtThread) = "N"
End Sub

Resta ancora da dire che, ovviamente, la chiusura dell'applicazione E si occupa di annientare l'oggetto G istanziato e tramite esso i processi T avviati.

I sorgenti dei progetti relativi all'articolo sono scaricabili dall'Area Download. (nota)

Gli autori
Rodolfo Calzetti coordina il tema di sviluppo software di Centro Data Srl; laureato in matematica, ha esperienza di programmazione avanzata in VB e in C; ha realizzato diverse soluzioni Activex.
Maurizio Brasca è il responsabile di prodotto di Centro Data Srl, di cui è uno dei soci; si occupa della progettazione del software in ambito finanziario (tesoreria, titoli, ecc.).
Centro Data Srl è attiva nel software per la gestione finanziaria delle imprese, in particolare nella gestione della tesoreria e del portafoglio titoli.

Centro Data Srl
Via Pedretti 1/B
20095 Cusano Milanino (MI)
Tel. 02/6134635
Fax 02/66400818

Nota del 22/09/03:
Riguardando il codice vi segnalo un errore: se le richieste superano i thread disponibili il programma principale rimane bloccato in una attesa infinita. Sostituire in globale.cls il codice

  Public Function AllocaThread() As Long
 
    Dim PtThread As Long
 
    Do
      PtThread = InStr(AllocazioneServizi, "N")
      DoEvents
    Loop Until PtThread > 0
 
    Mid$(AllocazioneServizi, PtThread) = "S"
 
    AllocaThread = PtThread
 
  End Function

con il codice:

  Public Function AllocaThread() As Long
 
    Dim PtThread As Long
 
    PtThread = InStr(AllocazioneServizi, "N")
 
    If PtThread > 0 Then
      Mid$(AllocazioneServizi, PtThread) = "S"
    End If
 
    AllocaThread = PtThread
 
  End Function

Il chiamante deve poi testare che AllocaThread() dia risultato maggiore di zero poiché altrimenti significa che il sistema non è in grado di soddisfare la richiesta.