📄 frmfileanddiroperate.frm
字号:
Exit Function
Else
GoTo Goon
End If
Else
Data = TempData
i = 0
GoTo GoToNextSector
End If
'-----------------------------------------
End Function
'----------------------------------------------
' Procedure : FindNameIterate 迭代查找
' Auther : WangWeiSheng
' Modfy : WangWeiSheng
' Data : 2007-09-16
' Input : sDisk 盘符
' Input : dCodeCluster 要读出的文件或文件夹的起始地址
' Input : sDirNameTo 要复制到哪一个文件夹
' Input : sDirNameCur 当前文件夹的名称
' Input : bIsRootEntry dCodeCluster所标示的是否是根目录，因为根目录的处理上限不一样,为True是根目录
' Input : iIterateFlag 是什么命令
' OutPut : String 返回找到的文件名或文件夹名
' OutPut : WffData 返回文件的许多内容，包括文件创建时间、日期、最后访问日期及最后修改时间日期等
' Purpose : 按目录查找文件或文件夹并返回找到的文件名或文件夹名和簇号并返回文件的尺寸
'----------------------------------------------
Private Function FindNameIterate(ByVal sDisk As String, ByVal dCodeCluster As Double, ByVal sDirNameTo As String, ByVal sDirNameCur As String, bIsRootEntry As Boolean, iIterateFlag As Integer) As String
Dim Data() As Byte '装载扇区数据
Dim tDirInfo() As DirInfo '定义一个文件夹信息数组，用来装载所有找到的文件夹，用于迭代处理
Dim Cluster() As Double '用于装载返回的所有文件夹的起始簇号，用于迭代调用
Dim ClusterFile() As Long '用于装载文件所占用的所有的簇号
Dim sDir() As String '用于记录所有找到的文件夹
Dim dFirstCluster As Double '用于记录文件夹第一次進入该过程时起始簇号
Dim dDirCodeCluster As Double '记录这个文件夹记录项的起始地址，用于最后删除这个没有的文件夹记录项
Dim i As Long, ll As Long, mm As Long '定义几个循环变量
Dim lTemp As Long, lStart As Long '一个临时交换变量,用于数组下标计数
Dim lUp As Long '扇区上限值
Dim bLengthFileNameFact As Boolean '找到的内容是否为长文件名
Dim FileNameByte() As Byte '装载文件名
Dim TempData() As Byte '取回跨簇或跨扇区数据的临时字节数组
Dim sName As String '取出文件名
Dim sExtName As String '取出扩展名
Dim sSaveFileName As String '保存的全路径文件名
Dim intLastPos As Long '最后一个长文件名记录项
Dim lPos As Long 'chr(0)的位置
Dim bIsDirFact As Boolean '实际检测是否是dir
Dim lBb As Long, BTemp As Byte
Dim lNum32Byte As Long '一个簇有多少个32字节
Dim bOverCluster As Boolean '定义一个是否跨越簇的标志
Dim bModifySector As Boolean '这义一个是否修改了扇区数据的标志，因为修改了就写回去，没有修改就没有写回去的必要
Dim CheckNum As Byte '长文件名中保存的与其关联的短文件名的校验值
Dim CheckSum As Byte '由短文件名计算出的校验值
Dim dPrevStartLoc As Double '在跨簇时记录前一个起始地址用于删除用
Dim dCurStartLoc As Double '记录跨簇或扇区时当前正在用的起始地址
Dim dFileSize As Double
Dim bIsCrash As Boolean
Dim dStartLoc As Double
Dim dSaveCluster As Double '暂时保存一下文件夹的簇号
Dim lOverNextStartPos As Long '记录跨簇或跨扇区后下一个记录开始位置就不是0，而是跨过上一个已处理的记录项开始
If iIterateFlag = 5 Then Exit Function
Select Case iIterateFlag
Case 1
sLabelCaption = "正在复制："
Case 2
sLabelCaption = "正在刻隆："
Case 3
sLabelCaption = "正在删除："
Case 4
sLabelCaption = "正在粉碎："
End Select
If iIterateFlag = 4 Then
bIsCrash = True
Else
bIsCrash = False
End If
If bIsRootEntry Then
lUp = lRootSector '因为会出现对硬盘扇区進行写操作，因此考虑对硬盘的保护，不采用对簇進行写操作，只考虑对当前扇区進行写操作，所以还是以扇区方式处理数据
Else '如果对簇進行写操作，就会出现这个簇的有些扇区没有数据更改，也進行了写操作,采用这个方法效率不是最高的
lUp = lSectorPerCluster '如果不是根目录就是一个簇的扇区数
End If
'lNumByte = lBytePerSector '每扇区多少字节
lNum32Byte = lBytePerSector / 32 - 1 '一个扇区有多少个32字节减去一个32字节
ReDim Data(lBytePerSector - 1) '每次读出一个扇区的字节数
dFirstCluster = dCodeCluster '把刚刚传入的这个文件夹的起始簇号保存起来，因为dCodeCluster在后面的操作中要发后变化，所以要保存起来
dStartLoc = lDataEntries + (dCodeCluster - &H2) * lSectorPerCluster * lBytePerSector '计算目录项的起始地址
Goon:
For i = 0 To lUp - 1 '循环查找每一个扇区
OpenDisk "\\.\" & sDisk
ReadDiskbyPos Data(), dStartLoc + i * lBytePerSector, lBytePerSector
CloseDisk
GoToNextSector: '跨簇或扇区的数据已经读出了，就不必再读一次了
If bOverCluster Then
lStart = lOverNextStartPos
Else
lStart = 0
End If
bOverCluster = False '跨簇标志复位
bModifySector = False '修改了数据标志复位
For mm = lStart To lNum32Byte '以32字节为单位，一个扇区512字节,一共16个32字节
DoEvents
If Data(mm * &H20) = &H0 Then '如果为0，表示这个扇区的数据到此为止，后边都没有了
mm = lNum32Byte
Exit For
End If
If Data(mm * &H20) <> &HE5 And Data(mm * &H20) <> &H2E Then '如果为&HE5则为已删除项，&H2E为当前目录标记，不予处理
bLengthFileNameFact = (Data(mm * &H20 + &HB) = &HF) '取出长文件名位置处标记是否为长文件名
If bLengthFileNameFact Then '长文件名用处理长文件名的方法
CheckNum = Data(mm * &H20 + &HD) '取出文件名校验值
BTemp = Data(mm * &H20) And &H60 '第6位为1表示长文件最后一个目录项
If BTemp Then '满足是最后一个的条件则处理，否则不处理
intLastPos = Data(mm * &H20) And &H1F '取出最后一个的序号
ReDim FileNameByte(intLastPos * 26) '定义装文件名的数组大小
lTemp = 0 '初始化
If mm + intLastPos > lNum32Byte Then '表示这个长文件名跨越扇区'此处要判断是否跨扇区OverFlowSector 只有长文件名才有可能跨越扇区
'跨越簇，就要先把后一簇中这个文件名的部分数据取回来
bOverCluster = True
lOverNextStartPos = mm + intLastPos - lNum32Byte
'首先判断是在根目录还是在簇中,因为两个的取回后面的数的方式不一样
If Not bIsRootEntry Then '这个时候是跨簇了，即不是根目录跨簇，因为根目录不是真正的跨簇
dPrevStartLoc = dStartLoc + i * lBytePerSector '保存上一个扇区的起始地址
If i = lUp - 1 Then '这个时候跨的是簇而不仅仅是扇区
If lFileSystemType = 1 Then
dStartLoc = GetNextStartLoc16(sDisk, dFirstCluster) '获得下一个簇的起始地址
ElseIf lFileSystemType = 2 Then 'FAT32内容加在此处
dStartLoc = GetNextStartLoc32(sDisk, dFirstCluster)
End If
dCurStartLoc = dStartLoc
GetDataOverSector sDisk, TempData(), dCurStartLoc, lBytePerSector '取回数据 必须最小读出一个扇区,只读出所须字节数，结果出错
Else
dCurStartLoc = dStartLoc + (i + 1) * lBytePerSector
GetDataOverSector sDisk, TempData(), dCurStartLoc, lBytePerSector
End If
Else '根目录中跨扇区 只有FAT16才可能出现
dPrevStartLoc = dStartLoc + i * lBytePerSector '保存上一个扇区的起始地址
dCurStartLoc = dStartLoc + (i + 1) * lBytePerSector '保存下一个扇区的趣始地址
GetDataOverSector sDisk, TempData(), dCurStartLoc, 512 '512字节表示必须最小读出一个扇区
End If
'此处要加入校验值计算
CheckSum = GetCheckSum(TempData(), (mm + intLastPos - lNum32Byte - 1) * &H20)
If CheckNum = CheckSum Then '校验值有效才处理
bIsDirFact = TempData((mm + intLastPos - lNum32Byte - 1) * &H20 + &HB) And &H10
MoveDataIntoByte TempData(), FileNameByte(), lTemp, mm + intLastPos - lNum32Byte - 2, 0 '取出跨簇的文件名内容
MoveDataIntoByte Data(), FileNameByte(), lTemp, lNum32Byte - mm, mm '取出没有跨簇的文件名内容
sName = FileNameByte
lPos = InStr(1, sName, Chr$(0), vbBinaryCompare)
If lPos > 0 Then sName = Left(sName, lPos - 1)
lBb = mm + intLastPos - lNum32Byte - 1
dFileSize = GetStartClusterAndFileSize(TempData(), dCodeCluster, lBb, bIsDirFact, False)
If bIsDirFact Then
If iIterateFlag <= 2 Then
MkDir sDirNameTo & "\" & sName
FindNameIterate sDisk, dCodeCluster, sDirNameTo & "\" & sName, sDirNameCur & "\" & sName, False, iIterateFlag
Else
dSaveCluster = dCodeCluster
FindNameIterate sDisk, dCodeCluster, sDirNameTo & "\" & sName, sDirNameCur & "\" & sName, False, iIterateFlag
WriteDelFlagOnlyIntoArray sDisk, Data(), lNum32Byte - mm, mm, bIsCrash '清除目录项
WriteDelFlagOnlyIntoArray sDisk, TempData(), mm + intLastPos - lNum32Byte - 1, 0, bIsCrash '清除目录项
bModifySector = True
dCodeCluster = dSaveCluster
OperateFileAllCluster ClusterFile(), sDisk, dCodeCluster, True, False '清除FAT表
End If
Else
Label3.Caption = sLabelCaption & sDirNameCur & "\" & sName
' Debug.Print sDirNameCur & "\" & sName
DoEvents
Select Case iIterateFlag
Case 1, 2 '1- 一般复制 '2-刻隆复制
sSaveFileName = sDirNameTo & "\" & sName
' dCurStartLoc = lDataEntries + (lCodeCluster - &H2) * lSectorPerCluster * lBytePerSector
ReadAndSaveFile sDisk, sSaveFileName, dFileSize, dCodeCluster
If iIterateFlag = 2 Then
WriteOrigFileTime sDirNameCur & "\" & sName, sSaveFileName
End If
Case 3, 4 '3- 一般删除'4-文件粉碎
WriteDelFlagOnlyIntoArray sDisk, Data(), lNum32Byte - mm, mm, bIsCrash
WriteDelFlagOnlyIntoArray sDisk, TempData(), mm + intLastPos - lNum32Byte - 1, 0, bIsCrash
bModifySector = True
If iIterateFlag = 4 Then
CrashFile sDisk, dCodeCluster '此处添加清除数据区内容
Else
OperateFileAllCluster ClusterFile(), sDisk, dCodeCluster, True, False '删除FAT表内对应位置的簇号记录
End If
Case Else '其余不作处理
End Select
End If
mm = lNum32Byte
End If
Else '在簇内部，没有跨簇
CheckSum = GetCheckSum(Data(), (mm + intLastPos) * &H20) '计算校验值
If CheckSum = CheckNum Then '校验值相同才处理
bIsDirFact = Data((mm + intLastPos) * &H20 + &HB) And &H10
MoveDataIntoByte Data(), FileNameByte(), lTemp, intLastPos - 1, mm '取出文件名
sName = FileNameByte
lPos = InStr(1, sName, Chr$(0), vbBinaryCompare)
If lPos > 0 Then sName = Left(sName, lPos - 1)
dFileSize = GetStartClusterAndFileSize(Data(), dCodeCluster, mm + intLastPos, bIsDirFact, False)
If bIsDirFact Then
If iIterateFlag <= 2 Then
MkDir sDirNameTo & "\" & sName
FindNameIterate sDisk, dCodeCluster, sDirNameTo & "\" & sName, sDirNameCur & "\" & sName, False, iIterateFlag
Else
dSaveCluster = dCodeCluster
FindNameIterate sDisk, dCodeCluster, sDirNameTo & "\" & sName, sDirNameCur & "\" & sName, False, iIterateFlag
WriteDelFlagOnlyIntoArray sDisk, Data(), intLastPos, mm, bIsCrash '清除目录项
bModifySector = True
dCodeCluster = dSaveCluster
OperateFileAllCluster ClusterFile(), sDisk, dCodeCluster, True, False '清除FAT表
End If
Else
Label3.Caption = sLabelCaption & sDirNameCur & "\" & sName
' Debug.Print sDirNameCur & "\" & sName
DoEvents
Select Case iIterateFlag
Case 1, 2 '一般COPY '克隆复制
sSaveFileName = sDirNameTo & "\" & sName
' dCurStartLoc = lData⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -