Oppure

Loading
05/01/12 13:04
WillyVB
Rieccomi qui con un nuovo quesito, sono riuscito (sbirciando molto sulla rete) a strutturare una ricerca che vada a cercare la parola ricercata in ogni parola contenuta nella stringa ricercata.

esempio:
Parola da ricercare= "Prova"
Stringa su cui cercare= "Questa è una prova"

il programma suddivide automaticamente la stringa in questo modo= |Questa|è|una|prova| quindi non fa un controllo bensì ne fa 4 inoltre non ricerca la frase esatta bensì l'inizio quindi se io nella stringa da ricercare avessi avuto "provaova" al posto di "prova" avrebbe comunque inserito il record nella listview da me creata.

Ora il problema è applicare una ricerca su più parametri, titolo, anno, categoria ect

avevo pensato di usare delle flags, ho impostato in vari modi il codice e ho riscontrato loop infiniti, controlli solo sul primo records, ed altri problemini. vi rilascio di seguito il codice che ho trovato sulla rete per la ricerca, riadattato da me per il mio programma.


Funzione di ricerca:
Private Function TrovaParola2(Str1, Str2, FLAG) As String
  'Str1 = Stringa che contiene un testo o un campo Memo (in Access)'
 'Str2 = parola da trovare'

 Dim Pos1, Pos2, App, k, LenStr As Integer
 Dim StrParte As String

 'Inizzializza le variabili'
  App = 0
  
  FLAG = False
  
  Pos1 = 0 ' Punta a una spazio Chr(32)
  Pos2 = 0 ' Punta sempre allo spazio successivo di Pos1
 'Parola trovata provvisoria e confrontata con Str2
  StrParte = " "
 'Elimina eventuali spazi all'inizio e alla fine, dei parametri passati
  Str1 = Trim(Str1)
  Str2 = Trim(Str2)


 'Calcola la lunghezza del Testo. Len(Str1) Si poteva mettere nel For, ma è più lento
 'perchè ad ogni ciclo deve ricalcolare la lunghezza del testo
 LenStr = Len(Str1)
 'Qusto ciclo elimina tutti i caratteri di ritorno a capo(Chr(13)
 'e il carattere di linea nuova Chr(10) e li sotitusce con uno spazio " "
 For k = 1 To LenStr
  If Mid(Str1, k, 1) = Chr(13) Or Mid(Str1, k, 1) = Chr(10) Then
     Mid(Str1, k, 1) = " "
  End If
 Next
 '=============== Inizio Ricerca =========================
 Do
  If App = 0 Then
    Pos1 = InStr(1, Str1, Chr(32))             'trova la posizione del primo spazio.'
    If Pos1 = 0 Then Pos1 = Len(Str1)          'Se Pos1 = 0, la stringa ha una sola parola.
    StrParte = Trim(Left(Str1, Pos1))          'Salva la parola dall'inizio stringa, fino al primo spazio.
    App = 1                                    'fa in modo di venire qui solo la prima volta.
  Else
    Pos2 = InStr(Pos1 + 1, Str1, Chr(32))      'trova la posizione dei successivi spazi.
    If Pos2 = 0 Then Pos2 = Len(Str1)          'Se Pos2 = 0, ha letto l'ultima parola.
    LenStr = (Pos2 - Pos1)                     'determina la lunghezza della parola.
    If LenStr = 0 Then Exit Do                 'è a fine file esce dal ciclo Do.
    StrParte = Trim(Mid(Str1, Pos1 + 1, LenStr)) 'Salva la parola.
    Pos1 = Pos2                                'Pos1 punta all'ultimo spazio trovato.
  End If
   
  If Str2 = StrParte Then                      'confronta la parola da ricercare con l'ultima trovata
    FLAG = True
    Exit Do                                    'esce dal ciclo Do'
  End If
 Loop                                           'ritorna al Do e riesegue il ciclo
End Function


Dichiarazione variabili:
Dim TitX, RegiaX, DistrX, ProdX, AnnoUX, GenX, Gen, CheckVet(), FindVet() As String
Dim N, NE, i As Integer
Dim F1, F2, F3, F4, F5, F6, FVet() As Boolean
Dim SchedaFilm As Film


Private Sub Cerca:
Private Sub cmdCerca_Click()
FrmVisList.ListFilm.ListItems.Clear

i = 0
NE = 0

ReDim CheckVet(i), FindVet(i), FVet(i)

TitX = txtTitX
RegiaX = txtRegiaX
DistrX = txtDistrX
ProdX = txtProdX
AnnoUX = txtAnnoUX
GenX = comboGenX

If Option1 = True Then
    Open App.Path & "\Archivi\Indice" For Input As #1
        Do Until EOF(1)
            Input #1, Gen
            Open App.Path & "\Archivi\" & Gen For Random As #2 Len = Len(SchedaFilm)
            N = 0
                Do Until EOF(2)
                    N = N + 1
                    Get #2, N, SchedaFilm
                    Call TrovaParola(SchedaFilm.Tit, TitX)
                Loop
            Close #2
        Loop
    Close #1
End If

If Option2 = True Then
    If TitX <> "" Then
        i = i + 1
        ReDim Preserve CheckVet(i), FindVet(i), FVet(i)
        CheckVet(i) = SchedaFilm.Tit
        FindVet(i) = TitX
        FVet(i) = F1
        NE = NE + 1
    End If
                
    If RegiaX <> "" Then
        i = i + 1
        ReDim Preserve CheckVet(i), FindVet(i), FVet(i)
        CheckVet(i) = SchedaFilm.Regia
        FindVet(i) = RegiaX
        FVet(i) = F2
        NE = NE + 1
    End If
                
    If DistrX <> "" Then
        i = i + 1
        ReDim Preserve CheckVet(i), FindVet(i), FVet(i)
        CheckVet(i) = SchedaFilm.Distr
        FindVet(i) = DistrX
        FVet(i) = F3
        NE = NE + 1
    End If
                
    If ProdX <> "" Then
        i = i + 1
        ReDim Preserve CheckVet(i), FindVet(i), FVet(i)
        CheckVet(i) = SchedaFilm.Prod
        FindVet(i) = ProdX
        FVet(i) = F4
        NE = NE + 1
    End If
                
    If AnnoUX <> "" Then
        i = i + 1
        ReDim Preserve CheckVet(i), FindVet(i), FVet(i)
        CheckVet(i) = SchedaFilm.AnnoU
        FindVet(i) = AnnoUX
        FVet(i) = F5
        NE = NE + 1
    End If
                
    If GenX <> "" Then
        i = i + 1
        ReDim Preserve CheckVet(i), FindVet(i), FVet(i)
        CheckVet(i) = SchedaFilm.Gen1
        FindVet(i) = GenX
        FVet(i) = F6
        NE = NE + 1
    End If
            
Open App.Path & "\Archivi\Indice" For Input As #1
    Do Until EOF(1)
        Input #1, Gen
        Open App.Path & "\Archivi\" & Gen For Random As #2 Len = Len(SchedaFilm)
        N = 0
            Do Until EOF(2)
                N = N + 1
                Get #2, N, SchedaFilm
                
                For i = 0 To NE
                    Call TrovaParola2(CheckVet(i), FindVet(i), FVet(i))
                Next i
                
                i = 0
                Do Until i > NE
                    i = i + 1
                    If FVet(i) = True Then
                        If i = NE Then
                            Set X = FrmVisList.ListFilm.ListItems.Add(, , RTrim(SchedaFilm.Cod))
                                X.SubItems(1) = RTrim(SchedaFilm.Tit)
                                X.SubItems(2) = RTrim(SchedaFilm.TitO)
                                X.SubItems(3) = RTrim(SchedaFilm.Regia)
                                X.SubItems(4) = RTrim(SchedaFilm.AnnoU)
                        End If
                    Else
                        If FVet(i) = False Then
                            Exit Do
                        End If
                    End If
                Loop
            Loop
        Close #2
    Loop
Close #1
End If
End Sub



Questa è l'impostazione attuale, il concetto logico è che appare la finestra di ricerca, si seleziona tramite l'option il metodo (il metodo semplice funziona alla grande), ma il nostro caso riguarda quello avanzato, mettiamo caso che io cerco i film anno di uscita (Variabile AnnoUX) il programma controlla quali campi sono "compilati" riscontra che solo il campo txtAnnoUX è compilato allora incrementa l'indice "i", ridimensiona i vettori, aggiunge al vettore CheckVet la variabile dove si deve cercare, in FindVet aggiunge la variabile contente il valore da ricercare, mentre in FVet la Flag appartenente, dopodiché legge l'archivio SchedaFilm, e richiama la funzione di ricerca, una volta qui controlla se all'interno della variabile c'è la parola o il numero ricercato, se c'è imposta la flag su VERO altrimenti rimane falsa. Finito il controllo su ogni vettore indicizzato dovrebbe controllare in modo ciclico le flag se sono tutte vere allora dovrebbe aggiungere la scheda nella listview uscendo dal do per ripetere l'operazione per la prossima scheda fin quando non finiscono (aggiungendo allo stesso modo altri risultati), altrimenti esce dal do e riprende i controlli sulla prossima scheda.

Ma purtroppo ciò non avviene o almeno... clicko su cerca, mi cancella i campi della listview ma non mi da nessun risultato... Qualche soluzione?!
Ultima modifica effettuata da WillyVB 05/01/12 13:20
aaa
05/01/12 21:52
ampeg
la prima cosa da fare è sistemare tutte le dichiarazioni delle variabili assegnadogli il tipo di dato specifico, ad esempio tu stai utilizzando il modo di dichiarare le variabili implementato in vb.net che permette di dichiarare il tipo di un blocco di variabili mentre in VB6 ogni variabile va dichiarata specificatamente

ad esempio Dim a, b, c As Integer in vb.net  sono 3 variabili Integer, in VB6 solo la c è Integer le altre sono Variant, quindi vanno specificate tutte: Dim a As Integer, b As integer, c As integer


la funzione TrovaParola2 non ha senso poiché restituisce sempre un valore vbnullstring

io la correggerei così togliendo la variabile FLAG:

Private Function TrovaParola2(ByVal Str1 As String , ByVal Str2 As String) As Boolean

  ....


  'parte finale

  If Str2 = StrParte Then                      'confronta la parola da ricercare con l'ultima trovata

    TrovaParola2 = True 'al posto della var FLAG

    Exit Do                                    'esce dal ciclo Do'

  End If

 Loop    

End Function


poi la userei così:
'in pratica il flag me lo restituisce la funzione direttamente

For i = 0 To NE
   FVet(i) = TrovaParola2(CheckVet(i), FindVet(i))
Next i



questo non so se risolverà il problema, dovresti provare a fare il debug e vedere se effettivamente la variabile FVett(i) assume il valore desiderato
Ultima modifica effettuata da ampeg 05/01/12 21:55
aaa
06/01/12 14:10
WillyVB
Grazie mille ampeg dalla base dei tuoi consigli e con una trentina di prove in debug sono riuscito a trovare "l'errore" ed isolarlo, ora il codice è completo e funzionante, ho dovuto usare i checkbox per "attivare" i vari parametri da ricercare in quanto lo stesso "spazio" ovvero "" per vb è un "carattere" quindi va ricercato tramite i checkbox e l'utilizzo delle FLAGS ho creato dei vettori che contengono i parametri da ricercare posto qui il controllo finale che faccio, chissà mai sarà utile a qualcuno in futuro.

For i = 1 To NE
                        If CheckVet(i) <> "" And FindVet(i) <> "" Then
                            FVet(i) = TrovaParola2(CheckVet(i), FindVet(i))
                            If FVet(i) = False Then
                                Exit For
                            Else
                                If FVet(i) = True And i = NE Then
                                    Set X = FrmVisList.ListFilm.ListItems.Add(, , RTrim(SchedaFilm.Cod))
                                        X.SubItems(1) = RTrim(SchedaFilm.Tit)
                                        X.SubItems(2) = RTrim(SchedaFilm.TitO)
                                        X.SubItems(3) = RTrim(SchedaFilm.Regia)
                                        X.SubItems(4) = RTrim(SchedaFilm.AnnoU)
                                End If
                            End If
                        End If
                    Next i


Grazie ancora per l'aiuto :)
aaa