A. vb中如何查看整个文件夹地大小
Public Function GetFolderSize(Folder As String) As Long
'取得文件夹的大小,包含子目录
On Error GoTo er
Dim Tmp As String
Dim TotalSize As Long
Dim FolderBuff() As String
Dim FolderMax As Long
Dim BuffMax As Long
cur_Folder = IIf(Right(Folder, 1) = "\", Folder, Folder & "\")
Tmp = Dir(cur_Folder & "*.*", vbDirectory)
Do Until Tmp = ""
If Tmp <> "." And Tmp <> ".." Then
If VBA.GetAttr(cur_Folder & Tmp) = vbDirectory Then '目录
FolderMax = FolderMax + 1
If FolderMax >= BuffMax Then
BuffMax = BuffMax + 1000
ReDim Preserve FolderBuff(BuffMax)
End If
FolderBuff(FolderMax) = cur_Folder & Tmp
Else
TotalSize = TotalSize + FileLen(cur_Folder & Tmp)
End If
End If
Tmp = Dir()
Loop
For i = 1 To FolderMax
TotalSize = TotalSize + GetFolderSize(FolderBuff(i)) '递归目录
Next i
er:
GetFolderSize = TotalSize
Erase FolderBuff
End Function
Private Sub Command1_Click()
'调试部分,供参考
Dim Folder As String
Folder = VBA.Environ("windir")
foldersize = GetFolderSize(Folder)
If foldersize > 1000000000 Then
Tmp = Format(foldersize / 1000000000, "0.00") & " G"
ElseIf foldersize > 1000000 Then
Tmp = Format(foldersize / 1000000, "0.0") & " M"
ElseIf foldersize > 1000 Then
Tmp = Format(foldersize / 1000, "0.0") & " k"
Else
Tmp = Format(foldersize)
End If
MsgBox "文件夹:" & Folder & vbCrLf & "大小:" & Tmp, vbInformation
End Sub
B. 怎么用VB给文件夹加密
1、由于采用二进制读取文件的方式,因此加密时一般可以不考虑文件类型。
2、这里只进行一次异或运算,如有需要可以进行多次异或运算。
3、此加密算法速度快,当然加密强度也低 ;
参考代码如下:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
'-----------------------------------------------------------------------
'函数说明: 使用异或运算加密文件(可加密大部分文件)
'参数说明: key - 密钥
' fileName - 普通文件名,
' encryptFileName - 加密后的文件名
'返回值: true - 成功,false - 失败
'-----------------------------------------------------------------------
Private Function XOR_Encrypt(key As Integer, fileName As String, encryptFileName As String) As Boolean
On Error GoTo errHandler
Dim inputFileNo As Integer
Dim fileBytes() As Byte
Dim length As Long
XOR_Encrypt = False
'打开文件并保存在二进制数组中
inputFileNo = FreeFile
Open fileName For Binary As #inputFileNo
length = LOF(inputFileNo)
If length = 0 Then
MsgBox "退出加密:文件内容为空!", vbInformation, "提示"
Exit Function
End If
ReDim fileBytes(length - 1) As Byte
Get inputFileNo, , fileBytes()
Close #inputFileNo
'将该二进制数组进行异或加密
Dim i As Long
For i = LBound(fileBytes) To UBound(fileBytes)
fileBytes(i) = fileBytes(i) Xor key
Next
'将异或加密后的二进制数组保存在新的文件中
Dim outputFileNo As Integer
outputFileNo = FreeFile
Open encryptFileName For Binary As #outputFileNo
Put outputFileNo, , fileBytes
Close #outputFileNo
XOR_Encrypt = True
errHandler:
If Err.Number Then
MsgBox "加密过程中出错:" & Err.Description, vbCritical, "错误"
XOR_Encrypt = False
Resume Next
End If
End Function