⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmfileanddiroperate.frm

📁 FAT硬盘格式读写程序,希望能有所裨益.
💻 FRM
📖 第 1 页 / 共 5 页
字号:
       End If
       Label3.Caption = sLabelCaption & sReadFile
       DelDiskFile sReadFile, bIsDel, bIsCrash
    End If
End If
'CloseDisk                                                             '关闭磁盘
Label3.Caption = "处理完毕!"
End Sub

'----------------------------------------------
' 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
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
        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 dPrevCodeCluster As Double            '在跨簇或跨扇区时记录前一个扇区的起始簇号
Dim dCurStartLoc As Double                '记录跨簇或扇区时当前正在用的起始地址
'Dim dOrigStartLoc As Double               '记录下不跨簇时的起始扇区地址
Dim lOverNextStartPos As Long             '记录跨簇或跨扇区后下一个开始位置就不是0,而是跨过上一个已处理的项开始
Dim dStartLoc As Double                   '起始地址

'起始地址 = 数据区起始地址 + ( 返回的簇偏移号 - 基数&H2 ) * 每簇扇区数 * 每扇区字节数
dStartLoc = lDataEntries + (dCodeCluster - &H2) * lSectorPerCluster * lBytePerSector
dFirstCluster = dCodeCluster
If bIsRootEntry Then
   lUp = lRootSector ' / lSectorPerCluster              '如果是根目录就用根目录占多少个簇

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -