visto che i file è complicato ricostruirli avevo pensato di fare una sorta di funzione cerca che cercasse nei vari cluster (considero cluster un gruppo di 1024 byte poiche se mi fossi attenuto rigorosamente al valore di 512 il testo visualizzato per ogni schermata sarebbe stato troppo esiguo).
Così mi sono messo sotto e ho scritto una sorta di visualizzatore dei dati sul disco, solo che ho dei problemi che non capisco nel senso , per la funzione cerca carico blocchi di memoria di 131072 byte che sono abbastanza piccoli da essere gestiti rapidamente ma abbastanza grandi da ridurre il numero di accessi al disco in modo sensibile (rispetto agli accessi che avrei dovuto fare se usavo cluster di 1024 anche per al ricerca) e li scansiono con la funzione instr , guardo a che punto del blocco trovo il valore cercato e dico che NBlocco(da 131072) * 128 + ValoreInstr mod 1024 =NBlocco del cluster da 1024 in cui il valore è stato trovato.
Il mio problema nasce quando tento di leggere il cluster da 131072 numero 384 (ossia il problema sorge dopo circa 50 MB di scansione) mi si genera un errore che non riesco a controllare per il fatto che nel codice ho dovuto una On Error (che fa saltare il ciclo).
Allora ho pensato di far partire la scansione dal cluster incriminato e stare a vedere che accadeva debuggando le funzioni coinvolte ma niente va tutto bene (l'ho lasciato andare per oltre 500 cluster da 131072 e non si sono generati errori)
Ora vi posto il codice delle due funzioni così se qualcuno capisce cosa c'è che non va mi può spiegare (poi metto il codice di tutto il progetto in caso serva uno sguardo d'insieme)
Ps: la on error l'ho messa per quell'eventuale scarto tra i cluster da 1024 e quelli da 131072 che mi potrebbe (alla fine della scansione ) a una possibile richiesta di leggere memoria che non esiste.
Funzioni coinvolte nella riceca tra i cluster da 131072
Dim Counter As Long, SubCounter As Long
Dim Risultati() As String
Dim ClusterTrovati() As String
ReDim Preserve Risultati(0 To Termini.ListCount)
ReDim Preserve ClusterTrovati(0 To Termini.ListCount)
Dim Temporary As String
Dim Testo As String
Dim Current As Long, Value As String
If Termini.ListCount = 0 Or Termini.List(0) = "" Then GoTo Termina
Continue = True
Elapsed.Enabled = True
Start = Int(Timer)
Counter = 0
Do
DoEvents
Testo = Scan(Counter)
SubCounter = 0
Temporary = ""
Do
DoEvents
Do
DoEvents
If Current = 0 Then Current = 1
Current = InStr(Current, Testo, Termini.List(SubCounter), vbTextCompare)
If Current <> 0 Then
Risultati(SubCounter) = Val(Risultati(SubCounter)) + 1
Temporary = ClusterTrovati(SubCounter)
Value = 1 + (Counter * 128) + Int(Current / 1024)
If InStr(1, ClusterTrovati(SubCounter), Value, vbBinaryCompare) <> 0 Then GoTo Salto
ClusterTrovati(SubCounter) = Space(Len(ClusterTrovati(SubCounter)) + Len(Value) + 1)
Mid$(ClusterTrovati(SubCounter), 1, Len(Temporary)) = Temporary
Mid$(ClusterTrovati(SubCounter), Len(Temporary) + 1, Len(Value)) = Value
Salto:
Label4.Caption = "*"
Current = Current + 1
End If
Loop Until Current = 0
SubCounter = SubCounter + 1
Loop Until SubCounter = Termini.ListCount
Counter = Counter + 1
Label2.Caption = Counter * 128
Loop Until Counter = Int(OriginalCluster / 131072) * 128 Or Continue = False
Fine:
MsgBox "Ricerca terminata , verranno visualizzati ora i risultati", vbInformation, "Ricerca Terminata"
Counter = 0
Text4.Text = ""
Do
DoEvents
Text4.Text = Text4.Text & "Rislutati per la voce " & Chr(34) & Termini.List(Counter) & Chr(34) & " pari a " & Chr(34) & Risultati(Counter) & Chr(34) & " nei cluster " & Chr(34) & ClusterTrovati(Counter) & Chr(34) & vbNewLine
Counter = Counter + 1
Loop Until Counter = Termini.ListCount
Termina:
Private Function Scan(ByRef CurrentCluster As Long)
Dim hDrive As Long
Dim r As Long
Dim Counter As Long
Dim nRead As Long
Dim Clust As String
Dim buf(0 To 131071) As Byte
hDrive = CreateFile("\\.\" & NomePeri & ":", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
If hDrive = INVALID_HANDLE_VALUE Then
MsgBox "Errore nell'apertura del device " & NomePeri, vbInformation, "Errore nell'accesso"
Else
SetFilePointer hDrive, 131072 * CurrentCluster, 0, 1
ReadFile hDrive, buf(0), 131071, nRead, 0&
CloseHandle hDrive
Clust = Space(131072)
Do
DoEvents
Mid$(Clust, Counter + 1, 1) = Chr(buf(Counter))
Counter = Counter + 1
Loop Until Counter = 131071
If CurrentCluster * 128 Mod 1024 = 0 Then
Percentuale.Caption = Int((CurrentCluster * 128 / NumeroCluster) * 100) & " %"
Shape1.Width = Int((CurrentCluster * 128 * 3135) / NumeroCluster)
End If
End If
Scan = Clust
End Function
Ed ecco tutto il codice
Option Explicit
Dim CurrentCluster As Long
Dim NomePeri As String
Dim NumeroCluster As Long
Dim OriginalCluster As Long
Dim Continue As Boolean
Dim Start As Long
Dim Old As Long
Const SECTOR_SIZE = 1024
Dim buf(0 To SECTOR_SIZE - 1) As Byte
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1&
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long _
) As Long
Private Declare Function ReadFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByRef lpBuffer As Byte, _
ByVal nNumberOfBytesToRead As Long, _
ByRef lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Long _
) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long _
) As Long
Private Sub Avanti_Click()
If CurrentCluster + 1 <= NumeroCluster Then CurrentCluster = CurrentCluster + 1
Read_n_Display (CurrentCluster)
End Sub
Private Sub Command1_Click()
Dim FSO As FileSystemObject
Dim Stato As String, Utilizzo As String, Condivisione As String
Dim Seriale As String, Patch As String
Dim FSODrives
Dim FSODrive
Dim sDrive As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSODrives = FSO.Drives
NomePeri = UCase(Mid$(Drive1, 1, 1))
For Each FSODrive In FSODrives
sDrive = FSODrive.DriveLetter
If (sDrive = NomePeri) Then
Set FSODrive = FSO.GetDrive(sDrive)
If FSODrive.IsReady = True Then
Stato = "Connesso"
Else
Stato = "Disconnesso"
MsgBox "Attenzione la periferica non risponde" & vbNewLine & "Assicurarsi che la periferica sia connessa e pronta", vbExclamation, "Eorrore Nella Connessione"
GoTo Fine
End If
Select Case FSODrive.DriveType
Case Is = 0
Utilizzo = "Sconosciuto"
Case Is = 1
Utilizzo = "Disco Rimovibile"
Case Is = 2
Utilizzo = "Disco Locale"
Case Is = 3
Utilizzo = "Disco Remoto"
Case Is = 4
Utilizzo = "Supporto Ottico"
Case Is = 5
Utilizzo = "RAM"
End Select
If Len(FSODrive.ShareName) = 0 Then
Condivisione = "Nessuna"
Else
Condivisione = FSODrive.ShareName
End If
Seriale = Hex(FSODrive.SerialNumber)
If Len(Seriale) < 8 Then
Patch = String(8 - Len(Seriale), "0")
Seriale = Patch & Seriale
End If
Seriale = Mid$(Seriale, 1, 4) & "-" & Mid$(Seriale, 5, 4)
OriginalCluster = FSODrive.TotalSize / 1024
NumeroCluster = Int(FSODrive.TotalSize / 1024)
NCluster.Caption = "Numero Cluster : " & NumeroCluster
Text1.Text = "La periferica è : " & vbNewLine & vbNewLine & "Il nome della periferica è : " & vbNewLine & "Il nome della cartella principale della periferica è : " & vbNewLine & "Il numero seriale della periferica è : " & vbNewLine & vbNewLine & "Lo stato della periferica è : " & vbNewLine & "Il tipo di periferica è : " & vbNewLine & vbNewLine & "Il FileSystem usato dalla periferica è : " & vbNewLine & vbNewLine & "Le dimensioni della periferica sono di : " & vbNewLine & "Lo spazio libero della periferica è : " & vbNewLine & "Lo spazio disponibile della periferica è : " & vbNewLine & vbNewLine & "La condivisione della periferica è : "
Text2.Text = NomePeri & vbNewLine & vbNewLine & FSODrive.VolumeName & vbNewLine & FSODrive.RootFolder & vbNewLine & Seriale & vbNewLine & vbNewLine & Stato & vbNewLine & Utilizzo & vbNewLine & vbNewLine & FSODrive.FileSystem & vbNewLine & vbNewLine & Int(FSODrive.TotalSize / 1048576) & " MB ( " & Int(FSODrive.TotalSize / 1024) & " KByte )" & vbNewLine & Int(FSODrive.FreeSpace / 1048576) & " MB ( " & Int(FSODrive.FreeSpace / 1024) & " KByte )" & vbNewLine & Int(FSODrive.AvailableSpace / 1048576) & " MB ( " & Int(FSODrive.AvailableSpace / 1024) & " KByte )" & vbNewLine & vbNewLine & Condivisione
End If
Next
CurrentCluster = 0
Read_n_Display (0)
Form1.Height = 8940
Fine:
Set FSO = Nothing
Set FSODrives = Nothing
Set FSODrive = Nothing
End Sub
Private Sub Command2_Click()
Frame5.Visible = True
Termini.Clear
Voci = ""
Old = 100
End Sub
Private Sub Command3_Click()
Frame4.Visible = False
Continue = False
Elapsed.Enabled = False
Old = 0
End Sub
Private Sub Command4_Click()
Termini.AddItem Voci.Text
Voci.Text = ""
Voci.SetFocus
End Sub
Private Sub Command5_Click()
Frame5.Visible = False
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label5.Caption = ""
Frame4.Visible = True
Shape1.Width = 1
Percentuale.Caption = "0 %"
Dim Counter As Long, SubCounter As Long
Dim Risultati() As String
Dim ClusterTrovati() As String
ReDim Preserve Risultati(0 To Termini.ListCount)
ReDim Preserve ClusterTrovati(0 To Termini.ListCount)
Dim Temporary As String
Dim Testo As String
Dim Current As Long, Value As String
If Termini.ListCount = 0 Or Termini.List(0) = "" Then GoTo Termina
Continue = True
Elapsed.Enabled = True
Start = Int(Timer)
Counter = 0
Do
DoEvents
Testo = Scan(Counter)
SubCounter = 0
Temporary = ""
Do
DoEvents
Do
DoEvents
If Current = 0 Then Current = 1
Current = InStr(Current, Testo, Termini.List(SubCounter), vbTextCompare)
If Current <> 0 Then
Risultati(SubCounter) = Val(Risultati(SubCounter)) + 1
Temporary = ClusterTrovati(SubCounter)
Value = 1 + (Counter * 128) + Int(Current / 1024)
If InStr(1, ClusterTrovati(SubCounter), Value, vbBinaryCompare) <> 0 Then GoTo Salto
ClusterTrovati(SubCounter) = Space(Len(ClusterTrovati(SubCounter)) + Len(Value) + 1)
Mid$(ClusterTrovati(SubCounter), 1, Len(Temporary)) = Temporary
Mid$(ClusterTrovati(SubCounter), Len(Temporary) + 1, Len(Value)) = Value
Salto:
Label4.Caption = "*"
Current = Current + 1
End If
Loop Until Current = 0
SubCounter = SubCounter + 1
Loop Until SubCounter = Termini.ListCount
Counter = Counter + 1
Label2.Caption = Counter * 128
Loop Until Counter = Int(OriginalCluster / 131072) * 128 Or Continue = False
Fine:
MsgBox "Ricerca terminata , verranno visualizzati ora i risultati", vbInformation, "Ricerca Terminata"
Counter = 0
Text4.Text = ""
Do
DoEvents
Text4.Text = Text4.Text & "Rislutati per la voce " & Chr(34) & Termini.List(Counter) & Chr(34) & " pari a " & Chr(34) & Risultati(Counter) & Chr(34) & " nei cluster " & Chr(34) & ClusterTrovati(Counter) & Chr(34) & vbNewLine
Counter = Counter + 1
Loop Until Counter = Termini.ListCount
Termina:
End Sub
Private Sub Command6_Click()
Frame5.Visible = False
End Sub
Private Sub Command7_Click()
Dim Cluster As Long
Cluster = InputBox("Inserire l'indirizzo del cluster che si intende visualizzare", "Ricerca")
Cluster = Val(Cluster)
If Cluster > NumeroCluster And Cluster < 0 Then
MsgBox "Errore nella ricerca del cluster" & vbNewLine & " Assicurarsi che l'indirizzo inserito sia un indirizzo corretto ed esistente", vbInformation, " Errore nella Ricerca"
Else
Read_n_Display (Cluster - 1)
CurrentCluster = Cluster
End If
End Sub
Private Sub Command8_Click()
Dim TRicercato As String
Dim Current As Long
Dim Risultato As String
TRicercato = InputBox("Inserire la parola o frase che si vuole ricercare nel testo letto e visualizzato", "Ricerca")
Current = 1
Risultato = "Nessuna voce trovata"
If TRicercato = "" Then GoTo Fine
Do
DoEvents
Current = InStr(Current, Text4.Text, TRicercato, vbBinaryCompare)
If Current <> 0 Then
Risultato = Risultato & "Testo trovato nella " & Int(Current / 66) + 1 & "° riga , al " & (Current Mod 66) - 1 & "° carattere" & vbNewLine
Current = Current + 1
End If
Loop Until Current = 0
MsgBox Risultato, vbInformation, "Ricerca"
Fine:
End Sub
Private Sub Elapsed_Timer()
Dim Tempo As Long
Dim Tempo2 As Long
On Error GoTo Fine
Tempo = Int((NumeroCluster / (Val(Label2.Caption) - Old)))
Tempo2 = Start + Tempo - Int(Timer)
Label3.Caption = Format(Int(Tempo / 3600), "00") & ":" & Format(Int((Tempo - (Int(Tempo / 3600) * 3600)) / 60), "00") & ":" & Format(Tempo Mod 60, "00")
Label5.Caption = Format(Int(Tempo2 / 3600), "00") & ":" & Format(Int((Tempo2 - (Int(Tempo2 / 3600) * 3600)) / 60), "00") & ":" & Format(Tempo2 Mod 60, "00")
Fine:
Old = Val(Label2.Caption)
End Sub
Private Sub Form_Load()
Form1.Height = 5100
End Sub
Private Function Read_n_Display(ByRef CurrentCluster As Long)
Dim hDrive As Long
Dim r As Long
Dim Counter As Long
Dim nRead As Long
Dim Clust As String
Dim Riga As Long
Clust = String(1056, Chr(46))
hDrive = CreateFile("\\.\" & NomePeri & ":", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
If hDrive = INVALID_HANDLE_VALUE Then
MsgBox "Errore nell'apertura del device " & NomePeri, vbInformation, "Errore nell'accesso"
Else
SetFilePointer hDrive, 1024 * CurrentCluster, 0, 1
ReadFile hDrive, buf(0), 1024, nRead, 0&
CloseHandle hDrive
Riga = 1
Do
DoEvents
If buf(Counter) < 32 Then buf(Counter) = 46
If Counter Mod 64 = 0 And Counter <> 0 Then
Mid$(Clust, Counter + (Riga * 2), 2) = vbNewLine
Riga = Riga + 1
End If
If Counter = 0 Then
Mid$(Clust, Counter + (Riga * 2), 1) = Chr(buf(Counter))
Else
Mid$(Clust, Counter + (Riga * 2), 1) = Chr(buf(Counter))
End If
Counter = Counter + 1
Loop Until Counter = 1023
CCluster.Caption = "Cluster Corrente : " & (CurrentCluster + 1)
Text4.Text = Clust
End If
End Function
Private Function Scan(ByRef CurrentCluster As Long)
Dim hDrive As Long
Dim r As Long
Dim Counter As Long
Dim nRead As Long
Dim Clust As String
Dim buf(0 To 131071) As Byte
hDrive = CreateFile("\\.\" & NomePeri & ":", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
If hDrive = INVALID_HANDLE_VALUE Then
MsgBox "Errore nell'apertura del device " & NomePeri, vbInformation, "Errore nell'accesso"
Else
SetFilePointer hDrive, 131072 * CurrentCluster, 0, 1
ReadFile hDrive, buf(0), 131071, nRead, 0&
CloseHandle hDrive
Clust = Space(131072)
Do
DoEvents
Mid$(Clust, Counter + 1, 1) = Chr(buf(Counter))
Counter = Counter + 1
Loop Until Counter = 131071
If CurrentCluster * 128 Mod 1024 = 0 Then
Percentuale.Caption = Int((CurrentCluster * 128 / NumeroCluster) * 100) & " %"
Shape1.Width = Int((CurrentCluster * 128 * 3135) / NumeroCluster)
End If
End If
Scan = Clust
End Function
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Enabled = True
End Sub
Private Sub indietro_Click()
If CurrentCluster - 1 >= 0 Then CurrentCluster = CurrentCluster - 1
Read_n_Display (CurrentCluster)
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii <> 0 Then KeyAscii = 0
End Sub
Private Sub Timer1_Timer()
Drive1.Refresh
Timer1.Enabled = False
End Sub
il programma è ancora un abbozzo quindi scusate per il codice scritto un pò male , confido comunque in un vostro consiglio.
Grazie in anticipo