读书人

关于一个加密软件的有关问题

发布时间: 2012-09-07 10:38:15 作者: rapoo

关于一个加密软件的问题

VB code
Function ByteToBin(m As Byte) As String   ' 将字节型数据转换成八位二进制字符串            Dim c$            c$ = ""            Do While m <> 0            r = m Mod 2            m = m \ 2            c$ = r & c$            Loop            c$ = Right("00000000" & c$, 8)            ByteToBin = c$            End Function            Function Reverse(m As String) As String     ' 将八位二进制字符串颠倒顺序            Dim i%, x$            x = ""            For i = 1 To 8            x = Mid(m, i, 1) & x            Next i            Reverse = x            End Function            Function BinToByte(m As String) As Byte     ' 将八位二进制串转换成十进制            Dim x As String * 1, y%, z%            z = 0            For i = 1 To 8            x = Mid(m, i, 1)            y = x * 2 ^ (8 - i)            z = z + y            Next i            BinToByte = z            End Function            Private Sub Command1_Click()            Dim x As Byte, i%, fname$            fname = InputBox("请输入要加密的文件名!注意加上路径名:")            If Dir(fname) = "" Then            MsgBox "文件不存在!"            Exit Sub            End If            Open fname For Binary As #1         ' 以二进制访问模式打开待加密文件            For i = 1 To LOF(1)               ' LOF函数是求文件长度的内部函数            Get #1, i, x                 ' 取出第i个字节            x = BinToByte(Reverse(ByteToBin(x))) ' 这里调用了三个自定义函数            Put #1, i, x                 ' 将加密后的这个字节写回到文件原位置            Next i            Close            MsgBox "任务完成!"            End Sub

这里是对单个文件加密,怎么写代码能让一个文件夹里的所有文件都按照上面的代码加密,求高手给个全代码.万分感激

[解决办法]
VB code
Function ByteToBin(m As Byte) As String  Dim c$  c$ = ""  Do While m <> 0  r = m Mod 2  m = m \ 2  c$ = r & c$  Loop  c$ = Right("00000000" & c$, 8)  ByteToBin = c$  End Function  Function Reverse(m As String) As String  Dim i%, x$  x = ""  For i = 1 To 8  x = Mid(m, i, 1) & x  Next i  Reverse = x  End Function  Function BinToByte(m As String) As Byte  Dim x As String * 1, y%, z%  z = 0  For i = 1 To 8  x = Mid(m, i, 1)  y = x * 2 ^ (8 - i)  z = z + y  Next i  BinToByte = z  End Function  Function Jm(fname As String) '这里把你的command_click事件直接做成了一个带有参数fname的Jm函数,可以在遍历目录时直接调用  Dim x As Byte, i%  If Dir(fname) = "" ThenPrint "文件不存在!" '这里还有下面的msgbxo全部给你改成了print,毕竟如果文件太多的话一个个弹窗会很麻烦  Exit Function  End If  Open fname For Binary As #1  For i = 1 To LOF(1) '做得匆忙,我没来得及给你改,如果是比较大的图片、视频文件,这里要小心溢出错误  Get #1, i, x  x = BinToByte(Reverse(ByteToBin(x)))  Put #1, i, x  Next i  ClosePrint "任务完成!"  End FunctionPrivate Sub Command1_Click()File1.Path = Text1.Text '将File1的Path属性改成用户指定的目录For i = 0 To File1.ListCount - 1 '遍历第一个到底最后一个文件的文件名Jm (Text1.Text & "\" & File1.List(i)) '将这个文件名加上路径后调用函数Jm,注意这里要检测一下text1的值不是根目录,你懂得Next iMsgBox "OK"End Sub 

读书人网 >VB

热点推荐