📄 frmfileanddiroperate.frm
字号:
Else
lUp = lSectorPerCluster '如果不是根目录就是一个簇的扇区数
End If
lNumByte = lBytePerSector '* lSectorPerCluster '每簇多少字节
lNum32Byte = lNumByte / 32 - 1 '一个簇有多少个32字节减去一个32字节
ReDim Data(lNumByte - 1) '每次读出一个簇的字节数
Goon:
For i = 0 To lUp - 1 '循环查找每一个扇区
OpenDisk "\\.\" & sDisk
ReadDiskbyPos Data(), dStartLoc + i * lNumByte, lNumByte
CloseDisk
GoToNextSector:
If bOverCluster Then '跨簇或扇区后的起始位置不一样，不能还是从0开始
lStart = lOverNextStartPos
Else
lStart = 0
End If
bOverCluster = False '跨簇或扇区标志复位
For mm = lStart To lNum32Byte '以32字节为单位，一个扇区512字节,一共16个32字节
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) '取出长文件名位置处标记是否为长文件名
' dOrigStartLoc = dStartLoc '记录下这个簇的起始地址
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
dPrevStartLoc = dStartLoc + i * lNumByte '首先判断是在根目录还是在簇中,因为两个的取回后面的数的方式不一样
If Not bIsRootEntry Then '这个时候是跨簇了，即不是根目录跨簇，因为根目录不是真正的跨簇
' dPrevStartLoc = dStartLoc + I * lNumByte '所这个扇区的这两个值保存起来
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) * lNumByte
GetDataOverSector sDisk, TempData(), dCurStartLoc, lBytePerSector
End If
Else '根目录中跨簇 只有FAT16才可能出现
' dPrevStartLoc = dStartLoc + I * lNumByte
dCurStartLoc = dStartLoc + (i + 1) * lNumByte
GetDataOverSector sDisk, TempData(), dCurStartLoc, lBytePerSector '必须最小读出一个扇区
End If
'此处要加入校验值计算
CheckSum = GetCheckSum(TempData(), (mm + intLastPos - lNum32Byte - 1) * &H20)
If CheckNum = CheckSum Then '校验值有效才处理
bIsDirFact = TempData((mm + intLastPos - lNum32Byte - 1) * &H20 + &HB) And &H10
If bIsDir = bIsDirFact Then '都是文件夹或者都是文件则進行比较
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
If StrComp(sDirName, sName, vbTextCompare) = 0 Then
'*****************************************************************
dFileSize = GetStartClusterAndFileSize(TempData(), dCodeCluster, lBb, bIsDir, bIsFind)
If bIsLast Then
If bIsFind Then
FindDirName = sName
DirInfoIntoType ttDirInfo, dCodeCluster, sDisk, sName, dPrevStartLoc, _
dCurStartLoc, lBb, mm, lNum32Byte - mm, bOverCluster, bIsCrash
Else
If bIsDel And (Not bIsDir) Then
WriteDelFlagIntoByte sDisk, Data(), dPrevStartLoc, lNum32Byte - mm, mm, bIsCrash '写回不跨簇或扇区内容
WriteDelFlagIntoByte sDisk, TempData(), dCurStartLoc, mm + intLastPos - lNum32Byte - 1, 0, bIsCrash '写回跨簇或扇区内容
If bIsCrash Then
Label3.Caption = "正在粉碎文件：" & sName
CrashFile sDisk, dCodeCluster '此处添加清除数据区内容
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 = lNum32Byte
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 '此处添加清除数据区内容
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 '此处添加清除数据区内容
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"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -