Конечно делись
А фрагментированные файлы перезаписаны? Или данные нетронуты, просто перетасованы? И какого типа файлы?
В случае текстовых файлов можно восстановить довольно многое.
'*****************************************************************
' Module for performing Direct Read/Write access to disk sectors
'
' Written by Arkadiy Olovyannikov (ark@fesma.ru)
'*****************************************************************
Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const FILE_DEVICE_FILE_SYSTEM = &H9&
Private Const FILE_ANY_ACCESS = 0
Private Const FILE_READ_ACCESS = &H1
Private Const FILE_WRITE_ACCESS = &H2
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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function LockFile Lib "kernel32" (ByVal hFile As Long, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToLockLow As Long, ByVal nNumberOfBytesToLockHigh As Long) As Long
Private Declare Function UnlockFile Lib "kernel32" (ByVal hFile As Long, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToUnlockLow As Long, ByVal nNumberOfBytesToUnlockHigh As Long) As Long
Private Const FILE_BEGIN = 0
Public Function DirectReadDriveNT(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal cBytes As Long) As Variant
Dim hDevice As Long
Dim abBuff() As Byte
Dim abResult() As Byte
Dim nSectors As Long
Dim nRead As Long
nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
hDevice = CreateFile("\\.\" & UCase(Left(sDrive, 1)) & ":", GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
If hDevice = INVALID_HANDLE_VALUE Then Exit Function
Call SetFilePointer(hDevice, iStartSec * BytesPerSector, 0, FILE_BEGIN)
ReDim abResult(cBytes - 1)
ReDim abBuff(nSectors * BytesPerSector - 1)
Call ReadFile(hDevice, abBuff(0), UBound(abBuff) + 1, nRead, 0&)
CloseHandle hDevice
CopyMemory abResult(0), abBuff(iOffset), cBytes
DirectReadDriveNT = abResult
End Function
Public Function DirectWriteDriveNT(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal sWrite As String) As Boolean
Dim hDevice As Long
Dim abBuff() As Byte
Dim ab() As Byte
Dim nRead As Long
Dim nSectors As Long
nSectors = Int((iOffset + Len(sWrite) - 1) / BytesPerSector) + 1
hDevice = CreateFile("\\.\" & UCase(Left(sDrive, 1)) & ":", GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
If hDevice = INVALID_HANDLE_VALUE Then Exit Function
abBuff = DirectReadDriveNT(sDrive, iStartSec, 0, nSectors * BytesPerSector)
ab = StrConv(sWrite, vbFromUnicode)
CopyMemory abBuff(iOffset), ab(0), Len(sWrite)
Call SetFilePointer(hDevice, iStartSec * BytesPerSector, 0, FILE_BEGIN)
Call LockFile(hDevice, LoWord(iStartSec * BytesPerSector), HiWord(iStartSec * BytesPerSector), LoWord(nSectors * BytesPerSector), HiWord(nSectors * BytesPerSector))
DirectWriteDriveNT = WriteFile(hDevice, abBuff(0), UBound(abBuff) + 1, nRead, 0&)
Call FlushFileBuffers(hDevice)
Call UnlockFile(hDevice, LoWord(iStartSec * BytesPerSector), HiWord(iStartSec * BytesPerSector), LoWord(nSectors * BytesPerSector), HiWord(nSectors * BytesPerSector))
CloseHandle hDevice
End Function
Private Function HiWord(ByVal dw As Long) As Integer
CopyMemory HiWord, ByVal VarPtr(dw) + 2, 2
End Function
Private Function LoWord(ByVal dw As Long) As Integer
CopyMemory LoWord, dw, 2
End Function
Public Function MkLong(ByVal wLo As Integer, ByVal wHi As Integer) As Long
CopyMemory MkLong, wLo, 2
CopyMemory ByVal VarPtr(MkLong) + 2, wHi, 2
End Function
Option Explicit
Private Const EOFMarker = &HFFFFF8
Private Type DirectoryEntry
Name As String * 8
Ext As String * 3
Attrib As Byte
Bogus As Byte
Second As Byte
CreateTime As Integer
CreateDate As Integer
AccessDate As Integer
ClusterH As Integer
ModifyTime As Integer
ModifyDate As Integer
ClusterL As Integer
Size As Long
End Type
Private Type RawDirectoryEntry
Name_(1 To 8) As Byte
Ext(1 To 3) As Byte
Attrib As Byte
Bogus As Byte
Second As Byte
CreateTime As Integer
CreateDate As Integer
AccessDate As Integer
ClusterH As Integer
ModifyTime As Integer
ModifyDate As Integer
ClusterL As Integer
Size As Long
End Type
Private Const PathToProcess = "E:\DISTRIB\DISTRIBX" 'no lfns atm
Private DriveToProcess As String
Private StartingDirectory As String
Public BytesPerSector As Integer
Private BytesPerCluster As Long, SectorsPerCluster As Byte
Private Clusters As Long
Private RootCluster As Long
Private FAT1Sector As Long
Private FAT2Sector As Long
Private FirstSector As Long
Private FAT() As Long
Sub Main()
DriveToProcess = Left(PathToProcess, 2)
StartingDirectory = Mid(PathToProcess, 3)
ReadBR
Dim d As Variant
For Each d In Split(StartingDirectory, "\")
If Len(d) Then RootCluster = EnterDirectory(RootCluster, d)
Next
RecoverDirectory RootCluster
End Sub
Private Sub Dump(Data() As Byte)
Dim i As Long, j As Long
For i = 0 To UBound(Data) Step 16
For j = i To i + 15
If j <= UBound(Data) Then Debug.Print Right("00" & Hex(Data(j)), 2) & " ";
Next
Debug.Print ,
For j = i To i + 15
If j <= UBound(Data) Then Debug.Print Chr(Data(j));
Next
Debug.Print
Next
End Sub
Private Sub ReadBR()
Dim Data() As Byte
Dim TotalSectors As Long, ReservedSectors As Integer, SectorsPerFat As Long
BytesPerSector = 512 'a reasonable default
Data = DirectReadDriveNT(DriveToProcess, 0, 0, 512)
CopyMemory BytesPerSector, Data(&HB), 2
Debug.Assert BytesPerSector = 512
SectorsPerCluster = Data(&HD)
BytesPerCluster = BytesPerSector * SectorsPerCluster
CopyMemory ReservedSectors, Data(&HE), 2
Debug.Assert Data(&H10) = 2 'number of FATS
CopyMemory SectorsPerFat, Data(&H24), 4
CopyMemory RootCluster, Data(&H2C), 4
CopyMemory TotalSectors, Data(&H20), 4
FAT1Sector = ReservedSectors
FAT2Sector = FAT1Sector + SectorsPerFat
FirstSector = FAT2Sector + SectorsPerFat
Clusters = (TotalSectors - FirstSector) / SectorsPerCluster
ReDim FAT(Clusters)
Data = DirectReadDriveNT(DriveToProcess, FAT1Sector, 0, BytesPerSector * SectorsPerFat)
CopyMemory FAT(0), Data(0), BytesPerSector * SectorsPerFat
End Sub
Private Function SectorOfCluster(ByVal Cluster As Long) As Long
SectorOfCluster = SectorsPerCluster * (Cluster - 2) + FirstSector
End Function
Private Function ReadCluster(ByVal Cluster As Long) As Variant
Dim Data() As Byte, Result As String
Do
Debug.Assert Cluster
Data = DirectReadDriveNT(DriveToProcess, SectorOfCluster(Cluster), 0, BytesPerCluster)
Result = Result & StrConv(Data, vbUnicode)
If FAT(Cluster) >= EOFMarker Then Exit Do
Cluster = FAT(Cluster)
Loop
ReadCluster = StrConv(Result, vbFromUnicode)
End Function
Private Function ClusterOfEntry(Entry As DirectoryEntry) As Long
ClusterOfEntry = MkLong(Entry.ClusterL, Entry.ClusterH)
End Function
Private Function ReadDirectory(ByVal BaseCluster As Long, Entries() As RawDirectoryEntry) As Long
Dim Data() As Byte
Data = ReadCluster(BaseCluster)
ReadDirectory = (1 + UBound(Data)) / Len(Entries(0))
ReDim Entries(ReadDirectory)
CopyMemory Entries(0), Data(0), ReadDirectory * Len(Entries(0))
End Function
Private Function EnterDirectory(ByVal BaseCluster As Long, ByVal DirectoryName As String) As Long
Dim Entries() As RawDirectoryEntry, NumEntries As Long, Entry As DirectoryEntry, i As Long
DirectoryName = UCase(Left(DirectoryName & Space(8), 8))
NumEntries = ReadDirectory(BaseCluster, Entries)
For i = 0 To NumEntries - 1
If Entries(i).Name_(1) <> &HE5 Then
CopyMemory Entry, Entries(i), Len(Entry)
If (Entry.Attrib And vbDirectory) Then
Debug.Assert Entry.Size = 0
Select Case Entry.Name
Case ". ": Debug.Assert ClusterOfEntry(Entry) = BaseCluster
Case DirectoryName: EnterDirectory = ClusterOfEntry(Entry)
End Select
End If
End If
Next
Debug.Assert EnterDirectory
End Function
Private Sub RecoverDirectory(ByVal BaseCluster As Long)
Dim Entries() As RawDirectoryEntry, NumEntries As Long, Entry As DirectoryEntry, i As Long
Dim Cluster As Long, Clusters As Long, j As Long
NumEntries = ReadDirectory(BaseCluster, Entries)
For i = 0 To NumEntries - 1
If Entries(i).Name_(1) <> &HE5 Then
CopyMemory Entry, Entries(i), Len(Entry)
Cluster = ClusterOfEntry(Entry)
If Cluster Then
Select Case Entry.Attrib
Case &HF: 'LFN
'...
Case vbDirectory:
Debug.Assert Entry.Size = 0
Select Case Entry.Name
Case ". ": Debug.Assert ClusterOfEntry(Entry) = BaseCluster
Case ".. ": 'ignore
Case Else: If FAT(Cluster) Then RecoverDirectory Cluster
End Select
Case 0:
'the trickiest part
If FAT(Cluster) Then
Debug.Print Entry.Name & "." & Entry.Ext & " already there"
Else
Clusters = Entry.Size \ BytesPerCluster
If Entry.Size > Clusters * BytesPerCluster Then Clusters = Clusters + 1 'allow for slack
For j = Cluster To Cluster + Clusters - 1
If FAT(j) Then
Debug.Print Entry.Name & "." & Entry.Ext & " overwritten"
GoTo Skip
End If
Next
For j = Cluster To Cluster + Clusters - 2
FAT(j) = j + 1
Next
FAT(Cluster + Clusters - 1) = EOFMarker
Debug.Print Entry.Name & "." & Entry.Ext & " recovered"
End If
Skip:
Case Else: Stop
End Select
Else
Debug.Assert (Entry.Name = String(8, 0)) Or (Entry.Attrib = &HF)
End If
End If
Next
'ignore lost LFN's - there's more work to do
End Sub
alibek писал(а):Идея и вправду сумасшедшая
Мне юзать VMWare толком не довелось. Она умеет эмулировать другое оборудование? Если да, то думаю, идея прокатит.
tyomitch писал(а):Копию FAT не снимал, это да...
Кстати, а разве WinXP не встаёт поверх Win2000? У меня она почему-то поставилась рядом, и даже не спросила как мне надо. Или это фишка такая?
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 116