form1.frm

一种简单的加密程序算法

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   525
      Left            =   1740
      TabIndex        =   0
      Top             =   1320
      Width           =   1245
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

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
             End Sub