📄 frmfileanddiroperate.frm
字号:
If Option3(0).Value Then
' Debug.Print "lCodeCluster=" & Hex(lCodeCluster)
' Debug.Print "入口扇区：" & Hex(lDataEntries / 512 + (lCodeCluster - &H2) * lSectorPerCluster)
' dFileSize = LongToUnsigned(WffData.nFileSizeLow)
Label3.Caption = "正在复制文件：" & sReadFile
ReadAndSaveFile sFileSplit(0), sSaveFileName, dFileSize, dCodeCluster
ElseIf Option3(1).Value Then
Label3.Caption = "正在刻隆文件：" & sReadFile
ReadAndSaveFile sFileSplit(0), sSaveFileName, dFileSize, dCodeCluster
' ReadDiskFile sSaveFileName, "", True, WffdOut '这句有可能使公共变量由于磁盘分区的不同而改变
WriteOrigFileTime sReadFile, sSaveFileName
' Else
' MsgBox "找到文件夹:" & sRetPath & ",起始簇号：" & lCodeCluster
End If
ReadDiskFile = True
Else
ReadDiskFile = False
End If
Else
If sRetName <> "No Name" Then
ReadDiskFile = True
Else
ReadDiskFile = False
End If
End If
End Function
'----------------------------------------------
' Procedure : DelDiskFile
' Auther : WangWeiSheng
' Input : sDelFile 要删除的文件全路径，或者是文件夹全路径
' Input : bIsDel 是否删除
' Input : bIsCrash 是否粉碎
' OutPut : Boolean 删除是否成功
' Purpose : 把一个文件直接从磁盘上删除或是粉碎
'----------------------------------------------
Private Function DelDiskFile(sDelFile As String, bIsDel As Boolean, bIsCrash As Boolean) As Boolean
Dim sFileSplit() As String
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.log中，sam.log就是这个路径中最后部分
Dim i As Long
Dim sRetName As String
Dim tDirInfo As DirInfo
Dim dFileSize As Double
Dim dCodeCluster As Double '起始簇号
If Right(sDelFile, 1) = "\" Then Exit Function
sFileSplit = Split(sDelFile, "\")
GetSomeParameter (sFileSplit(0))
If lFileSystemType = -1 Then Exit Function
'dTempStartLoc = lRootEntries
If lFileSystemType = 1 Then
dCodeCluster = &H2 - lRootSector / lSectorPerCluster
ElseIf lFileSystemType = 2 Then
dCodeCluster = &H2
End If
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
bIsRoot = False
End If
If i <> UBound(sFileSplit) Then '
bIsDir = True
bIsLast = False
Else
If Option5.Value Then
bIsDir = True
Else
bIsDir = False
End If
bIsLast = True
End If
sRetName = FindDirName(sFileSplit(0), dCodeCluster, sFileSplit(i), dFileSize, tDirInfo, bIsDir, bIsRoot, bIsDel, bIsCrash, bIsLast, False)
'起始地址 = 数据区起始地址 + ( 返回的簇偏移号 - 基数&H2 ) * 每簇扇区数 * 每扇区字节数
' dTempStartLoc = lDataEntries + (lCodeCluster - &H2) * lSectorPerCluster * lBytePerSector
If sRetName = "No Name" Then Exit For
Next
If sRetName <> "No Name" Then
DelDiskFile = True
Else
DelDiskFile = False
End If
End Function
'----------------------------------------------
' Procedure : FindDirName
' Auther : WangWeiSheng
' Modfy : WangWeiSheng
' Data : 2007-09-10
' Input : sDisk 盘符
' Input : dStartLoc 要读出的文件或文件夹的起始地址
' Input : sDirName 要读出的文件或文件夹的名称(对于文件夹有可能是路径中间的文件夹)
' Input : bIsDir sDirName 是否是文件夹，为True是文件夹
' Input : bIsRootEntry sDirName 是否是根目录，因为根目录的处理上限不一样,为True是根目录
' Input : bIsDel 是否是删除文件命令
' Input : bIsCrash 是否是文件粉碎命令
' Input : bIsLast 是否路径的最后的一部分
' Input : bIsFind 是否是只查找，这个参数最大
' OutPut : String 返回找到的文件名或文件夹名
' OutPut : WffData 返回文件的许多内容，包括文件创建时间、日期、最后访问日期及最后修改时间日期等
' Purpose : 按目录查找文件或文件夹并返回找到的文件名或文件夹名和簇号并返回文件的尺寸
'----------------------------------------------
'说明：如果在一个根目录扇区尾部只有两个目录项位置，即64字节，但现在有一个文件名是长文件名，将占用4个目录项（128字节），
' 这时Windows同样从该位置开始记录，多余部分顺延到下一个扇区，而不是直接跳到下一个扇区進行完整记录
'这个函数过程比较复杂，因为不管查找文件还是删除文件，都是要经过几乎相同的查找过程，只不过是找到后如何处理的问题
'查找过程本身也比较复杂，还得加入删除的处理内容，显得这个过程的程序非常复杂
'修改说明：用原来的方法，先判断文件名或文件夹名是用长文件名还是用短文件名表示，这样会导致输入文件名就必须与硬盘上的记
'录完全一样才能找出，否则会出现查不着文件的现象,所以取消先判断文件名用是用的长文件名还是短文件名
Private Function FindDirName(sDisk As String, dCodeCluster As Double, sDirName As String, dFileSize As Double, _
ttDirInfo As DirInfo, bIsDir As Boolean, bIsRootEntry As Boolean, bIsDel As Boolean, _
bIsCrash As Boolean, bIsLast As Boolean, bIsFind As Boolean) As String
Dim Data() As Byte '装载扇区数据
Dim Cluster() As Long '用于装载返回的这个文件所有的簇号
Dim i As Long, ll As Long, mm As Long '定义几个循环变量
Dim lTemp As Long, lStart As Long '一个临时交换变量,用于数组下标计数
Dim lUp As Long '扇区上限值
Dim dFirstCluster As Double '记录起始簇号
Dim bLengthFileNameFact As Boolean '找到的内容是否为长文件名
Dim FileNameByte() As Byte '装载文件名
Dim TempData() As Byte '取回跨簇或跨扇区数据的临时字节数组
Dim sName As String '取出文件名
Dim sExtName 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 lNumByte As Long '定义一个打开字节数变量，用于区分在根目录时和在文件夹时的不同量
Dim lNum32Byte As Long '一个簇有多少个32字节
Dim bOverCluster As Boolean '定义一个是否跨越簇的标志
Dim CheckNum As Byte '长文件名中保存的与其关联的短文件名的校验值
Dim CheckSum As Byte '由短文件名计算出的校验值
Dim dPrevStartLoc As Double '在跨簇时记录前一个起始地址用于删除用
Dim dCurStartLoc As Double '记录跨簇或扇区时当前正在用的起始地址
Dim lOverNextStartPos As Long '记录跨簇或跨扇区后下一个开始位置就不是0，而是跨过上一个已处理的项开始
Dim dStartLoc As Double '起始地址
'起始地址 = 数据区起始地址 + ( 返回的簇偏移号 - 基数&H2 ) * 每簇扇区数 * 每扇区字节数
dStartLoc = lDataEntries + (dCodeCluster - &H2) * lSectorPerCluster * lBytePerSector
dFirstCluster = dCodeCluster '把这个地址保存起来，因为在后面dCodeCluster这个数有可能改变成其它数
If bIsRootEntry Then
lUp = lRootSector ' / lSectorPerCluster '如果是根目录就用根目录占多少个扇区
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 '这个时候是跨簇了，即不是根目录跨簇，因为根目录不是真正的跨簇
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才可能出现
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 ', 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 = lNum32Byte
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -