frmundelete.frm

Visual Basic Low Level Disk Acces

VERSION 5.00
Begin VB.Form frmUndelete 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "VB Undelete"
   ClientHeight    =   5505
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10830
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5505
   ScaleWidth      =   10830
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command3 
      Caption         =   "Save data"
      Height          =   315
      Left            =   9720
      TabIndex        =   10
      Top             =   60
      Width           =   1035
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command4"
      Height          =   315
      Left            =   5100
      TabIndex        =   9
      Top             =   60
      Width           =   315
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command3"
      Height          =   315
      Left            =   4080
      TabIndex        =   8
      Top             =   60
      Width           =   315
   End
   Begin VB.TextBox Text2 
      Alignment       =   1  'Right Justify
      Height          =   315
      Left            =   4380
      TabIndex        =   7
      Text            =   "Text2"
      Top             =   60
      Width           =   735
   End
   Begin VB.TextBox Text1 
      Height          =   4935
      Left            =   2880
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Top             =   480
      Width           =   7875
   End
   Begin VB.Frame Frame1 
      Caption         =   "Info"
      Height          =   1935
      Left            =   60
      TabIndex        =   2
      Top             =   3480
      Width           =   2775
      Begin VB.Label Label1 
         Caption         =   "Label1"
         Height          =   1635
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   2535
      End
   End
   Begin VB.DriveListBox Drive1 
      Height          =   315
      Left            =   120
      TabIndex        =   1
      Top             =   60
      Width           =   2715
   End
   Begin VB.ListBox List1 
      Height          =   2790
      Left            =   60
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   480
      Width           =   2775
   End
   Begin VB.Label Label3 
      Caption         =   "Preview sector"
      Height          =   255
      Left            =   2940
      TabIndex        =   6
      Top             =   120
      Width           =   1155
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Label2"
      Height          =   195
      Left            =   5520
      TabIndex        =   5
      Top             =   120
      Width           =   3375
      WordWrap        =   -1  'True
   End
End
Attribute VB_Name = "frmUndelete"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Type DIR_ENTRY_INFO
    dwDirEntryNum As Long
    sDosName As String
    sUnicodeName As String
    bLFNEntries As Byte
    dtDateCreated As Date
    dtLastAccesed As Date
    dtLastModified As Date
    dwFirstCluster As Long
    dwFileSize As Long
    dwRecoverSize As Long
    dwFirstFATEntry As Long
    bAttribute As VbFileAttribute
End Type

Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

Dim dei() As DIR_ENTRY_INFO
Dim sPath As String
Dim DirFirstCluster As Long
Dim MaxSectors As Long

Private Sub Command1_Click()
   If Val(Text2) > 1 Then
      Text2 = Val(Text2) - 1
      If dei(List1.ItemData(List1.ListIndex)).dwFirstCluster = 0 Then
         ShowSector Text1, Left(Drive1.Drive, 2), RootDirectoryStart + 1 - Val(Text2)
      Else
         ShowSector Text1, Left(Drive1.Drive, 2), (dei(List1.ItemData(List1.ListIndex)).dwFirstCluster - RootDirStartCluster) * SectorsPerCluster + DataAreaStart + 1 - Val(Text2)
      End If
   End If
End Sub

Private Sub Command2_Click()
   If Val(Text2) < MaxSectors Then
      Text2 = Val(Text2) + 1
      If dei(List1.ItemData(List1.ListIndex)).dwFirstCluster = 0 Then
         ShowSector Text1, Left(Drive1.Drive, 2), RootDirectoryStart + 1 - Val(Text2)
      Else
         ShowSector Text1, Left(Drive1.Drive, 2), (dei(List1.ItemData(List1.ListIndex)).dwFirstCluster - RootDirStartCluster) * SectorsPerCluster + DataAreaStart + 1 - Val(Text2)
      End If
   End If
End Sub

Private Sub Command3_Click()
   Dim nIndex As Long
   nIndex = List1.ItemData(List1.ListIndex)
   frmSave.m_StartCluster = dei(nIndex).dwFirstCluster
   frmSave.m_DataSize = dei(nIndex).dwFileSize
   frmSave.m_Drive = Left(Drive1.Drive, 2)
   frmSave.Show vbModal, Me
End Sub

Private Sub Drive1_Change()
  Erase dei
  InitDriveInfo Left(Drive1.Drive, 2)
  sPath = Left(Drive1.Drive, 2)
  FillUndeleteList List1
End Sub

Private Sub Form_Load()
   Drive1.Drive = "c:\"
   Label1.Font = "Terminal"
   Command1.Font = "Marlett"
   Command2.Font = "Marlett"
   Command1.Font.Size = 12
   Command2.Font.Size = 12
   Command1.Caption = "3"
   Command2.Caption = "4"
   SizeForm Me, Text1
   Text2.Locked = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Unload frmSave
End Sub

Private Sub List1_Click()
   Dim sName As String
   sName = dei(List1.ItemData(List1.ListIndex)).sDosName
   If sName = ".." Then
      Label2 = "of " & ParentFolder(sPath)
   Else
      Label2 = "of " & sPath & "\" & sName
   End If
   Text2 = "1"
   MaxSectors = Int((dei(List1.ItemData(List1.ListIndex)).dwFileSize / BytesPerSector / SectorsPerCluster) + 1) * 8
   ShowInfo List1.ItemData(List1.ListIndex)
   If dei(List1.ItemData(List1.ListIndex)).dwFirstCluster = 0 Then
      ShowSector Text1, Left(Drive1.Drive, 2), RootDirectoryStart
   Else
      ShowSector Text1, Left(Drive1.Drive, 2), (dei(List1.ItemData(List1.ListIndex)).dwFirstCluster - RootDirStartCluster) * SectorsPerCluster + DataAreaStart
   End If
End Sub

Private Sub List1_DblClick()
   Dim sName As String, sRet As String
   Dim nIndex As Long, ret As Long
   nIndex = List1.ItemData(List1.ListIndex)
   sName = dei(nIndex).sDosName
   If sName = "" Then Exit Sub
   If Left(sName, 1) = "?" Then 'Undelete File/Folder
      If dei(nIndex).dwRecoverSize = 0 Then
         sRet = "Recovering impossible."
         If (dei(nIndex).bAttribute And vbDirectory) = False Then
            sRet = sRet & vbCrLf & "But you may save data into another file."
         End If
         MsgBox sRet, vbExclamation, "Undelete error"
         Exit Sub
      End If
      If dei(nIndex).dwRecoverSize < dei(nIndex).dwFileSize Then
         sRet = "Only first " & dei(nIndex).dwRecoverSize
         sRet = sRet & " bytes of this file can be undeleted."
         sRet = sRet & vbCrLf & "In most cases file will be corrupted."
         sRet = sRet & vbCrLf & "It's better to save data into another file."
         sRet = sRet & vbCrLf & "Proceed anywhere?"
         ret = MsgBox(sRet, vbExclamation + vbYesNo + vbDefaultButton2, "Undlete warning")
         If ret = vbNo Then Exit Sub
      End If
      sRet = ""
      sRet = InputBox("Enter first letter of deleted item which will replace " & Chr(34) & "?" & Chr(34) & " char in " & sName & ".", VBUndelete)
      If sRet = "" Then Exit Sub
      UndeleteFile List1.ItemData(List1.ListIndex), sRet
   Else 'Open subfolder
      If sName = ".." Then
         sPath = ParentFolder(sPath)
      Else
         sPath = sPath & "\" & sName
      End If
      If dei(nIndex).dwFirstCluster = 0 Then
         GetRootDir Left(Drive1.Drive, 2)
         DirFirstCluster = RootDirStartCluster
      Else
         SearchDirEntries Left(Drive1.Drive, 2), dei(nIndex).dwFirstCluster
         DirFirstCluster = dei(nIndex).dwFirstCluster
      End If
      FillUndeleteList List1
   End If
End Sub

Private Sub FillUndeleteList(lb As ListBox)
   Dim i As Long, LFNEntry As Long
   Dim sDirEntry As String
   Dim sShortName As String, sExt As String, sTemp As String
   Dim sUnicodeName As String
   Dim nListEntry As Long
   Dim iDosTime As Integer, iDosDate As Integer
   lb.Clear
   For i = 0 To UBound(aDirEntries)
       sDirEntry = StrConv(aDirEntries(i).abDirEntry, vbUnicode)