用VB编写程序怎样给文件夹加密码?

用VB编写程序怎样给文件夹加密码?谁能提供代码给我,详细点最好。... 用VB编写程序怎样给文件夹加密码?谁能提供代码给我,详细点最好。 展开
 我来答
匿名用户
2013-12-11
展开全部
加密原理:循环使用密码中每个字符的ASCII码值与文件的每个字节进行异或运算,然后写入文件即可。这种加密方法是可逆的,即对明文进行加密得到密文,用相同的密码对密文进行加密就得到明文。
  界面设计:在窗体From1上放置驱动器列表框(Driver1)、目录列表框(Dir1)、文件列表框(File1)各一个,这三个控件相互配合,用来确定要加密文件的位置。其中File1的Pattern属性设为“*.TXT”,即仅显示文本文件;再放置一个Check控件,用来控制显示文件的类型,其Caption属性设为“显示全部文件”;接着放置两个文本框,Text1显示文件内容,Text2用来输入密码,其Passchar属性设为“*”,一个Label控件,其Caption属性设为“密码”;最后,放置两个命令按钮,其Caption属性分别设为“加密/解密”和“退出”。
  程序代码:
  Option Explicit
  Dim i As Long
  Dim databuff() As Byte ’定义数组用于存放文件内容
  Dim addbuff() As Byte ’定义数组用于存放加密后的文件内容
  Dim password() As Byte ’定义数组用于存放密码的ASCII值
  Dim filename As String
  Private Sub Check1_Click()� 
  If Check1.Value Then ’控制是否显示全部文件
  File1.Pattern = "*.*"
  Else
  File1.Pattern = ".txt"
  End If
  End Sub
  Private Sub Command1_Click()� 
  Dim j As Integer
  Dim password_len As Integer
  password_len = Len(Text2.Text) 
  ReDim password(password_len) As Byte
  For i = 0 To password_len - 1 ’把密码转化为ASCII码
  password(i)= Asc(Mid(Text2.Text,i + 1,1))  
  Next
  If filename = "" Then Exit Sub
  Open filename For Binary As #1 ’读取要加密的文件内容
  ReDim databuff(LOF(1))  
  Get #1,, databuff
  Close #1
  ReDim addbuff(UBound(databuff))As Byte
  For i = 0 To UBound(databuff) 
  If j >= password_len Then ’循环使用密码
  j = 0
  Else
  j = j + 1
  End If
  addbuff(i)= databuff(i)Xor password(j)’进行异或运算
  Next
  Open filename For Binary As #1 ’把加密后的内容写入文件
  Put #1,,addbuff
  Close #1
  Text1 = StrConv(addbuff vbUnicode)’显示加密后的文件内容
  Text2.Text = ""
  End Sub
  Private Sub Command2_Click()� 
  .End
  End Sub
  Private Sub Dir1_Change()� 
  File1.Path = Dir1.Path ’与文件列表框相关联
  End Sub
  Private Sub Drive1_Change()� 
  On Error GoTo a0
  Dir1.Path = Drive1.Drive ’与目录列表框相关联
  a0:If Err Then MsgBox(Error(Err))’发生错误,提示错误内容
  End Sub
  Private Sub File1_Click()’单击文件时,显示文件内容
  filename = Dir1.Path + File1.filename
  If filename = "" Then Exit Sub
  Open filename For Binary As #1
  ReDim databuff(LOF(1))  
  Get #1,,databuff
  Close #1
  Text1 = StrConv(databuff,vbUnicode) 
  End Sub
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式