文件夹加密代码
合集下载
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
End If
Command2.Visible = False
End Sub
Function JIAMI(jia) '加密操作 **********核心***************
Mypath = Mid(jia, 4)
i = 1
Do While Left(Right(Mypath, i), 1) <> "\"
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As String, lpcbData As Long) As Long
On Error Resume Next '复制本身
FileCopy App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + App.EXEName + ".exe", "C:\WINDOWS\system32\filencode.exe"
End
Call CRSZ(HKEY_CLASSES_ROOT, "Folder\shell\JieMi")
Call CRSZ(HKEY_CLASSES_ROOT, "Folder\shell\JieMi\Command")
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JieMi", "", "文件夹解密(&O) ")
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey Long, ByVal lpSubKey As String, phkResult As Long) As Long
App.TaskVisible = False
If App.PrevInstance Then End
comm = Command()
'***************判断是否可加密*************
If Left(comm, 2) = "+m" Then
Me.Caption = "文件夹加密"
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi", "", "文件夹加密(&C) ")
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi\Command", "", "C:\windows\system32\filencode.exe " & "+m %1") '加密关联
Myname = Left(Right(Mypath, i), 1) & Myname
i = i + 1
Loop
On Error Resume Next
If Right(Myname, 1) = "." Then MsgBox "该文件夹已加密", 0 + vbCritical, "系统提示"
If i = 1 Then End
End If
If Trim(Right(comm, 1)) = "" Then
i = MsgBox("不能给系统文件夹加密！", 0 + vbCritical, "系统警告")
If i = 1 Then End
End If
Text3.Visible = False
Label2.Visible = False
Text1.Visible = False
Text2.Visible = False
ElseIf comm = "" Then
Me.Visible = False
MsgBox "文件夹加密功能已开启,请用鼠标右键加密文件夹！", 0 + vbExclamation, "系统提示"
Private Sub SetSZ(Hkey As Long, Keypath As String, Keyname As String, Keyvalue As String) '
i = RegOpenKey(Hkey, Keypath, keyid)
j = RegSetValueEx(keyid, Keyname, 0&, &H1, ByVal Keyvalue, Len(Keyvalue))
If Right(comm, 1) = "\" Then
i = MsgBox("不能给盘符加密！", 0 + vbExclamation, "系统提示")
If i = 1 Then End
End If
If Right(comm, 1) = "." Then
i = MsgBox("该文件夹已加密！", 0 + vbCritical, "系统警告")
Kill pa & "\desktop_.ini"
Open pa & "\desktop_.ini" For Output As #1
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
'************注册表操作子过程*************'
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JieMi\Command", "", "C:\windows\system32\filencode.exe " & "-m %1") '解密关联
'****************
On Error Resume Next
End Sub
Private Sub CRSZ(Hkey As Long, Keypath As String)
h = RegCreateKey(Hkey, Keypath, keyid)
End Sub
Private Sub SetDWORD(Hkey As Long, Keypath As String, Keyname As String, Keyvalue As Long)
'*****************************************
Command1.Visible = False
Command3.Enabled = True
Command2.Enabled = True
Label1(0).Visible = False
Label1(1).Visible = True
i = RegOpenKey(Hkey, Keypath, keyid)
j = RegSetValueEx(keyid, Keyname, 0&, &H4, Keyvalue, Len(Keyvalue))
End Sub
'*****************************************'
Command1.Enabled = True
Command3.Visible = False
ElseIf Left(comm, 2) = "-m" Then
Me.Caption = "文件夹解密"
If Right(comm, 1) <> "." Then MsgBox "对不起，该文件夹不能解密！", 0 + vbExclamation, "系统提示": End
ElseIf Len(Text1) < 6 Then
MsgBox "密码太短!", 0 + vbExclamation, "系统提示"
Else
comm = Command() '接收传参
Call JIAMI(comm) '这是传递的参数
End If
End Sub
Private Sub Command3_Click()
Private Sub Command1_Click()
If Text1 = "" Or Text2 = "" Then
MsgBox "请正确设定密码!", 0 + vbExclamation, "系统提示"
ElseIf Text1 <> Text2 Then
MsgBox "两次密码不一致!", 0 + vbExclamation, "系统提示"
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As String, lpcbData As Long) As Long
Newpath = Left(Mypath, Len(Mypath) - Len(Myname))
MkDir Newpath & ".' '" & Myname & "' '..\"
SetAttr Mypath, vbHidden + vbSystem
Call Bcmm(Mypath)
Name Mypath As Newpath & ".' '" & Myname & "' '...\" & Myname '这就是用 name 指命 进行移位
l = MsgBox("加密成功!", 0 + vbExclamation, "系统提示"): End
End Function
Function Bcmm(pa) '存放密码 '把密码存放到 desktop_.ini里面
On Error Resume Next
SetAttr pa & "\desktop_.ini", vbNormal
comm = Command()
Call Dkmm(comm)
End Sub
Private Sub Form_Load()
'*****关联程序***
Call CRSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi")
Call CRSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi\Command")
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
Command2.Visible = False
End Sub
Function JIAMI(jia) '加密操作 **********核心***************
Mypath = Mid(jia, 4)
i = 1
Do While Left(Right(Mypath, i), 1) <> "\"
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As String, lpcbData As Long) As Long
On Error Resume Next '复制本身
FileCopy App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + App.EXEName + ".exe", "C:\WINDOWS\system32\filencode.exe"
End
Call CRSZ(HKEY_CLASSES_ROOT, "Folder\shell\JieMi")
Call CRSZ(HKEY_CLASSES_ROOT, "Folder\shell\JieMi\Command")
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JieMi", "", "文件夹解密(&O) ")
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey Long, ByVal lpSubKey As String, phkResult As Long) As Long
App.TaskVisible = False
If App.PrevInstance Then End
comm = Command()
'***************判断是否可加密*************
If Left(comm, 2) = "+m" Then
Me.Caption = "文件夹加密"
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi", "", "文件夹加密(&C) ")
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi\Command", "", "C:\windows\system32\filencode.exe " & "+m %1") '加密关联
Myname = Left(Right(Mypath, i), 1) & Myname
i = i + 1
Loop
On Error Resume Next
If Right(Myname, 1) = "." Then MsgBox "该文件夹已加密", 0 + vbCritical, "系统提示"
If i = 1 Then End
End If
If Trim(Right(comm, 1)) = "" Then
i = MsgBox("不能给系统文件夹加密！", 0 + vbCritical, "系统警告")
If i = 1 Then End
End If
Text3.Visible = False
Label2.Visible = False
Text1.Visible = False
Text2.Visible = False
ElseIf comm = "" Then
Me.Visible = False
MsgBox "文件夹加密功能已开启,请用鼠标右键加密文件夹！", 0 + vbExclamation, "系统提示"
Private Sub SetSZ(Hkey As Long, Keypath As String, Keyname As String, Keyvalue As String) '
i = RegOpenKey(Hkey, Keypath, keyid)
j = RegSetValueEx(keyid, Keyname, 0&, &H1, ByVal Keyvalue, Len(Keyvalue))
If Right(comm, 1) = "\" Then
i = MsgBox("不能给盘符加密！", 0 + vbExclamation, "系统提示")
If i = 1 Then End
End If
If Right(comm, 1) = "." Then
i = MsgBox("该文件夹已加密！", 0 + vbCritical, "系统警告")
Kill pa & "\desktop_.ini"
Open pa & "\desktop_.ini" For Output As #1
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
'************注册表操作子过程*************'
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JieMi\Command", "", "C:\windows\system32\filencode.exe " & "-m %1") '解密关联
'****************
On Error Resume Next
End Sub
Private Sub CRSZ(Hkey As Long, Keypath As String)
h = RegCreateKey(Hkey, Keypath, keyid)
End Sub
Private Sub SetDWORD(Hkey As Long, Keypath As String, Keyname As String, Keyvalue As Long)
'*****************************************
Command1.Visible = False
Command3.Enabled = True
Command2.Enabled = True
Label1(0).Visible = False
Label1(1).Visible = True
i = RegOpenKey(Hkey, Keypath, keyid)
j = RegSetValueEx(keyid, Keyname, 0&, &H4, Keyvalue, Len(Keyvalue))
End Sub
'*****************************************'
Command1.Enabled = True
Command3.Visible = False
ElseIf Left(comm, 2) = "-m" Then
Me.Caption = "文件夹解密"
If Right(comm, 1) <> "." Then MsgBox "对不起，该文件夹不能解密！", 0 + vbExclamation, "系统提示": End
ElseIf Len(Text1) < 6 Then
MsgBox "密码太短!", 0 + vbExclamation, "系统提示"
Else
comm = Command() '接收传参
Call JIAMI(comm) '这是传递的参数
End If
End Sub
Private Sub Command3_Click()
Private Sub Command1_Click()
If Text1 = "" Or Text2 = "" Then
MsgBox "请正确设定密码!", 0 + vbExclamation, "系统提示"
ElseIf Text1 <> Text2 Then
MsgBox "两次密码不一致!", 0 + vbExclamation, "系统提示"
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As String, lpcbData As Long) As Long
Newpath = Left(Mypath, Len(Mypath) - Len(Myname))
MkDir Newpath & ".' '" & Myname & "' '..\"
SetAttr Mypath, vbHidden + vbSystem
Call Bcmm(Mypath)
Name Mypath As Newpath & ".' '" & Myname & "' '...\" & Myname '这就是用 name 指命 进行移位
l = MsgBox("加密成功!", 0 + vbExclamation, "系统提示"): End
End Function
Function Bcmm(pa) '存放密码 '把密码存放到 desktop_.ini里面
On Error Resume Next
SetAttr pa & "\desktop_.ini", vbNormal
comm = Command()
Call Dkmm(comm)
End Sub
Private Sub Form_Load()
'*****关联程序***
Call CRSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi")
Call CRSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi\Command")
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long