ab.com コミュニティ

コード: 全て選択

#strict

Const CARRY_FLAG = 1

Const VWIN32_DIOC_DOS_INT25 = 2
Const VWIN32_DIOC_DOS_INT26 = 3
Const VWIN32_DIOC_DOS_DRIVEINFO = 6

Const INVALID_SET_FILE_POINTER = &HFFFFFFFF

Type DIOC_REGISTERS
	reg_EBX As DWord
	reg_EDX As DWord
	reg_ECX As DWord
	reg_EAX As DWord
	reg_EDI As DWord
	reg_ESI As DWord
	reg_Flags As DWord
End Type

Type Align(1) DISKIO
	dwStartSector As DWord   ' 論理セクタ番号の開始番号
	wSectors As Word         ' セクタ数
	dwBuffer As DWord        ' 読み込み/書き込みバッファのアドレス
End Type

Declare Function DeviceIoControl Lib "Kernel32" (
	hDevice As HANDLE,
	dwIoControlCode As DWord,
	lpInBuffer As VoidPtr,
	nInBufferSize As DWord,
	lpOutBuffer As VoidPtr,
	nOutBufferSize As DWord,
	lpBytesReturned As DWordPtr,
	lpOverlapped As *OVERLAPPED) As Long

' GetClusterSize9x内部で呼んでいる関数
' これはMSのCでのサンプルの関数をほぼそのままABに移植しただけ。
' http://support.microsoft.com/?scid=kb;ja;174569

' NewReadSectors, ReadLogicalSectors
' 引数
'	hDev vwin32のハンドル
'	bDrive ドライブ番号(0=カレントドライブ, 1=Aドライブ, 2=B, 3=C 4=D, ……)
'	dwStartSector 読み込み開始セクタ番号
'	wSectors 読み込むセクタ数
'	pSectBuff 読み込む先のバッファへのポインタ
Function NewReadSectors(hDev As HANDLE, bDrive As Byte, dwStartSector As DWord, wSectors As Word, pSectBuff As VoidPtr) As BOOL
	Dim cb As DWord
	Dim reg As DIOC_REGISTERS
	Dim dio As DISKIO

	With dio
		.dwStartSector = dwStartSector
		.wSectors      = wSectors
		.dwBuffer      = pSectBuff As DWord
	End With

	With reg
		.reg_EAX = &h7305   ' Ext_ABSDiskReadWrite
		.reg_EBX = VarPtr(dio) As DWord
		.reg_ECX = -1
		.reg_EDX = bDrive   ' Int 21h, fn 7305h ドライブ番号は 1 ベースです。
	End With

	If DeviceIoControl(hDev, VWIN32_DIOC_DOS_DRIVEINFO, 
		VarPtr(reg), Len(reg), VarPtr(reg), Len(reg), VarPtr(cb), 0) Then
		' DeviceIoControl および読み取りが成功しているかどうか検証します。
		NewReadSectors = (reg.reg_Flags And CARRY_FLAG) <> 0
	End If
End Function

Function ReadLogicalSectors(hDev As HANDLE, bDrive As Byte,dwStartSector As DWord, wSectors As Word, pSectBuff As *Byte)
	Dim cb As DWord
	Dim reg As DIOC_REGISTERS
	Dim dio As DISKIO

	With dio
		.dwStartSector = dwStartSector
		.wSectors      = wSectors
		.dwBuffer      = pSectBuff As DWord
	End With
	
	With reg
		.reg_EAX = bDrive - 1    ' Int 25h ドライブ番号は 0 ベースです。
		.reg_EBX = VarPtr(dio) As DWord
		.reg_ECX = &hFFFF        ' DISKIO 構造体を使用します。
	End With

	If DeviceIoControl(hDev, VWIN32_DIOC_DOS_INT25,
                                VarPtr (reg), Len (reg),
                                VarPtr (reg), Len (reg), VarPtr (cb), 0) <> FALSE Then
		' DeviceIoControl および読み取りが成功しているかどうか検証します。
		ReadLogicalSectors = (reg.reg_Flags And CARRY_FLAG) = 0
	End If
End Function

Dim vi As OSVERSIONINFO
vi.dwOSVersionInfoSize = Len (vi)
GetVersionEx(vi)

Function IsWin95OSR2OrOver(ByRef vi As OSVERSIONINFO) As BOOL
	With vi
		If .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
			.dwMajorVersion = 4 And _
			(.dwMinorVersion >= 10 Or .szCSDVersion[0] = Asc("B") Or .szCSDVersion[0] = Asc("C")) Then
			IsWin95OSR2OrOver = TRUE
		Else
			IsWin95OSR2OrOver = FALSE
		End If
	End With
End Function

Const SectorSize = 512

'   ReadDriveSector - セクター単位読込
' driveLatter ドライブ文字
' startSector 読込を開始するセクタ番号（0から）
' sectors 読み込むセクタ数
' buf 読み込むバッファ
' 注意：セクタサイズは512バイトで決め打ちしてある。
Function ReadDriveSector(driveLatter As Byte, startSector As DWord, sectors As Word, buf As *Byte) As BOOL
	If vi.dwPlatformId = VER_PLATFORM_WIN32_NT Then
		Dim drive[6] As Byte
		wsprintf(drive, "\\.\%c:", driveLatter)

		Dim hDrive As HANDLE
		hDrive = CreateFile(drive, GENERIC_READ, FILE_SHARE_READ, ByVal 0, OPEN_ALWAYS, 0, 0)
		If hDrive <> INVALID_HANDLE_VALUE Then
			If SetFilePointer(hDrive, startSector * SectorSize, 0, FILE_BEGIN) <> INVALID_SET_FILE_POINTER Then
				Dim readSize As DWord
				ReadDriveSector = ReadFile(hDrive, buf, sectors * SectorSize, VarPtr(readSize), ByVal 0)
			End If
		End If
		CloseHandle(hDrive)
	Else
		Dim driveNum As Byte
		driveNum = CharLower(driveLatter As ULONG_PTR As *Byte) As ULONG_PTR As Byte - Asc("a")
		driveNum++

		Dim hDevice As HANDLE
		hDevice = CreateFile("\\.\vwin32", 0, 0, ByVal NULL, 0, FILE_FLAG_DELETE_ON_CLOSE, NULL)
		If hDevice <> INVALID_HANDLE_VALUE Then

			Dim ret As BOOL
			If IsWin95OSR2OrOver(vi) Then
				ReadDriveSector = NewReadSectors(hDevice, driveNum, startSector, sectors, buf)
			Else
				ReadDriveSector = ReadLogicalSectors(hDevice, driveNum, startSector, sectors, buf)
			End If
			CloseHandle(hDevice)
		End If
	End If
End Function

Dim buffer[ELM(SectorSize)] As Byte
ReadDriveSector(Asc("A"), 0, 1, buffer)
Dim hWrite As HANDLE
hWrite = CreateFile("H:\out.bin", GENERIC_WRITE, 0, ByVal 0, CREATE_ALWAYS, 0, 0)
If hWrite <> INVALID_HANDLE_VALUE Then
	Dim writtenSize As DWord
	WriteFile(hWrite, buffer, Len (buffer), VarPtr(writtenSize), ByVal 0)
	CloseHandle(hWrite)
End If