VB6换个思路解决微信下载文件只读的问题（含源码）
日期：2023年3月10日
作者：Commas
签名：(ง •_•)ง 积跬步以致千里,积小流以成江海……
注释：如果您觉得有所帮助，帮忙点个赞，也可以关注我，我们一起成长；如果有不对的地方，还望各位大佬不吝赐教，谢谢^ - ^
1.01365 = 37.7834；0.99365 = 0.0255
1.02365 = 1377.4083；0.98365 = 0.0006
文章目录
- 一、前言
- 二、设置与取消文件只读权限
- 三、判断文件只读
- 四、实现过程
一、前言
当一个文件（Word、Excel、PPT等等）编辑的差不多了，准备保存的时候，哟，好家伙，发现该文件权限设置为只读（readonly）了，无法保存，心情突然没那么美丽了。其实很简单解决这个问题，如下所示：
右键选择“属性”→取消“只读”的勾选，那么example.docx文件就取消只读，可以正常保存了。另外还有什么压缩传输法，文件另存法，微信降级法等等，虽然可以解决问题，但是也太不方便了。
后面排查发现，原来是最近微信更新后出现的问题——微信传输的文件均被设置成了只读（readonly）权限，给出的说法是为了防止文件信息在网络传输过程中被篡改。但是也太不方便了吧，作为一名技术不能忍，于是乎搞出一个小程序chmod.exe，将这个exe放在微信下载文件夹下面，运行就可以把整个文件夹中所有的文件取消只读了，看下效果吧：
- 双击运行，效果如下：
- 再次双击运行，效果如下：
好了，话不多说，我们接下来讲讲如何实现吧……
最后面放了程序与源码的下载地址^ - ^
二、设置与取消文件只读权限
VB6中的VBA库提供了一个方法SetAttr()，可以设置文件的读写等等权限。
语法：
VBA.SetAttr(PathName As String,Attributes As VbFileAttribute)
或
SetAttr(PathName As String,Attributes As VbFileAttribute)
PathName：必要参数。需要修改只读属性的文件路径或目录路径；Attributes：必要参数。常数或数值表达式，其总和用来表示文件的属性；
attributes 参数设置可为：
| 常数 | 值 | 描述 |
|---|---|---|
vbNormal |
0 |
常规（缺省值），可读可写 |
vbReadOnly |
1 |
只读 |
vbHidden |
2 |
隐藏 |
vbSystem |
4 |
系统文件 |
vbArchive |
32 |
上次备份以后，文件已经改变 |
设置只读示例：
'set the file readoly
Call VBA.SetAttr(App.Path & "\example.txt",vbReadOnly)
或
'set the file readoly
Call VBA.SetAttr(App.Path & "\example.txt",1)
取消只读示例：
'cancel the file readonly
Call VBA.SetAttr(App.Path & "\example.txt", vbNormal)
或
'cancel the file readonly
Call VBA.SetAttr(App.Path & "\example.txt", 0)
三、判断文件只读
VB6中的VBA库提供了一个方法GetAttr()，可以设置文件的读写等等权限。
语法：
VBA.GetAttr(PathName As String) As VbFileAttribute
或
GetAttr(PathName As String) As VbFileAttribute
PathName：必要参数。需要修改只读属性的文件路径或目录路径；VbFileAttribute：返回值是一个 十进制 的Integer，此为一个文件、目录、或文件夹的属性值总和；
由 GetAttr 返回的值，是下面这些属性值的总和：
| 常数 | 值(十进制) | 值(二进制) | 描述 |
|---|---|---|---|
vbNormal |
0 |
0 |
常规 |
vbReadOnly |
1 |
1 |
只读 |
vbHidden |
2 |
10 |
隐藏 |
vbSystem |
4 |
100 |
系统文件 |
vbDirectory |
16 |
10000 |
目录或文件夹 |
vbArchive |
32 |
10000 |
上次备份以后，文件已经改变 |
vbalias |
64 |
1000000 |
指定的文件名是别名 |
特别说明
若要判断是否设置了某个属性，在 GetAttr 函数与想要得知的属性值之间使用 And 运算符与逐位比较。如果所得的结果不为零，则表示设置了这个属性值，即：
result = GetAttr(PathName) And VbFileAttribute
- 如果 result <> 0 ，那么表示设置
VbFileAttribute权限； - 如果 result = 0 ，那么没有设置
VbFileAttribute权限；
只读示例：
Dim result As Integer
result = GetAttr(App.Path & "\example.txt", 0) And vbReadOnly
If result <> 0 Then
Debug.Print "文件设置了只读权限"
Else
Debug.Print "文件未设置只读权限"
End If
只要result <> 0，就表示文件设置了只读权限，其中用到了一个【And 运算符与逐位比较 】知识点，如果读者感兴趣，那么到时候再出一期详细讲讲吧，这里展开讲解的话，可以话题就跑偏了。
上述判断文件权限，大部分习惯高级语言的小伙伴们都不太适应吧，所以我将其封装了下，健康绿色，可以放心食用，如下所示：
Private Function CheckFileReadOnly(ByVal sFilePath As String) As Boolean
On Error Resume Next
'函数说明：判断文件是否为只读
'创建作者：Commas
'创建时间：2022-02-16
'修改时间：
'------数据格式说明------
'sFilePath：文件路径
'------数据格式说明------
CheckFileReadOnly = False
If sFilePath <> "" Then
If Dir(sFilePath, vbDirectory + vbNormal + vbArchive + vbHidden + vbReadOnly + vbSystem) <> "" Then
If (VBA.GetAttr(sFilePath) And vbReadOnly) <> 0 Then
CheckFileReadOnly = True
End If
End If
End If
End Function
四、实现过程
现在我们实现的是一个文件的权限设置，如果就这么去取消只读权限，那还不如直接右键属性直接取消来的快，所以需要用到目录遍历（如果想详细了解这方面的知识，可以看我的另一篇博文《VB6遍历目录（文件夹和文件）》）。
首先，我们封装一下单个文件的取消只读权限
Private Function CancelFileReadOnly(ByVal sFilePath As String) As Boolean
On Error Resume Next
'函数说明：文件取消只读
'创建作者：Commas
'创建时间：2022-02-16
'修改时间：
'------数据格式说明------
'sFilePath：文件路径
'------数据格式说明------
Err.Clear
VBA.SetAttr sFilePath, vbNormal
If Err <> 0 Then
CancelFileReadOnly = False
Err.Clear
Else
CancelFileReadOnly = True
End If
End Function
然后，我们获取路径下的所有目录（文件夹目录+文件目录）
Set clnDir = GetAllDir(sFindPathName)
接着，我们遍历目录clnDir来取消文件只读
For i = 1 To clnDir.Count
sCurFilePath = clnDir.Item(i)
'判断文件是否未只读
If CheckFileReadOnly(sCurFilePath) Then
sCurFileName = Mid(sCurFilePath, InStrRev(sCurFilePath, "\") + 1)
'取消文件只读权限
If CancelFileReadOnly(sCurFilePath) Then
clnOK.Add sCurFileName
Else
clnFail.Add sCurFileName
End If
End If
Next i
最后，将遍历过程封装成函数，即批量取消只读权限（BatchCancelFileReadOnly）
Private Function BatchCancelFileReadOnly(ByVal sFindPathName As String) As Boolean
On Error Resume Next
'函数说明：文件取消只读
'创建作者：Commas
'创建时间：2022-02-16
'修改时间：
'------数据格式说明------
'sFindPathName：文件夹路径
'------数据格式说明------
Dim sCurFileName As String, sCurFilePath As String, i As Long
Dim clnOK As New Collection, clnFail As New Collection, clnDir As New Collection
' 获取查询路径下所有目录（包括子孙）
Set clnDir = GetAllDir(sFindPathName)
For i = 1 To clnDir.Count
sCurFilePath = clnDir.Item(i)
'判断文件是否未只读
If CheckFileReadOnly(sCurFilePath) Then
sCurFileName = Mid(sCurFilePath, InStrRev(sCurFilePath, "\") + 1)
'取消文件只读权限
If CancelFileReadOnly(sCurFilePath) Then
clnOK.Add sCurFileName
Else
clnFail.Add sCurFileName
End If
End If
Next i
If clnFail.Count = 0 Then
BatchCancelFileReadOnly = True
Else
BatchCancelFileReadOnly = False
End If
Dim sMsg As String
If clnOK.Count > 0 Or clnFail.Count > 0 Then
addMsg sMsg, "******操作完成，详情如下******"
addMsg sMsg, "执行路径：" & sFindPathName
addMsg sMsg, ""
End If
'ok
If clnOK.Count > 0 Then
addMsg sMsg, ""
addMsg sMsg, "@@@@已取消【只读】的文件如下所示："
End If
For i = 1 To clnOK.Count
addMsg sMsg, clnOK(i)
Next
'fail
If clnFail.Count > 0 Then
addMsg sMsg, ""
addMsg sMsg, "@@@@取消【只读】失败的文件如下所示："
End If
For i = 1 To clnFail.Count
addMsg sMsg, clnFail(i)
Next
If sMsg = "" Then sMsg = "经检查，【路径" & sFindPathName & "】没有【只读】文件"
MsgBox sMsg
End Function
调用示例：
Sub Main()
Dim sPath As String
'VBA.Command$ 也可以从命令行参数提取path，这里暂时没有实现
sPath = App.Path
Debug.Print BatchCancelFileReadOnly(sPath)
End Sub
顺便提一嘴，还可以做一个计时器，定时执行取消只读权限；或者监听文件变化，再执行批量取消，这样看上去就会更加便捷了，这个实现就留给聪明的你啦^ - ^
一、下载地址：
- 免费白嫖：https://download.csdn.net/download/qq_35844043/87548631
- 积分下载：https://download.csdn.net/download/qq_35844043/87548735
二、源码分享：
GitCode地址：https://gitcode.net/qq_35844043/vb6/-/tree/master/
版权声明：本文为博主原创文章，如需转载，请给出：
原文链接：https://blog.csdn.net/qq_35844043/article/details/129420874