VB拷贝SAM文件

原创 2007年09月30日 13:37:00

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
 

vb文件拷贝

  • 2014年03月18日 21:58
  • 3KB
  • 下载

VB版U盘文件拷贝工具uFileSys

  • 2011年09月10日 22:24
  • 35KB
  • 下载

SAM/BAM格式文件操作软件samtools使用说明

SAM和BAM是序列比对之后常用的输出格式,比如tophat输出BAM格式,bowtie和bwa等都采用了SAM格式。BAM格式其实就是SAM格式的二进制格式,占用存储空间更小。samtools由中国...

bowtie结果sam文件解读

sam文件解读 @HD    VN:1.0    SO:unsorted @SQ    SN:chr1    LN:249250621 @SQ    SN:chr2    LN:24319937...

#AT91SAM9260 linux 系统移植日志------jffs2文件系统定制

AT91SAM9260 linux 系统移植日志——jffs2文件系统定制2011-9-13 目标:熟练u-boot、linux系统、文件系统的优化裁剪;精通系统移植;精通linux系统、文件系统、...

基于AT91SAM9261EK的嵌入式Linux2.6.32+Yaffs2 根文件系统移植成功

经过几天的尝试与摸索,终于把yaffs2根文件系统移植到AT91SAM9261EK上,移植中出现了一些问题,经过查找网络资源并分析,总结,终于测试成功。 (1)Bootstrap V3.8.5 :官方...

生信:2:sam格式文件解读

第二章:生物信息分析第一节:解读sam格式文件1,SAM文件格式介绍SAM(The Sequence Alignment / Map format)格式,即序列比对文件的格式,详细介绍文档:http:...

Linux(AT91SAM9260)增加UBIFS文件系统支持

一、 编写目的 2 二、 UBIFS文件系统移植 2 1. 内核配置 2 2. 挂载UBIFS分区至/mnt目录 3 3. 制作UBIFS文件系统镜像 6   一、编写目的 UBIF...

windows XP 系统 SAM 文件问题( 基于忘记开机密码 )

这几天被 SAM 搞得非常无语......忘记XP密码后,我就到网上去搜索( 我有多个系统), 绝大部分的答案 都是说通过 其他系统 或者 PE 进去 删除 system32 \ config \ ...
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB拷贝SAM文件
举报原因:
原因补充:

(最多只允许输入30个字)