Accesso a Disco

Nessuno di voi ha idea di come si potrebbe fare per accedere ad un disco in modo diretto?
mi spiego se volessi fare un programma per recuperare dati da un disco danneggiato è possibilie tramite qualche api leggere il contenuto di tutto il disco (o solo alcuni settori) senza dover specificare un file?

Perchè io ho trovato qualcosa che riguarda l'api CreateFile ma non sono tanto sicuro di essere sulla strada giusta ... consigli?

Grazie anticipatamente

No ... non puoi accedere a quel livello da un programma VB ... anzi non puoi farlo da nessun tipo di programma, neanche da C/C++ operante unicamente in modalita' utente ...

Dal tuo programma devi utilizzare un apposito device driver ... e non e' proprio una passeggiata scriverne uno ...

ah peccato mi ero preso proprio bene con questa idea
aveo letto qui Accesso ai settori dei dischi da VB (NT) e pensavo si potesse fare (in effetti se provo quel codice ottengo dei caratteri come output anche se per il momento non mi dicono molto)

Mmmm ... sì, avendo i diritti e su dischi che non sono bloccati dal sistema operativo, potrebbe essere possibile utilizzare quel codice anche da VB6 ...

Dovresti riuscirci ...

so che adesso mi prenderai per stupido, ma in poche parole volevo chiedere, una volta che riesco a sfogliare tutto il volume come posso fare a recuperare un file? nel senso devo appoggiarmi su un database di header , vedere se ne riconosco uno nel volume e considerare quelllo un file fino a che non trovo l'header successivo ?

E' una cosa tremendamente complessa perche' i "pezzi" dei file possonon non avere nulla a che fare l'uno con l'altro ...

Un consiglio spassionato ... lascia perdere.

ah ok
avevo sottovalutato il problema

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

Scusate il doppio post nell'arco di poche ore (non trovo la funzione modifica , probabilemente a causa dell'ora tarda) ad ogni modo ho trovato l'errore nel codice, una sciocca svista mia (ho sbagliato il conto con le proporzioni per calcolare l'uscita dal ciclo) ad ogni modo graze e scusate ancora.