VB拷贝SAM文件

VERSION 5.00
Begin VB.Form frmMain
   BorderStyle     =   1  'Fixed Single
   Caption         =   "磁盘文件复制"
   ClientHeight    =   2745
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5235
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2745
   ScaleWidth      =   5235
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdExit
      Cancel          =   -1  'True
      Caption         =   "退出"
      Height          =   375
      Left            =   3720
      TabIndex        =   5
      Top             =   1950
      Width           =   1275
   End
   Begin VB.TextBox txtSource
      Height          =   285
      Left            =   1110
      TabIndex        =   2
      Top             =   450
      Width           =   3945
   End
   Begin VB.TextBox txtPath
      Height          =   255
      Left            =   1110
      TabIndex        =   1
      Top             =   1260
      Width           =   3945
   End
   Begin VB.CommandButton cmdCopy
      Caption         =   "复制"
      Height          =   375
      Left            =   1920
      TabIndex        =   0
      Top             =   1980
      Width           =   1275
   End
   Begin VB.Label lblMsg
      AutoSize        =   -1  'True
      Caption         =   "目标路径:"
      Height          =   180
      Index           =   1
      Left            =   180
      TabIndex        =   4
      Top             =   1320
      Width           =   810
   End
   Begin VB.Label lblMsg
      AutoSize        =   -1  'True
      Caption         =   "源路径:"
      Height          =   180
      Index           =   0
      Left            =   180
      TabIndex        =   3
      Top             =   510
      Width           =   630
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) 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
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) 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, lpOverlapped As Any) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_ALWAYS = 4
Private Const FILE_READ_ATTRIBUTES = (&H80)
Private Const FSCTL_GET_RETRIEVAL_POINTERS = 589939

Private Type RETRIEVAL_POINTERS_BUFFER
    dwExtentCount As Long
    bytStartingVcn(7) As Byte '这些都可以使用LARGE_INTEGER类型代替
    bytNextVcn(7) As Byte '这些都可以使用LARGE_INTEGER类型代替
    bytLcn(7) As Byte '这些都可以使用LARGE_INTEGER类型代替
    lngTmp As Long
End Type

Private Type LARGE_INTEGER
    LowPart As Long
    HighPart As Long
End Type

Private Sub cmdCopy_Click()
    Dim strSamPath As String
'    strSamPath = GetSystemPath & "/Config/Sam"
    strSamPath = txtSource.Text
    If CopySamFile(strSamPath, txtPath.Text) Then
        MsgBox "复制完毕！！", vbInformation, "提示"
    Else
        MsgBox "复制错误！！", vbCritical, "提示"
    End If
End Sub

'获取系统目录路径
Private Function GetSystemPath() As String
    Dim strTmp As String
    strTmp = String(260, Chr(0))
    GetSystemDirectory strTmp, 260
    strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)
    GetSystemPath = strTmp
End Function

Private Function GetFileClusters(ByVal strFileName As String, ByVal lngClusterSize As Long, lngClCount As Long, lngFileSize As Long) As Long()
    Dim hFile As Long
    Dim lngOutSize As Long
    Dim lngBytes As Long, lngCls As Long, lngCnCount As Long, r As Long, lngCount As Long, i As Long, j As Long
    Dim lngClusters() As Long
    Dim bytInBuf(7) As Byte
    Dim objOutBuf As RETRIEVAL_POINTERS_BUFFER
    Dim bytOutBuff() As Byte
    hFile = CreateFile(strFileName, FILE_READ_ATTRIBUTES, _
                       FILE_SHARE_READ Or FILE_SHARE_WRITE Or FILE_SHARE_DELETE, _
                       ByVal 0&, OPEN_EXISTING, 0, 0)
    If hFile <> INVALID_HANDLE_VALUE Then
        lngFileSize = GetFileSize(hFile, 0)
        lngOutSize = 32 + (lngFileSize / lngClusterSize) * 16
        ReDim bytOutBuff(lngOutSize - 1)
        If DeviceIoControl(hFile, FSCTL_GET_RETRIEVAL_POINTERS, bytInBuf(0), 8, bytOutBuff(0), lngOutSize, lngBytes, ByVal 0&) Then
            lngClCount = (lngFileSize + lngClusterSize - 1) / lngClusterSize
            CopyMemory objOutBuf, bytOutBuff(0), 32
            For r = 0 To objOutBuf.dwExtentCount - 1
                CopyMemory j, objOutBuf.bytLcn(4), 4
                For i = lngClCount To 0 Step -1
                    ReDim Preserve lngClusters(0 To lngCls)
                    lngClusters(lngCls) = j
                    j = j + 1
                    lngCls = lngCls + 1
                Next
            Next
            CloseHandle hFile
            GetFileClusters = lngClusters
        End If
    End If
End Function

Private Function CopySamFile(ByVal strSamPath As String, ByVal strDestPath As String) As Boolean
    Dim lngClusterSize As Long
    Dim lngClusters() As Long
    Dim lngClCount As Long, lngFileSize As Long, lngBytes As Long
    Dim hDrive As Long, hFile As Long
    Dim lngSecPerCl As Long, lngBtPerSec As Long, r As Long
    Dim curTmp As Currency
    Dim ligNo As LARGE_INTEGER
    Dim bytBuff() As Byte
    GetDiskFreeSpace Left(strSamPath, 2), lngSecPerCl, lngBtPerSec, ByVal 0&, ByVal 0&
    lngClusterSize = lngSecPerCl * lngBtPerSec
    On Error GoTo ErrHandle
    lngClusters = GetFileClusters(strSamPath, lngClusterSize, lngClCount, lngFileSize)
    hDrive = CreateFile("//./" & Left(strSamPath, 2), GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hDrive <> INVALID_HANDLE_VALUE Then
        hFile = CreateFile(strDestPath, GENERIC_WRITE, 0, ByVal 0, OPEN_ALWAYS, 0, 0)
        If hFile <> INVALID_HANDLE_VALUE Then
            For r = 0 To lngClCount - 1
                curTmp = CCur(lngClusterSize) * CCur(lngClusters(r)) / 10000
                CopyMemory ligNo, curTmp, Len(ligNo)
                Call SetFilePointer(hDrive, ligNo.LowPart, ligNo.HighPart, 0)
                If lngFileSize < lngClusterSize Then
                    ReDim bytBuff(lngFileSize - 1)
                    Call ReadFile(hDrive, bytBuff(0), lngFileSize, lngBytes, ByVal 0&)
                    Call WriteFile(hFile, bytBuff(0), lngFileSize, lngBytes, ByVal 0&)
                    Exit For
                Else
                    ReDim bytBuff(lngClusterSize - 1)
                End If
                Call ReadFile(hDrive, bytBuff(0), lngClusterSize, lngBytes, ByVal 0&)
                Call WriteFile(hFile, bytBuff(0), lngClusterSize, lngBytes, ByVal 0&)
                lngFileSize = lngFileSize - lngBytes
                Debug.Print ligNo.LowPart; ligNo.HighPart
            Next
        End If
        CloseHandle hFile
    End If
    CloseHandle hDrive
    CopySamFile = True
    Exit Function
ErrHandle:
    If hDrive <> -1 Then CloseHandle hDrive
    If hFile <> -1 Then CloseHandle hFile
End Function

Private Sub cmdExit_Click()
    Unload Me
End Sub