VB简单加密文件夹.docx
《VB简单加密文件夹.docx》由会员分享，可在线阅读，更多相关《VB简单加密文件夹.docx（8页珍藏版）》请在冰豆网上搜索。
VB简单加密文件夹
文章来源于网络,仅供学习交流!
经本人测试可用,添加三个标签Label和3个按钮Command,以及3个文本框Text
PrivateDeclareFunctionRegCreateKeyLib"advapi32.dll"Alias"RegCreateKeyA"（ByValHkeyAsLong,ByVallpSubKeyAsString,phkResultAsLong）AsLong
PrivateDeclareFunctionRegDeleteKeyLib"advapi32.dll"Alias"RegDeleteKeyA"（ByValHkeyAsLong,ByVallpSubKeyAsString）AsLongPrivateDeclareFunctionRegDeleteValueLib"advapi32.dll"Alias"RegDeleteValueA"（ByValHkeyAsLong,ByVallpValueNameAsString）AsLong
PrivateDeclareFunctionRegQueryValueExLib"advapi32.dll"Alias"RegQueryValueExA"（ByValHkeyAsLong,ByVallpValueNameAsString,ByVallpReservedAsLong,lpTypeAsLong,lpDataAsString,lpcbDataAsLong）AsLong
PrivateDeclareFunctionRegSetValueExLib"advapi32.dll"Alias"RegSetValueExA"（ByValHkeyAsLong,ByVallpValueNameAsString,ByValReservedAsLong,ByValdwTypeAsLong,lpDataAsAny,ByValcbDataAsLong）AsLong
PrivateDeclareFunctionRegQueryValueExStringLib"advapi32.dll"Alias"RegQueryValueExA"（ByValHkeyAsLong,ByVallpValueNameAsString,ByVallpReservedAsLong,lpTypeAsLong,lpDataAsString,lpcbDataAsLong）AsLong
PrivateDeclareFunctionRegOpenKeyLib"advapi32.dll"Alias"RegOpenKeyA"（ByValHkeyAsLong,ByVallpSubKeyAsString,phkResultAsLong）AsLong
ConstHKEY_CLASSES_ROOT=&H80000000
ConstHKEY_CURRENT_USER=&H80000001
ConstHKEY_LOCAL_MACHINE=&H80000002
'************注册表操作子过程*************'
PrivateSubSetSZ（HkeyAsLong,KeypathAsString,KeynameAsString,KeyvalueAsString）'
i=RegOpenKey（Hkey,Keypath,keyid）
j=RegSetValueEx（keyid,Keyname,0&,&H1,ByValKeyvalue,Len（Keyvalue））EndSub
PrivateSubCRSZ（HkeyAsLong,KeypathAsString）
h=RegCreateKey（Hkey,Keypath,keyid）
EndSub
PrivateSubSetDWORD（HkeyAsLong,KeypathAsString,KeynameAsString,KeyvalueAsLong）
i=RegOpenKey（Hkey,Keypath,keyid）
j=RegSetValueEx（keyid,Keyname,0&,&H4,Keyvalue,Len（Keyvalue））
EndSub
'*****************************************'
PrivateSubCommand1_Click（）
IfText1=""OrText2=""Then
MsgBox"请正确设定密码!
",0+vbExclamation,"系统提示"
ElseIfText1<>Text2Then
MsgBox"两次密码不一致!
",0+vbExclamation,"系统提示"
ElseIfLen（Text1）<6Then
MsgBox"密码太短!
",0+vbExclamation,"系统提示"
Else
comm=Command（）'接收传参
CallJIAMI（comm）'这是传递的参数
EndIf
EndSub
PrivateSubCommand3_Click（）
comm=Command（）
CallDkmm（comm）
EndSub
PrivateSubForm_Load（）
'*****关联程序***
CallCRSZ（HKEY_CLASSES_ROOT,"Folder\shell\JiaMi"）
CallCRSZ（HKEY_CLASSES_ROOT,"Folder\shell\JiaMi\Command"）
CallSetSZ（HKEY_CLASSES_ROOT,"Folder\shell\JiaMi","","文件夹加密（&C）"）
CallSetSZ（HKEY_CLASSES_ROOT,"Folder\shell\JiaMi\Command","","C:
\windows\system32\filencode.exe"&"+m%1"）'加密关联
CallCRSZ（HKEY_CLASSES_ROOT,"Folder\shell\JieMi"）
CallCRSZ（HKEY_CLASSES_ROOT,"Folder\shell\JieMi\Command"）
CallSetSZ（HKEY_CLASSES_ROOT,"Folder\shell\JieMi","","文件夹解密（&O）"）
CallSetSZ（HKEY_CLASSES_ROOT,"Folder\shell\JieMi\Command","","C:
\windows\system32\filencode.exe"&"-m%1"）'解密关联
'****************
OnErrorResumeNext
App.TaskVisible=False
IfApp.PrevInstanceThenEnd
comm=Command（）
'***************判断是否可加密*************
IfLeft（comm,2）="+m"Then
Me.Caption="文件夹加密"
IfRight（comm,1）="\"Then
i=MsgBox（"不能给盘符加密!
",0+vbExclamation,"系统提示"）
Ifi=1ThenEnd
EndIf
IfRight（comm,1）="."Then
i=MsgBox（"该文件夹已加密!
",0+vbCritical,"系统警告"）
Ifi=1ThenEnd
EndIf
IfTrim（Right（comm,1））=""Then
i=MsgBox（"不能给系统文件夹加密!
",0+vbCritical,"系统警告"）
Ifi=1ThenEnd
EndIf
Text3.Visible=False
Command1.Enabled=True
Command3.Visible=False
ElseIfLeft（comm,2）="-m"Then
Me.Caption="文件夹解密"
IfRight（comm,1）<>"."ThenMsgBox"对不起,该文件夹不能解密!
",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
ElseIfcomm=""Then
Me.Visible=False
MsgBox"文件夹加密功能已开启,请用鼠标右键加密文件夹!
",0+vbExclamation,"系统提示"
OnErrorResumeNext'复制本身
FileCopyApp.Path+IIf（Right（App.Path,1）="\","","\"）+App.EXEName+".exe","C:
\WINDOWS\system32\filencode.exe"
End
EndIf
Command2.Visible=False
EndSub
FunctionJIAMI（jia）'加密操作**********核心***************
Mypath=Mid（jia,4）
i=1
DoWhileLeft（Right（Mypath,i）,1）<>"\"
Myname=Left（Right（Mypath,i）,1）&Myname
i=i+1
Loop
OnErrorResumeNext
IfRight（Myname,1）="."ThenMsgBox"该文件夹已加密",0+vbCritical,"系统提示"
Newpath=Left（Mypath,Len（Mypath）-Len（Myname））
MkDirNewpath&".''"&Myname&"''..\"
SetAttrMypath,vbHidden+vbSystem
CallBcmm（Mypath）
NameMypathAsNewpath&".''"&Myname&"''...\"&Myname'这就是用name指命进行移位
l=MsgBox（"加密成功!
",0+vbExclamation,"系统提示"）:
End
EndFunction
FunctionBcmm（pa）'存放密码'把密码存放到desktop_.ini里面
OnErrorResumeNext
SetAttrpa&"\desktop_.ini",vbNormal
Killpa&"\desktop_.ini"
Openpa&"\desktop_.ini"ForOutputAs#1
Print#1,Text2
Close#1
SetAttrpa&"\desktop_.ini",vbHidden+vbSystem
EndFunction
FunctionDkmm（pa）'解密操作
OnErrorResumeNext
SetAttr"c:
\windows\desktop_.ini",vbNormal
Kill"c:
\windows\desktop_.ini"
Mypath=Mid（pa,4）
IfRight（Mypath,2）<>"'."ThenMsgBox"对不起,该文件夹不能解密!
",0+vbCritical,"系统提示":
End
i=1
DoWhileLeft（Right（Mypath,i）,1）<>"\"
Myname=Left（Right（Mypath,i）,1）&Myname
i=i+1
Loop
Newpath=Left（Mypath,Len（Mypath）-Len（Myname））
OnErrorGoTo3:
NameMypath&"..\"&Left（Right（Myname,Len（Myname）-4）,Len（Myname）-8）&"\desktop_.ini"As"c:
\windows\desktop_.ini"
Open"c:
\windows\desktop_.ini"ForInputAs#1'读取密码
DoWhileNotEOF
（1）
mima=mima+Input（1,#1）
Loop
Close#1
OnErrorResumeNext
Name"c:
\windows\desktop_.ini"AsMypath&"..\"&Left（Right（Myname,Len（Myname）-4）,Len（Myname）-8）&"\desktop_.ini"
IfText3<>Left（mima,Len（mima）-2）Then
MsgBox"对不起,密码错误!
",0+vbCritical,"系统提示"
Text3=""
Text3.SetFocus
ExitFunction
Else
OnErrorResumeNext'解密文件夹**********核心***************这是解密的核心
NameMypath&"..\"&Left（Right（Myname,Len（Myname）-4）,Len（Myname）-8）AsNewpath&Left（Right（Myname,Len（Myname）-4）,Len（Myname）-8）3:
RmDirMypath&".\"
SetAttrNewpath&Left（Right（Myname,Len（Myname）-4）,Len（Myname）-8）,vbSystem+vbReadOnly
SetAttrNewpath&Left（Right（Myname,Len（Myname）-4）,Len（Myname）-8）&"\desktop_.ini",vbNormal
KillNewpath&Left（Right（Myname,Len（Myname）-4）,Len（Myname）-8）&"\desktop_.ini"
MsgBox"解密成功!
",0+vbExclamation,"系统提示":
End
EndIf
EndFunction
PrivateSubText2_KeyPress（KeyAsciiAsInteger）
IfKeyAscii=13ThenCommand1_Click
EndSub
PrivateSubText3_KeyPress（KeyAsciiAsInteger）
IfKeyAscii=13ThenCallCommand3_Click
EndSub
升级会员 