frmfileanddiroperate.frm

FAT硬盘格式读写程序,希望能有所裨益.

Option Explicit

Private Const MaxLFNPath = 260
Private Const OFFSET_4 = 4294967296#
Private Const OFFSET_2 = 65536
'Private Const MAXINT_4 = 2147483647
'Private Const MAXINT_2 = 32767

Private Type WIN32File_FIND_DATA                '自定义一个Type
    bFileAttributes As Byte                     '文件属性
    iCreationTime As Integer                    '文件创建时间
    iCreationDate As Integer                    '文件创建日期
    iLastAccessDate As Integer                  '文件最后访问日期
    iLastModifyTime As Integer                  '文件最后修改时间
    iLastModifyDate As Integer                  '文件最后修改日期
    nFileSizeHigh As Long
    nFileSizeLow As Long
    bFileFlag As Byte                           'XP系统新增的判断文件名是用的大写字母还是小写字母
    dCurrentStartSector As Double               '所获取以上信息的扇区号
    iPosInCurrentStartSector As Integer         '获取以上位息在扇区号中的记录位置
    dOrigStartLoc As Double                     '把当前扇区属于哪个簇的起始位置记录下
'    bIsOverSector As Boolean                   '是否跨扇区
'    iLastNum As Integer                        '长文件名记录项标记最后一个的数值
'    cFileName As String * MaxLFNPath           '文件名
'    cShortFileName As String * 14              '短文件名
End Type
Private Type DirInfo                            '自定义一个包含文件夹信息的Type
      sDir As String                            '文件夹名称
      sDisk As String                           '磁盘名称
      Cluster As Double                         '该文件夹自己的目录内容起始簇号，如同一个文件的内容的起始簇号
      dStartLoc As Double                       '父目录起始地址
      lUp As Long                               '名称占用几个目录项
      lPos As Long                              '偏移到第几个目录项
      bIsCrash As Boolean                       '是否粉碎处理
      bIsOverCluster As Boolean                 '是否跨簇位置
      dOverStartLoc As Double                   '跨簇或扇区的起始地址
      lOverUp As Long                           '文件夹名称跨簇或扇区的部分占用几个目录项，注：一个目录项占用32个字节
End Type
Private Type SafeArray1d                        '1维数组的 SafeArray 定义
        cDims As Integer                        '维数
        fFeatures As Integer                    '标志
        cbElements As Long                      '单个元素的字节数
        clocks As Long                          '锁定计数
        pvData As Long                          '指向数组元素的指针
        cElements As Long                       '维定义，该维的元素个数
        Lbound As Long                          '该维的下界
 End Type
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long

Dim pBytesInLong() As Byte               '用于把字节直接变成Long型而不经过任何计算
Private SA1D As SafeArray1d
Private lPublicLong As Long              '定义一个公共交换的长整型数
Dim pBytesInInteger() As Byte
Private SA1DInt As SafeArray1d
Private lPublicInt As Integer
'以下定义几个要用的公共变量
Private lFatEntries As Long              'FAT表入口扇区偏移(本程序以FAT1开始)
Private lFatStartSector As Long          'FAT表入口起始扇区号
Private lRootEntries As Double           '根目录入口扇区偏移Cluster
Private lRootStartSector As Double       '根目录入口起始扇区
Private lCodeCluster As Double           '偏移簇号,这个数要定义大一些，在FAT32中这个数很大
Private lSectorPerFat As Double          '每FAT占的扇区数,这个数要定义大一些，在FAT32中这个数就很大
Private lReservedSector As Long          '保留扇区数
Private lRootSector As Long              '根目录所占扇区数
Private lFatNum As Long                  'FAT表个数
Private lBytePerSector As Long           '每扇区字节数
Private lSectorPerCluster As Long        '每簇扇区数
Private lDataEntries As Double           '数据区入口地址偏移
Private lDataStartSector As Double       '数据区入口起始扇区
Private lFileSystemType As Long          '文件系统类型 1为FAT16 2为FAT32 3为NTFS
Private lFileEndFlag As Double           '文件结束标志
Private hhToken As Long                  '恢复权取用
Private sToSaveFileName As String        '记录要保存的路径

Private iOperateFlag As Integer          '任务标记 如：1、2、3、4、5等
Private sLabelCaption As String

'----------------------------------------------
' Procedure  : ByteToLongInit
' Auther     : WangWeiSheng
' Input      : None
' OutPut     : None
' Purpose    : 把一个字节数组的起始地址同一个长整型数的地址等起来
'----------------------------------------------
Private Sub ByteToLongInit()
With SA1D
     .cDims = 1
     .fFeatures = 17
     .cbElements = 1
     .clocks = 0
     .pvData = VarPtr(lPublicLong)                         '使公共交换的长整形变量的指针与中间交换字节数组的指针等起来
     .cElements = 4
     .Lbound = 0
End With
CopyMemory ByVal VarPtrArray(pBytesInLong), VarPtr(SA1D), 4 '---使数组变量（其实就是个指针）指向我们自己创建的 SafeArray1d 结构

End Sub
'----------------------------------------------
' Procedure  : ByteToIntInit
' Auther     : WangWeiSheng
' Input      : None
' OutPut     : None
' Purpose    : 把一个字节数组的起始地址同一个整型数的地址等起来
'----------------------------------------------
Private Sub ByteToIntInit()
With SA1DInt
     .cDims = 1
'     .fFeatures = 17
     .cbElements = 1
     .clocks = 0
     .pvData = VarPtr(lPublicInt)                         '使公共交换的整形变量的指针与中间交换字节数组的指针等起来
     .cElements = 2
     .Lbound = 0
End With
CopyMemory ByVal VarPtrArray(pBytesInInteger), VarPtr(SA1DInt), 4 '---使数组变量（其实就是个指针）指向我们自己创建的 SafeArray1d 结构

End Sub



Private Sub wwBrowse_Click()
Dim vvOpenFile As OPENFILENAME
Dim sFileName As String
Dim ssFilter As String
Dim sDir As String

If Option4.Value Then
   ssFilter = "所有文件(*.*)" & Chr(0) & "*.*" & Chr(0)
   Text2 = GetDlgRtnFileName(1, vvOpenFile, Me.HWnd, ssFilter, "选择文件", "*.*" & Chr(0), sFileName)
   If StrComp(Text2.Text, "Cancel", vbTextCompare) = 0 Then
      Text2 = ""
      Exit Sub        '如果点的是“取消”按钮，则结束
   End If
Else
   sDir = SynBrowseForFolder(Me.HWnd, "请选择你的文件夹地址")
   If Len(sDir) = 0 Then Exit Sub
   Text2 = sDir
End If
End Sub
Private Sub wwBrowse1_Click()
Dim sDir As String
   sDir = SynBrowseForFolder(Me.HWnd, "请选择你的文件夹地址")
   If Len(sDir) = 0 Then Exit Sub
   Text1 = sDir
End Sub
Private Sub Option3_Click(Index As Integer)
iOperateFlag = Index + 1
End Sub

Private Sub wwDo_Click()
Dim sSaveFileName As String
Dim sReadFile As String
'Dim tDirInfo As DirInfo
Dim bIsFind As Boolean
Dim sFileName As String
Dim bIsDel As Boolean
Dim bIsCrash As Boolean
Dim tDirInfo As DirInfo
Dim dTempStartLoc As Double
Dim bRet As Boolean
Dim ClusterFile() As Long
Dim sDisk As String

If Len(Text2) = 0 Then Exit Sub                                     '处理目标不能为空
If Option3(0).Value Or Option3(1).Value Then                        '复制文件或文件夹没有保存位置
   If Len(Text1) = 0 Then
      MsgBox "没有保存位置！"
      Text1.SetFocus
      Exit Sub
   End If
End If
If StrComp(Text1, Text2, vbTextCompare) = 0 Then Exit Sub           '处理对象与保存对象不能相同
If Check1.Value = 1 Then
   getPrivileges hhToken, SE_DEBUG_NAME
End If
sReadFile = Trim(Text2)

If Option3(4).Value Then
   bIsFind = True
   sLabelCaption = "正在查找："
Else
   bIsFind = False
   sLabelCaption = "正在处理:"
End If
'sDisk = Left(sReadFile, 2)
'OpenDisk "\\.\" & sDisk                                             '打开磁盘

If Option5.Value Then                                               '处理文件夹 Dir
   bRet = ReadDiskFile(sReadFile, sSaveFileName, True, tDirInfo)    '如果是文件夹，则先取回包含路径最后部分的数据，包括(最后部分的父目录起始扇区号，最后部分在父目录扇区的记录位置，最后部分自己的起始扇区号, _
                                                                    '是否跨簇标记，跨簇后记录项的占用数等。)
   If Not bRet Then Exit Sub
   If iOperateFlag <> 5 Then                                        '不是查找
      If iOperateFlag <= 2 Then
         MkDir Trim(Text1) & "\" & tDirInfo.sDir                    '如果是复制或刻隆就要先创建一个文件夹
      End If
      Label3.Caption = sLabelCaption & "  " & Text2
      DoEvents
      FindNameIterate tDirInfo.sDisk, tDirInfo.Cluster, Trim(Text1) & "\" & tDirInfo.sDir, sReadFile, False, iOperateFlag          '迭代处理
      If iOperateFlag >= 3 Then                                     '删除则还要把这个最后的文件夹也删掉
         With tDirInfo
                
                WriteDelFlagIntoDirSector tDirInfo                  '把删除标记写入这个文件夹的位置
                OperateFileAllCluster ClusterFile(), .sDisk, .Cluster, True, False '删除FAT表内对应位置的簇号记录
           End With
      End If
   Else                                                             '返回文件夹信息
      sFileName = Left(sReadFile, InStrRev(sReadFile, "\", , vbBinaryCompare) - 1)      '取出路径中的文件名或是文件夹名
      MsgBox "找到目标:" & sFileName & "\" & tDirInfo.sDir & ",起始簇号：" & tDirInfo.Cluster
   End If
Else                                                                '这是处理文件  File
    Label3.Caption = sLabelCaption & sReadFile
    If Option3(0).Value Or Option3(1).Value Or Option3(4).Value Then
       If Option3(0).Value Or Option3(1).Value Then
          sFileName = Right(sReadFile, Len(sReadFile) - InStrRev(sReadFile, "\", , vbBinaryCompare))
          sSaveFileName = Trim(Text1) & "\" & sFileName
       End If
       bRet = ReadDiskFile(sReadFile, sSaveFileName, bIsFind, tDirInfo)        '处理文件，如果是查找则返回数据
       If iOperateFlag = 5 And bRet = True Then                     '如果是查找文件或是文件夹，则报告结果
          MsgBox "找到目标:" & sReadFile & ",起始簇号：" & tDirInfo.Cluster
       End If
    Else
       bIsDel = True
       If Option3(3).Value Then
          bIsCrash = True
          sLabelCaption = "正在粉碎："
       Else
          bIsCrash = False
          sLabelCaption = "正在删除："