frmfileanddiroperate.frm

磁盘FAT扇区数据读写操作 Ver 1.20(更新版)

   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 bIsFind As Boolean                     '是否是查找
Dim sFileName As String                    '中间变量
Dim bIsDel As Boolean                      '是否是删除
Dim bIsCrash As Boolean                    '是否是粉碎
Dim tDirInfo As DirInfo                    '返回数据一个信息类
Dim bRet As Boolean
Dim lStartTime As Long
Dim sDisk As String
Dim lLastCluster() As Long
Dim lLastClusterNum As Long
Dim sPathOut As String
Dim bPathIsRoot As Boolean

lStartTime = GetTickCount()
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
lTempClusterNum = 0
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 tDirInfo.sDir = tDirInfo.sDisk Then
      bPathIsRoot = True
   End If
   If iOperateFlag <> 5 Then                                        '不是查找
      
      If iOperateFlag <= 2 Then
         If Not bPathIsRoot Then
            sPathOut = Trim(Text1) & "\" & tDirInfo.sDir
            MkDir sPathOut                                          '如果是复制或刻隆就要先创建一个文件夹
         Else
            sPathOut = Trim(Text1)
         End If
         
      End If
      Label3.Caption = sLabelCaption & "  " & Text2
      DoEvents
      If iOperateFlag = 4 Then                                      '前面返回的信息中这个信息不对，要更正
         tDirInfo.bIsCrash = True
      End If
      If iOperateFlag = 3 And Not bPathIsRoot Then                  '在粉碎功能和根目录时这个目录项不加入其中，要单独处理
         TakeDataInToDirInfoArray tDirInfo                          '因为在删除状态要修改数据，把信息存入数组
      End If                                                        '在粉碎状态时就不必了
      If bPathIsRoot And lFileSystemType = 1 Then
         FindNameIterate tDirInfo.sDisk, tDirInfo.Cluster, sPathOut, sReadFile, True, iOperateFlag    '迭代处理
      Else
         FindNameIterate tDirInfo.sDisk, tDirInfo.Cluster, sPathOut, sReadFile, False, iOperateFlag   '迭代处理
      End If
      If iOperateFlag >= 3 Then                                     '删除则还要把这个最后的文件夹也删掉
         Label3.Caption = "开始删除目录项......"
         If iOperateFlag = 3 Then
            DoneAllDirSector                                        '只是一般删除时，集中处理所有的目录项
         Else
            If Not bPathIsRoot Then                                 '只要路径是根目录，则不能操作
               WriteDelFlagIntoDirSector tDirInfo                   '在文件粉碎时，把最后一个文件夹的目项删除标记写入这个文件夹的位置
            End If
         End If
         With tDirInfo
              If Not bPathIsRoot Then                               '只要路径是根目录，则根目录簇号排除在外
                 GetAllCluster CodeCluster(), .sDisk, .Cluster, lTempClusterNum '把这个最后的文件夹的簇号也收集起来
              Else
                 If lFileSystemType = 2 And iOperateFlag = 4 Then   '在FAT32系统且在粉碎状态时，把根目录簇号取回来
                    GetAllCluster lLastCluster(), .sDisk, .Cluster, lLastClusterNum  '在FAT32中把根目录簇号单独收集起来处理
                 End If
              End If
              DoneAllCluster CodeCluster(), .sDisk                   '删除所有的簇号
              If iOperateFlag = 4 Then
                 CrashAllClusterTo CodeCluster(), .sDisk             '所有簇号所对应的簇都清0
                 If bPathIsRoot Then
                    CrashRoot .sDisk, lLastCluster(), lFileSystemType '处理根目录(根目录清0)
                 End If
              End If
         End With
      End If
   Else                                                              '返回文件夹信息
      If Not bPathIsRoot Then
         sPathOut = Left(sReadFile, InStrRev(sReadFile, "\", , vbBinaryCompare) - 1) & tDirInfo.sDir
      Else
         sPathOut = Trim(Text2)
      End If
      MsgBox "找到目标:" & sPathOut & ",起始簇号：" & 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 = "正在删除："
       End If
       Label3.Caption = sLabelCaption & sReadFile
       DelDiskFile sReadFile, bIsDel, bIsCrash                      '删除单个文件
    End If
End If
'CloseDisk                                                             '关闭磁盘
Label3.Caption = "处理完毕！"
Debug.Print "do it take" & GetTickCount() - lStartTime & "ms"
End Sub

'----------------------------------------------
' Procedure  : CrashRoot
' Auther     : WangWeiSheng
' Date       : 2007-10-08 11:08:35
' Input      : RootCluster()      FAT32时输入的所有根目录簇号,FAT16不需要
' Input      : llFileSystmeType   何种文件系统
' Input      : sDisk              盘符
' Purpose    : 对于根目录要单独处理,FAT32要输入一个根目录簇号数组，而FAT16就不需要，因FAT16根目录位置和大小都是固定的
'----------------------------------------------
Private Function CrashRoot(sDisk As String, RootCluster() As Long, llFileSystemType As Long)
Dim ii As Long
Dim Data() As Byte
Dim lByteToWrite As Long
Dim dStartLoc As Double
Dim dCluster As Double

OpenDisk "\\.\" & sDisk
If llFileSystemType = 2 Then
    For ii = 0 To UBound(RootCluster)
        dCluster = LongToUnsigned(RootCluster(ii))
        If dCluster < lFileEndFlag Then
           lByteToWrite = lBytePerSector * lSectorPerCluster
           dStartLoc = (lDataStartSector + (dCluster - &H2) * lSectorPerCluster) * lBytePerSector
           ReDim Data(lByteToWrite)
           WriteDiskbyPos dStartLoc, lByteToWrite, Data()
        End If
    Next
ElseIf llFileSystemType = 1 Then
    lByteToWrite = lBytePerSector * lRootSector
    ReDim Data(lByteToWrite)
    WriteDiskbyPos lRootEntries, lByteToWrite, Data()
End If
CloseDisk
End Function

'----------------------------------------------
' Procedure  : ReadDiskFile
' Auther     : WangWeiSheng
' Input      : sReadFile      要读出的文件全路径，或者是文件夹全路径
' Input      : sSaveFileName  要保存的文件名全路径
' OutPut     : Boolean        读出是否成功
' Purpose    : 把一个文件直接从磁盘上读出
'----------------------------------------------
Private Function ReadDiskFile(sReadFile As String, sSaveFileName As String, bIsFind As Boolean, tDirInfo As DirInfo) As Boolean
Dim sFileSplit() As String
Dim dFileSize As Double      '返回文件尺寸
Dim dStartLoc As Double      '计算出文件数据区起始地址
'Dim dTempStartLoc As Double  '中间目录起始地址
Dim bIsDir As Boolean        '是否是文件夹
Dim bIsRoot As Boolean       '是否是根目录
Dim bIsLast As Boolean       '是否是这个路径的最后部分，如：c:\windows\system32\config\sam中，sam就是这个路径中最后部分
Dim i As Long
Dim sRetName As String       '返回的名字
Dim sRetPath As String       '返回的全路径
Dim bbIsFind As Boolean      '要对这个参数進行控制，因为没有到最后部分时，也要返回许多无用数据就没必要
'Dim tDirInfoOut As DirInfo
Dim dCodeCluster As Double   '起始簇号

If Right(sReadFile, 1) = "\" Then Exit Function
sFileSplit = Split(sReadFile, "\")
GetSomeParameter (sFileSplit(0))
If lFileSystemType = -1 Then Exit Function
'dTempStartLoc = lRootEntries '
If lFileSystemType = 1 Then                            '确定最初的起始地址FAT16和FAT32是不一样的
   dCodeCluster = &H2 - lRootSector / lSectorPerCluster
ElseIf lFileSystemType = 2 Then
   dCodeCluster = &H2
End If
If UBound(sFileSplit) = 0 Then
    With tDirInfo
         .dStartLoc = 0
         .Cluster = dCodeCluster
         .sDisk = sFileSplit(0)
         .sDir = sFileSplit(0)
    End With
    ReadDiskFile = True
    Exit Function
End If
sRetPath = sFileSplit(0)
For i = 1 To UBound(sFileSplit)
    If lFileSystemType = 1 Then
        If i = 1 Then
           bIsRoot = True               '是否处于根目录
        Else
           bIsRoot = False
        End If
    ElseIf lFileSystemType = 2 Then     'FAT32已经没有连续固定大小的根目录，根目录与文件夹目录一样
       bIsRoot = False
    End If
    If i <> UBound(sFileSplit) Then     '
       bIsDir = True
       bIsLast = False
       bbIsFind = False
    Else
       If Option5.Value Then
          bIsDir = True
       Else
          bIsDir = False
       End If
       bIsLast = True
       bbIsFind = bIsFind
    End If

    sRetName = FindDirName(sFileSplit(0), dCodeCluster, sFileSplit(i), dFileSize, tDirInfo, bIsDir, bIsRoot, False, False, bIsLast, bbIsFind)
    If sRetName = "No Name" Then Exit For
    sRetPath = sRetPath & "\" & sRetName
    '起始地址 = 数据区起始地址 + ( 返回的簇偏移号 - 基数&H2 ) * 每簇扇区数 * 每扇区字节数
'    dTempStartLoc = lDataEntries + (lCodeCluster - &H2) * lSectorPerCluster * lBytePerSector
Next

If Not bIsFind Then
    If sRetName <> "No Name" And Option4.Value Then