Копирование файла методом чтения секторов с диска

Здесь можно найти готовые «кирпичики» — части кода, пригодные для построения более крупных проектов, а также решения различных типовых и не очень задач на VB.

Модератор: Brickgroup

Teranas
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 224
Зарегистрирован: 13.12.2008 (Сб) 4:26
Откуда: Новосибирск

Копирование файла методом чтения секторов с диска

Сообщение Teranas » 18.10.2016 (Вт) 1:38

Копирование файла методом чтения секторов с диска
Будут конструктивные замечания, пишите, буду благодарен

Код: Выделить всё
Attribute VB_Name = "mod_GetSecFile"
Option Explicit
'------------------------------------------------------------------------------------
' VB6
' Копирование файла методом чтения секторов с диска
' В основном данный метод предназначен для копирования фалов блокированных системой:
' %WinDir%\system32\config\SAM, %WinDir%\system32\config\System и так далее.
' Копирование больших файлов этим методом не рационально по времени.
'------------------------------------------------------------------------------------
' CopyFileCL(File, ToFile) - Основная функция
' File - Читаемый файл с полным маршрутом
' ToFile - Файл назначения с полным маршрутом
'------------------------------------------------------------------------------------

Private Const FSCTL_GET_RETRIEVAL_POINTERS = 589939

Private Enum eGenFile
  GENERIC_ALL = &H10000000
  GENERIC_EXECUTE = &H20000000
  GENERIC_WRITE = &H40000000
  GENERIC_READ = &H80000000
End Enum

Private Const CREATE_NEW            As Long = 1
Private Const CREATE_ALWAYS         As Long = 2
Private Const OPEN_EXISTING         As Long = 3
Private Const OPEN_ALWAYS           As Long = 4
Private Const TRUNCATE_EXISTING     As Long = 5
Private Const FILE_SHARE_READ       As Long = 1
Private Const FILE_SHARE_WRITE      As Long = 2
Private Const FILE_SHARE_DELETE     As Long = 4
Private Const FILE_READ_ATTRIBUTES  As Long = &H80
Private Const FILE_BEGIN            As Long = 0
Private Const FILE_CURRENT          As Long = 1

Private Type STARTING_VCN_INPUT_BUFFER
  StartingVcnH      As Long   ' Large_Integer
  StartingVcnL      As Long
End Type

Private Type tExtents
  NextVcnH          As Long   ' Large_Integer
  NextVcnL          As Long   ' количество кластеров в цепочке
  LcnH              As Long   ' Large_Integer
  LcnL              As Long   ' номер первого кластера цепочки
End Type

Private Type RETRIEVAL_POINTERS_BUFFER
  dwExtentCount     As Long
  StartVcnH         As Long   ' Large_Integer
  StartVcnL         As Long   ' номер первой цепочки кластеров файла
  'NL() As tExtents
End Type

Private Type SECURITY_ATTRIBUTES3
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type

Private Type OVERLAPPED3
  Internal As Long
  InternalHigh As Long
  Offset As Long
  OffsetHigh As Long
  hEvent As Long
End Type

Private Type FILETIME3
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA3
  dwFileAttributes As Long
  ftCreationTime As FILETIME3
  ftLastAccessTime As FILETIME3
  ftLastWriteTime As FILETIME3
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * 260
  cAlternate As String * 14
End Type
 
Private Declare Function GetDiskFreeSpaceA Lib "kernel32" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByVal lpInBuffer As Long, ByVal nInBufferSize As Long, ByVal lpOutBuffer As Long, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CreateDirectoryA Lib "kernel32" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES3) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function FindFirstFileA Lib "kernel32" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA3) As Long
Private Declare Function FindNextFileA Lib "kernel32" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA3) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

Private StartVcn As RETRIEVAL_POINTERS_BUFFER, lClusters() As tExtents
Private fSize As Double, ClusterSize As Long, sDrv As String

Private Function FileCreateT(ByVal sFile As String) As Long
  ' Создать Файл
  FileCreateT = CreateFileA(sFile, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, OPEN_ALWAYS, 0&, ByVal 0&)
End Function
Private Function FileRW(GlobAdr As Double, hFile As Long, buf() As Byte, nBuf As Long, bWrite As Boolean) As Long
  ' Прочесть Блок по адресу GlobBlockAdr
  Dim OL As OVERLAPPED3, AdrLow As Long, AdrHigh As Long
  AdrLow = DoubleTo2Long(GlobAdr, AdrHigh)
  OL.Offset = AdrLow: OL.OffsetHigh = AdrHigh
  If bWrite Then
    WriteFile hFile, VarPtr(buf(0)), nBuf, FileRW, VarPtr(OL)
  Else
    ReadFile hFile, VarPtr(buf(0)), nBuf, FileRW, VarPtr(OL)
  End If
End Function

Private Function FileSizeT(hFileT As Long) As Double
  ' Определить Размер Файла по открытому идентификатору файла
  Dim BegAdrLow As Long, BegAdrHigh As Long
  BegAdrLow = GetFileSize(hFileT, BegAdrHigh)
  FileSizeT = Unit2Long(BegAdrHigh, BegAdrLow)
End Function

Private Function GetFileClusters(ByVal sFile As String) As Long
  ' Получаем список кластеров файла в виде массива lClusters() со структурами tExtents
  Dim hFile As Long, lBytes As Long, lCount As Long, LenSV As Long, s As String
  Dim OutBuf() As Byte, OutSize As Long, InBuf As STARTING_VCN_INPUT_BUFFER
  Erase lClusters(): LenSV = Len(StartVcn)
  sDrv = GetCharDrv(sFile)   ' Получаем букву диска из полного имени файла (C:)
  If Len(sDrv) <> 2 Then Exit Function
  ClusterSize = GetClusterSize(sDrv)  ' Узнаём размер кластера диска
  If ClusterSize <= 0 Then Exit Function
  ' Открываем файл в режиме чтения
  hFile = CreateFileA(sFile, FILE_READ_ATTRIBUTES, FILE_SHARE_READ Or FILE_SHARE_WRITE Or FILE_SHARE_DELETE, ByVal 0&, OPEN_EXISTING, &HFFF&, ByVal 0&)
  If hFile <> -1 Then
    fSize = FileSizeT(hFile) ' Узнаём размер файла
    If fSize > 0 Then
      OutSize = (fSize \ ClusterSize) * 16 + 32 ' Размер буфера с информацией о кластерах занимаемых файлом
      ReDim OutBuf(OutSize - 1) ' Установить размер буфера
      ' Чтение информации о кластерах файла в буфер -> OutBuf()
      If DeviceIoControl(hFile, FSCTL_GET_RETRIEVAL_POINTERS, ByVal VarPtr(InBuf), Len(InBuf), ByVal VarPtr(OutBuf(0)), OutSize, lBytes, ByVal 0&) Then
        If lBytes >= LenSV Then
          ' Читаем кол-во элементов (tExtents)
          Call RtlMoveMemory(ByVal VarPtr(StartVcn), ByVal VarPtr(OutBuf(0)), LenSV)
          If lBytes > LenSV Then
            ' Кол-во элементов (tExtents)
            GetFileClusters = StartVcn.dwExtentCount ' (lBytes - LenSV) \ 16
            ReDim lClusters(GetFileClusters) ' Установить размер матрицы (tExtents)
            ' Копируем информацию о кластерах в матрицу со структурами (tExtents)
            Call RtlMoveMemory(ByVal VarPtr(lClusters(0)), ByVal VarPtr(OutBuf(LenSV)), lBytes - LenSV)
            ' lClusters().Lcn - номер первого кластера цепочки
            ' lClusters().NextVcnL - количество кластеров в цепочке
          End If
        End If
      End If
    End If
    Call CloseHandle(hFile)
  End If
  Erase OutBuf()
End Function

Private Function GetClusterSize(sDrv As String) As Long
  Dim Sec1 As Long, Byte1 As Long, FreeClas1 As Long, NumClas1 As Long
  GetDiskFreeSpaceA sDrv, Sec1, Byte1, FreeClas1, NumClas1
  GetClusterSize = Sec1 * Byte1
End Function

Private Function GetCharDrv(sFile As String) As String
  If InStr(vbNull, sFile, ":") = 2 Then
    GetCharDrv = Left$(sFile, 2)
  End If
End Function

Private Function LeftNameFile(PathA As String) As String
  ' Выделение пути к файлу - из полного пути
  Dim iT As Integer
  iT = InStrRev(PathA, "\")
  If (iT > 0) Then LeftNameFile = Left$(PathA, iT)
End Function

Public Function UboundS(s() As String) As Long
  On Local Error Resume Next
  UboundS = UBound(s())
  If Err.Number <> 0 Then
    UboundS = -1: Err.Clear
  End If
End Function

Private Function PathDelK(PathK As String) As String
  ' Удалить последнии "\" в строке
  Dim s1 As String
  s1 = Trim$(PathK)
  While Right$(s1, 1) = "\"
    s1 = Left$(s1, Len(s1) - 1)
  Wend
  PathDelK = s1
End Function

Private Function PathPlusK(PathK As String) As String
  ' Добавить к маршруту каталога "\
  If Len(PathK) > 0 Then
    If Right$(PathK, 1) = "\" Then
      PathPlusK = PathK
    Else
      PathPlusK = PathK & "\"
    End If
  End If
End Function

Private Function NewDir(ByVal sPath As String) As Boolean
  ' Создать новый каталог
  Dim sa1 As SECURITY_ATTRIBUTES3, sTmp As String, i As Integer, s() As String
  sPath = PathDelK(sPath)
  If IsFile(sPath, True) Then
    NewDir = True
  Else
    If Len(sPath) > 0 Then
      s() = Split(sPath, "\")
      sTmp = s(0)
      For i = 1 To UboundS(s())
        sTmp = sTmp & "\" & s(i)
        Call CreateDirectoryA(sTmp, sa1)
      Next i
      NewDir = IsFile(sPath, True)
    End If
  End If
End Function
Private Function LongToDouble(MinusLong As Long) As Double
' Переводит Отрицательное LONG число в Положительное Double
  If MinusLong < 0 Then
    LongToDouble = 4294967296# + MinusLong
  Else
    LongToDouble = MinusLong
  End If
End Function
Private Function Unit2Long(High As Long, Low As Long) As Double
  ' Объединение Двух Long чисел в одно Double
  Unit2Long = High * 4294967296# + LongToDouble(Low)
End Function
Private Function DoubleToLong(ByVal FDouble As Double) As Long
  ' Перевод Числа в формате Double в Long
  If (FDouble <= 2147483647) Then
      DoubleToLong = FDouble
  Else
      DoubleToLong = FDouble - 4294967296#
  End If
End Function
Private Function DoubleTo2Long(FDouble As Double, High As Long) As Long
' Делит Double на два LONG числа
  If FDouble = 0 Then High = 0: Exit Function
  High = DoubleToLong(Fix(FDouble / 4294967296#))
  DoubleTo2Long = DoubleToLong(FDouble - (High * 4294967296#))
End Function

Private Function IsDrv(sDrv As String) As Boolean
  ' Проверить существование логического диска
  If Len(sDrv) = 2 Then
    If Right$(sDrv, 1) = ":" Then IsDrv = True
  End If
End Function
Public Function IsFile(ByVal sFile As String, Optional ByVal bPath As Boolean = False) As Boolean
  ' Проверить существование файла или каталога
  Dim FFD As WIN32_FIND_DATA3, hFind As Long
  sFile = PathDelK(sFile)
  hFind = FindFirstFileA(sFile, FFD)
  If hFind <> -1 Then
    If (FFD.dwFileAttributes And vbDirectory) > 0 Then
      IsFile = bPath
    Else
      IsFile = Not bPath
    End If
    FindClose hFind
  Else
    If bPath Then
      IsFile = IsDrv(sFile)
    End If
  End If
End Function

Public Function CopyFileCL(ByVal sFile As String, ByVal sToFile As String) As Boolean
  ' Копирование файла методом чтения секторов
  Dim hFile1 As Long, hFile2 As Long, buf() As Byte, d As Double
  Dim ret As Long, FileSize As Double
  Dim i As Long, j As Long, lCount As Long ' , F As Integer
  If Not NewDir(LeftNameFile(sToFile)) Then Exit Function
  If GetFileClusters(sFile) > 0 Then ' Получаем список кластеров файла
    ' Открываем диск в режиме чтения
    hFile1 = CreateFileA("\\.\" & sDrv, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, &HFFF&, ByVal 0&)
    If hFile1 <> -1 Then
      ' Создаём файл назначения и открываем его на запись
      'hFile2 = CreateFileA(sToFile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
      hFile2 = FileCreateT(sToFile)
      ' Установить размер буфера для обмена информацией
      If (hFile2 <> -1) Then
        ReDim buf(ClusterSize - 1)
        ' StartVcn.StartVcnL - номер первой цепочки кластеров файла
        For i = 0 To StartVcn.dwExtentCount - 1 ' количество элементов tExtents
          ' В структуре (tExtents) -> lClusters(i).NextVcnL на самом деле указывается
          ' не кол-во кластеров в цепочке, а порядковый номер кластера относительно файла,
          ' с которого начинается цепочка, поэтому делаем так...
          If i = 0 Then
            lCount = lClusters(i).NextVcnL - 1
          Else
            lCount = lClusters(i).NextVcnL - lClusters(i - 1).NextVcnL - 1
          End If
          For j = 0 To lCount  ' Кол-во кластеров в цепочке(Уже точное)
            d = Unit2Long(lClusters(i).LcnH, lClusters(i).LcnL)
            d = (d * ClusterSize) + (j * ClusterSize) ' Приращение адреса
            ' Читаем кластер с диска по адресу D
            ret = FileRW(d, hFile1, buf(), ClusterSize, False)
            ' Следующая строка нужна для того, что бы в конец записываемого файла не попал мусор
            If (FileSize + ClusterSize) > fSize Then ClusterSize = (fSize - FileSize)
            ' Записываем кластер в файл назначения
            If ClusterSize > 0 Then
              Call FileRW(FileSize, hFile2, buf(), ClusterSize, True)
              FileSize = FileSize + ClusterSize
            Else
              Exit For
            End If
            'Call ControlPause(CDbl(ClusterSize)) ' Контроль паузы и вывод информации
            'If BeginProcess = False Then Exit For
          Next j
        Next i
        If fSize <= FileSize Then CopyFileCL = True
        ' Осторожно двери закрываются
        Call CloseHandle(hFile2)
      End If
      Call CloseHandle(hFile1)
    End If
  Else
    If fSize = 0 Then
      ' Создаём файл нулевой длины, так как функция не вернула кол-во кластеров
      hFile2 = FileCreateT(sToFile)
      Call CloseHandle(hFile2)
      CopyFileCL = True
    End If
  End If
End Function
Вложения
TEST.7Z
(5.41 Кб) Скачиваний: 240
С уважением, Андрей.

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Re: Копирование файла методом чтения секторов с диска

Сообщение alibek » 18.10.2016 (Вт) 8:38

Наверное неправильно это называть копированием.
Оно ведь не сохраняет атрибуты файла, потоки, разрешения.
Lasciate ogni speranza, voi ch'entrate.

Teranas
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 224
Зарегистрирован: 13.12.2008 (Сб) 4:26
Откуда: Новосибирск

Re: Копирование файла методом чтения секторов с диска

Сообщение Teranas » 18.10.2016 (Вт) 17:00

Хм... Интересно, а как назвать копирование файлов по-другому? :shock:
Основная цель этого модуля скопировать файлы заблокированные системой,
а остальное можно прикрутить по собственному вкусу...
С уважением, Андрей.

Mikle
Изобретатель велосипедов
Изобретатель велосипедов
Аватара пользователя
 
Сообщения: 4147
Зарегистрирован: 25.03.2003 (Вт) 14:02
Откуда: Туапсе

Re: Копирование файла методом чтения секторов с диска

Сообщение Mikle » 18.10.2016 (Вт) 19:55

Teranas писал(а):Интересно, а как назвать копирование файлов по-другому?

Копирование данных из файла.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: Копирование файла методом чтения секторов с диска

Сообщение Хакер » 19.10.2016 (Ср) 8:59

Teranas писал(а):Хм... Интересно, а как назвать копирование файлов по-другому? :shock:

Дупликация содержимого файлов.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

bon818
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 267
Зарегистрирован: 29.08.2009 (Сб) 4:49
Откуда: Ташкент

Re: Копирование файла методом чтения секторов с диска

Сообщение bon818 » 19.10.2016 (Ср) 19:40

Хакер писал(а):Хм... Интересно, а как назвать копирование файлов по-другому? Дупликация содержимого файлов.

Клонирование(
Помидор шмомидор.
Здесь главное, что это сложный, интересный и достаточно редкий код, для любого языка программирования.
Другое дело что "Копирование файла методом чтения секторов с диска" не такая и интересная и мало пригодная функция.
А вот сделать с помощью этого примера, очень скоростной поиск файлов на диске, это уже интересней.
Хороший кирпич, его здесь не хватало, спасибо.


Вернуться в Кирпичный завод

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 5

    TopList