经本人测试可用，添加三个标签Label和3个按钮Command，以及3个文本框Text
    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 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
    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
    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 RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserv
ed As Long, lpType As Long, lpData As String, lpcbData As Long) As Long
    Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Const HKEY_CLASSES_ROOT = &H80000000
    Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
'************注册表操作子过程*************'
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))
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)
i = RegOpenKey(Hkey, Keypath, keyid)
j = RegSetValueEx(keyid, Keyname, 0&, &H4, Keyvalue, Len(Keyvalue))
End Sub
'*****************************************'
经典喜剧电影排行榜
Private Sub Command1_Click()
If Text1 = "" Or Text2 = "" Then
MsgBox "请正确设定密码!", 0 + vbExclamation, "系统提示"
ElseIf Text1 <> Text2 Then
MsgBox "两次密码不一致!", 0 + vbExclamation, "系统提示"
花胶的吃法ElseIf Len(Text1) < 6 Then
MsgBox "密码太短!", 0 + vbExclamation, "系统提示"
Else
comm = Command() '接收传参
Call JIAMI(comm) '这是传递的参数
End If
End Sub
Private Sub Command3_Click()
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")
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi", "", "文件夹加密(&C)    ")
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JiaMi\Command", "", "C:\windows\sys
" & "+m %1") '加密关联
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)    ")
Call SetSZ(HKEY_CLASSES_ROOT, "Folder\shell\JieMi\Command", "", "C:\windows\ " & "-m %1") '解密关联
'****************
On Error Resume Next
App.TaskVisible = False
If App.PrevInstance Then End
comm = Command()
'***************判断是否可加密*************
If Left(comm, 2) = "+m" Then
Me.Caption = "文件夹加密"
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, "系统警告")
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
Command1.Enabled = True
Command3.Visible = False
ElseIf Left(comm, 2) = "-m" Then
Me.Caption = "文件夹解密"
If Right(comm, 1) <> "." Then MsgBox "对不起，该文件夹不能解密！", 0 + vbExclamation, "系统提示": End
'*****************************************
Command1.Visible = False
Command3.Enabled = True
Command2.Enabled = True
Label1(0).Visible = False
Label1(1).Visible = True
Label2.Visible = False
Text1.Visible = False
Text2.Visible = False
ElseIf comm = "" Then
Me.Visible = False
MsgBox "文件夹加密功能已开启,请用鼠标右键加密文件夹！", 0 + vbExclamation, "系统提
示"
On Error Resume Next '复制本身
FileCopy App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + App.EXEName + ".exe", "C:\WINDOWS\"
End
End If
Command2.Visible = False
End Sub
Function JIAMI(jia) '加密操作 **********核心***************
Mypath = Mid(jia, 4)
i = 1
Do While Left(Right(Mypath, i), 1) <> "\"
Myname = Left(Right(Mypath, i), 1) & Myname
i = i + 1
Loop
On Error Resume Next阿里郎歌词
If Right(Myname, 1) = "." Then MsgBox "该文件夹已加密", 0 + vbCritical, "系统提示"
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
Kill pa & "\desktop_.ini"
Open pa & "\desktop_.ini" For Output As #1
Print #1, Text2
Close #1
SetAttr pa & "\desktop_.ini", vbHidden + vbSystem
End Function
Function Dkmm(pa) '解密操作
On Error Resume Next
SetAttr "c:\windows\desktop_.ini", vbNormal
Kill "c:\windows\desktop_.ini"
Mypath = Mid(pa, 4)
If Right(Mypath, 2) <> "'." Then MsgBox "对不起，该文件夹不能解密！", 0 + vbCritical, "系统提示": End
埃及艳后的故事i = 1
Do While Left(Right(Mypath, i), 1) <> "\"
Myname = Left(Right(Mypath, i), 1) & Mynameqq头像换不了什么原因
i = i + 1
Loop
Newpath = Left(Mypath, Len(Mypath) - Len(Myname))
On Error GoTo 3:
Name Mypath & "..\" & Left(Right(Myname, Len(Myname) - 4), Len(Myname) - 8) & "\desktop_.ini" As "c:\windows\desktop_.ini"
Open "c:\windows\desktop_.ini" For Input As #1 '读取密码
Do While Not EOF(1)
mima = mima + Input(1, #1)
Loop
Close #1

On Error Resume Next
Name "c:\windows\desktop_.ini" As Mypath & "..\" & Left(Right(Myname, Len(Myname) - 4), Len(Myname) - 8) & "\desktop_.ini"
If Text3 <> Left(mima, Len(mima) - 2) Then
MsgBox "对不起，密码错误！", 0 + vbCritical, "系统提示"
Text3 = ""
Text3.SetFocus