如何用VB加密文件夹.pdf

《如何用VB加密文件夹.pdf》由会员分享，可在线阅读，更多相关《如何用VB加密文件夹.pdf（5页珍藏版）》请在得力文库 - 分享文档赚钱的网站上搜索。

1、经本人测试可用，添加三个标签 Label 和 3 个按钮 Command，以及 3 个文本框 Text Private Declare Function RegCreateKey Lib advapi32.dll Alias RegCreateKeyA(ByValHkey As Long,ByVallpSubKey As String,phkResult As Long)As Long Private Declare Function RegDeleteKey Lib advapi32.dll Alias RegDeleteKeyA(ByValHkey As Long,ByVallpSubKe

2、y As String)As Long Private Declare Function RegDeleteValue Lib advapi32.dll Alias RegDeleteValueA(ByValHkey As Long,ByVallpValueName As String)As Long Private Declare Function RegQueryValueEx Lib advapi32.dll Alias RegQueryValueExA(ByValHkey As Long,ByVallpValueName As String,ByVallpReserved As Lon

3、g,lpType As Long,lpData As String,lpcbData As Long)As Long Private Declare Function RegSetValueEx Lib advapi32.dll Alias RegSetValueExA(ByValHkey As Long,ByVallpValueName As String,ByVal Reserved As Long,ByValdwType As Long,lpData As Any,ByValcbData As Long)As Long Private Declare Function RegQueryV

4、alueExString Lib advapi32.dll Alias RegQueryValueExA(ByValHkey As Long,ByVallpValueName As String,ByVallpReserved As Long,lpType As Long,lpData As String,lpcbData As Long)As Long Private Declare Function RegOpenKey Lib advapi32.dll Alias RegOpenKeyA(ByValHkey As Long,ByVallpSubKey As String,phkResul

5、t 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,ByValKeyvalu

6、e,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*P

7、rivate 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=

8、Command()Call Dkmm(comm)End Sub Private Sub Form_Load()*关联程序*Call CRSZ(HKEY_CLASSES_ROOT,FoldershellJiaMi)Call CRSZ(HKEY_CLASSES_ROOT,FoldershellJiaMiCommand)Call SetSZ(HKEY_CLASSES_ROOT,FoldershellJiaMi,文件夹加密(&C)Call SetSZ(HKEY_CLASSES_ROOT,FoldershellJiaMiCommand,C:windowssystem32filencode.exe&+m%

9、1)加密关联Call CRSZ(HKEY_CLASSES_ROOT,FoldershellJieMi)Call CRSZ(HKEY_CLASSES_ROOT,FoldershellJieMiCommand)Call SetSZ(HKEY_CLASSES_ROOT,FoldershellJieMi,文件夹解密(&O)Call SetSZ(HKEY_CLASSES_ROOT,FoldershellJieMiCommand,C:windowssystem32filencode.exe&-m%1)解密关联*On Error Resume Next App.TaskVisible=False If Ap

10、p.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(不能给系统文件夹加密

11、！,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).Vi

12、sible=False Label1(1).Visible=True Label2.Visible=False Text1.Visible=False Text2.Visible=False ElseIfcomm=Then Me.Visible=False MsgBox 文件夹加密功能已开启,请用鼠标右键加密文件夹！,0+vbExclamation,系统提示 On Error Resume Next 复制本身FileCopyApp.Path+IIf(Right(App.Path,1)=,)+App.EXEName+.exe,C:WINDOWSsystem32filencode.exe End

13、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)MkDirNewpa

14、th&.&Myname&.SetAttrMypath,vbHidden+vbSystem Call Bcmm(Mypath)Name Mypath As Newpath&.&Myname&.&Myname 这就是用name 指命 进行移位l=MsgBox(加密成功!,0+vbExclamation,系统提示):End End Function FunctionBcmm(pa)存放密码 把密码存放到 desktop_.ini里面On Error Resume Next SetAttr pa&desktop_.ini,vbNormal Kill pa&desktop_.ini Open pa&de

15、sktop_.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:windowsdesktop_.ini,vbNormal Kill c:windowsdesktop_.ini Mypath=Mid(pa,4)If Right(Mypath,2).Then MsgBox 对不起，该文件夹不能解密！,0+vbCritical,系统提示:End i=1 D

16、o While Left(Right(Mypath,i),1)Myname=Left(Right(Mypath,i),1)&Myname 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:windowsdesktop_.ini Open c:windowsdesktop_.ini For Input As#1 读取密码Do While Not EO

17、F(1)mima=mima+Input(1,#1)Loop Close#1 On Error Resume Next Name c:windowsdesktop_.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 Exit Function Else On Error Resume Next 解密文件夹*核心*

18、这是解密的核心Name Mypath&.&Left(Right(Myname,Len(Myname)-4),Len(Myname)-8)As Newpath&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,

19、vbNormal Kill Newpath&Left(Right(Myname,Len(Myname)-4),Len(Myname)-8)&desktop_.ini MsgBox 解密成功！,0+vbExclamation,系统提示:End End If End Function Private Sub Text2_KeyPress(KeyAscii As Integer)If KeyAscii=13 Then Command1_Click End Sub Private Sub Text3_KeyPress(KeyAscii As Integer)If KeyAscii=13 Then Call Command3_Click End Sub