📄 frmfileanddiroperate.frm
字号:
Exit For
End If
Else
mm = lNum32Byte
Exit For
End If
End If
Else '在簇内部，没有跨簇
CheckSum = GetCheckSum(Data(), (mm + intLastPos) * &H20) '计算校验值
If CheckSum = CheckNum Then '校验值相同才处理
bIsDirFact = Data((mm + intLastPos) * &H20 + &HB) And &H10
If bIsDir = bIsDirFact Then '要找的同为文件夹或同为文件才比较，否则不找
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)
If StrComp(sDirName, sName, vbTextCompare) = 0 Then
'*****************************************************************
dFileSize = GetStartClusterAndFileSize(Data(), dCodeCluster, mm + intLastPos, bIsDir, bIsFind)
If bIsLast Then
If bIsFind Then
FindDirName = sName
DirInfoIntoType ttDirInfo, dCodeCluster, sDisk, sName, dStartLoc + i * lNumByte, 0, 0, mm, intLastPos, bOverCluster, bIsCrash
Else
If bIsDel And (Not bIsDir) Then ''这一个查找过程只删除文件，不删除文件夹
WriteDelFlagIntoByte sDisk, Data(), dStartLoc + i * lNumByte, intLastPos, mm, bIsCrash
If bIsCrash Then
Label3.Caption = "正在粉碎文件：" & sName
CrashFile sDisk, dCodeCluster ', False '此处添加清除数据区内容
Else
Label3.Caption = "正在删除文件：" & sName
OperateFileAllCluster Cluster(), sDisk, dCodeCluster, True, False '删除FAT表内对应位置的簇号记录
End If
Else
FindDirName = sName
End If
End If
Else
FindDirName = sName
End If
Exit Function
Else
mm = mm + intLastPos
End If
Else
mm = mm + intLastPos '跳过长文件
End If
End If
End If
End If
Else '短文件名用处理短文件名的方法
bIsDirFact = Data(mm * &H20 + &HB) And &H10 '是否是文件夹
If bIsDir = bIsDirFact Then '要查找的与找到的是否相同，不管是找的文件还是文件夹
ReDim FileNameByte(7) '先取出文件名，后边取出扩展名
For ll = 0 To 7
FileNameByte(ll) = Data(mm * &H20 + ll)
Next
sName = StrConv(FileNameByte, vbUnicode)
sName = Trim(sName)
ReDim FileNameByte(2) '取出扩展名
For ll = 0 To 2
FileNameByte(ll) = Data(mm * &H20 + &H8 + ll)
Next
sExtName = StrConv(FileNameByte, vbUnicode)
sExtName = Trim(sExtName)
If sExtName <> "" Then '扩展名为空则没有点
sName = sName & "." & sExtName
End If
If StrComp(sDirName, sName, vbTextCompare) = 0 Then '比较找到的文件名是否是要找的文件名
'******************************************************************
dFileSize = GetStartClusterAndFileSize(Data(), dCodeCluster, mm, bIsDir, bIsFind)
If bIsLast Then '不是最后表示还没有找到最终目标，是不能進行任何处理的，只能把参数传回就结束
If bIsFind Then
FindDirName = sName
DirInfoIntoType ttDirInfo, dCodeCluster, sDisk, sName, dStartLoc + i * lNumByte, 0, 0, mm, 0, bOverCluster, bIsCrash
Else
If bIsDel And (Not bIsDir) Then '是否删除
' If bIsDirFact Then '如果是文件夹就進入文件夹处理程序
' Else '否则就進行文件处理
WriteDelFlagIntoByte sDisk, Data(), dStartLoc + i * lNumByte, 0, mm, bIsCrash
If bIsCrash Then
Label3.Caption = "正在粉碎文件：" & sName
CrashFile sDisk, dCodeCluster ', False '此处添加清除数据区内容
Else
Label3.Caption = "正在删除文件：" & sName
OperateFileAllCluster Cluster(), sDisk, dCodeCluster, True, False
End If
' End If
Else '不是删除则返回找到的名称然后退出
FindDirName = sName
End If
End If
Else
FindDirName = sName
End If
Exit Function
End If
End If
End If
End If
Next
If bOverCluster Then
Data = TempData
i = i + 1
GoTo GoToNextSector
End If
Next
If bIsRootEntry Then
MsgBox "路径错误！找不到" & sDisk & "\" & sDirName
FindDirName = "No Name"
Exit Function
' Exit Do
End If
'-----------------------------------------
If Not bOverCluster Then
If lFileSystemType = 1 Then
dStartLoc = GetNextStartLoc16(sDisk, dFirstCluster)
ElseIf lFileSystemType = 2 Then
dStartLoc = GetNextStartLoc32(sDisk, dFirstCluster)
End If
If dStartLoc = -1 Then
MsgBox "路径错误！找不到" & Left(Text2, InStr(1, Text2, sDirName, vbTextCompare) + Len(sDirName) - 1)
FindDirName = "No Name"
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 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 lNumByte As Long
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 / lSectorPerCluster '因为会出现对硬盘扇区進行写操作，因此考虑对硬盘的保护，不采用对簇進行写操作，只考虑对当前扇区進行写操作，所以还是以扇区方式处理数据
Else '如果对簇進行写操作，就会出现这个簇的有些扇区没有数据更改，也進行了写操作,采用这个方法效率不是最高的
lUp = 1 'lSectorPerCluster '如果不是根目录就是一个簇的扇区数
End If
lNumByte = lBytePerSector * lSectorPerCluster '每簇多少字节
lNum32Byte = lNumByte / 32 - 1 '一个簇有多少个32字节减去一个32字节
ReDim Data(lNumByte - 1) '每次读出一个簇的字节数
dFirstCluster = dCodeCluster '把刚刚传入的这个文件夹的起始簇号保存起来，因为dCodeCluster在后面的操作中要发生变化，所以要保存起来
dStartLoc = lDataEntries + (dCodeCluster - &H2) * lSectorPerCluster * lBytePerSector '计算目录项的起始地址
Goon:
For i = 0 To lUp - 1 '循环查找每一个扇区
OpenDisk "\\.\" & sDisk
ReadDiskbyPos Data(), dStartLoc + i * lNumByte, lNumByte
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 lFileSystemType = 1 Then
dStartLoc = GetNextStartLoc16(sDisk, dFirstCluster) '获得下一个簇的起始地址
ElseIf lFileSystemType = 2 Then 'FAT32内容加在此处
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -