moddisk.bas

Project to Read Hard Disk data (raw format) at Windows Run Time

Attribute VB_Name = "modDisk"
Option Explicit
'
Public direction As Long
'HANDLE CreateFile(
'  LPCTSTR lpFileName,                         // file name
'  DWORD dwDesiredAccess,                      // access mode
'  DWORD dwShareMode,                          // share mode
'  LPSECURITY_ATTRIBUTES lpSecurityAttributes, // SD
'  DWORD dwCreationDisposition,                // how to create
'  DWORD dwFlagsAndAttributes,                 // file attributes
'  HANDLE hTemplateFile                        // handle to template file
')as

Public recf(1) As String
Private Const GENERIC_READ = &H80000000
Private Const READ_CONTROL = &H20000
Private Const FILE_SHARE_DENNY = 0
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3

Public Type POINTER
hy As Long
lo As Long
End Type


Public Const FILE_BEGIN = 0


'//////////////////////////////////////////////////////////
Private Const FLAGREAD = READ_CONTROL Or GENERIC_READ
Private Const FILE_SHARE_RW = FILE_SHARE_WRITE Or FILE_SHARE_READ
'----------------------------------------------------------
Public drvHandle As Long

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long

Public 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
lpOverlapped As Long) As Long

Public buffer(512) As Byte
Public bReaded As Long

Public Const MLong As Long = 2147483647#

'//////////////////////////////////////////////////////////
Public Function OpenDrive(ByVal name As String) As Long
If drvHandle <> -1 Then closeDrive

drvHandle = CreateFile(name, FLAGREAD, FILE_SHARE_RW, _
ByVal 0&, OPEN_EXISTING, 0&, 0&)
Debug.Print drvHandle
OpenDrive = drvHandle
End Function

Public Function closeDrive(Optional dhandle As Long = -1) As Long
If dhandle = -1 Then dhandle = drvHandle
    closeDrive = CloseHandle(drvHandle)
End Function
'---------------------------------------------------------

Public Function ReadSector(ByVal sector As String) As Long
Dim readed As Long
Dim ptr As POINTER
If drvHandle <> 0 Then
sector = myHex(512 * CDbl(sector))
sector = String(16 - Len(sector), "0") & sector
  ptr.lo = CLng("&h" & Right(sector, 8))
  ptr.hy = CLng("&h" & Left(sector, 8))
  readed = SetFilePointer(drvHandle, ptr.lo, ByVal VarPtr(ptr.hy), FILE_BEGIN)
  If readed <> -1 Then
    ReadSector = ReadFile(drvHandle, ByVal VarPtr(buffer(0)), 512, bReaded, ByVal 0&)
    
  End If
  
Else
    ReadSector = -1
End If

End Function
'100027630080
'33280
'18972


'Public Function acerSector(Optional ByVal sec As String = "195366465") As POINTER
'Dim work As Double
'Dim work2 As Double, d As Double, qc As Double, rs As Double
'Dim distlo As Long
'Dim disthi As Long
'Dim cnv As String
'Dim hexs As String
'work = CDbl(sec) * 512&
'cnv = work
'work2 = work
'Do
'work2 = Format(CDbl(work2 / 16), "0.00")
'cnv = work2
'If InStr(1, cnv, ",") <> 0 Then
''debug.print "ed"
'work2 = CDbl(Left(cnv, InStr(1, cnv, ",")))
'End If
'
'qc = Format(CDbl(work2 * 16), "0.00")
''debug.print ((work - qc))
'hexs = Hex((work - qc)) & hexs
'work = work2
'If work < 16 Then
'hexs = Hex(work) & hexs
'Exit Do
'End If
'
'DoEvents
'Loop
'work = CDbl(sec) * 512&
''debug.print hexs
'If work > MLong Then
'acerSector.lo = CLng("&h" & Right(hexs, 4))
'acerSector.hy = 0
'If Len(hexs) > 4 Then acerSector.hy = CLng("&h" & Left(hexs, Len(hexs) - 4))
'''debug.print hexs & " " & acerSector.hy & " " & acerSector.lo
'Else
'acerSector.hy = 0
'acerSector.lo = CLng(work)
'End If
'
'End Function

Public Function buildRec() As Long
recf(0) = "INDX(" & Chr(0) & Chr(9) & Chr(0)
Debug.Print recf(0)
End Function



Public Sub Busy(Optional free As Integer = 11)
'se free =0 free mesmo
Screen.MousePointer = free
End Sub