enc-dec.frm

vb精彩编程希望大家有用

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "加密/解密"
   ClientHeight    =   1095
   ClientLeft      =   3915
   ClientTop       =   3315
   ClientWidth     =   2190
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1095
   ScaleWidth      =   2190
   Begin VB.CommandButton Command1 
      Caption         =   "加密/解密"
      Height          =   495
      Left            =   480
      TabIndex        =   0
      Top             =   360
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'对文件加密
Sub FileEncodeAndDecode(InputFile As String, OutputFile As String, PasswordKey As String)

    On Error GoTo err1
    
    Dim temp As Single
    Dim Char As String * 1
    Dim XORMask As Single
    Dim temp1 As Integer
    
    Open InputFile For Binary As #1
    Open OutputFile For Binary As #2
    
    '根据输入的密码字符的ASCII码产生不同的随机数种子序列
    For x = 1 To Len(PasswordKey)
        temp = Asc(Mid$(PasswordKey, x, 1))
        For y = 1 To temp
            temp1 = Rnd
        Next y
        
        Randomize temp1
    Next x
        
    
    Counter = 0
    For z = 1 To FileLen(InputFile)
        
        '用随机数序列生成加密屏蔽码
        XORMask = Int(Rnd * 256)
        
        '取得被加密字符进行XOR运算，完成加密
        Get 1, , Char
        Char = Chr$((Asc(Char) Xor XORMask))
        Put 2, , Char
        
        Counter = Counter + 1
        If Counter > Len(PasswordKey) Then Counter = 1
        
        '跳过部分随机数序列
        For x = 1 To (Asc(Mid$(PasswordKey, Counter, 1)) * 2)
            temp = Rnd
        Next x
    Next z


    Close #1
    Close #2
    Exit Sub
err1:
    MsgBox "打开文件出错!", vbCritical, , "加密/解密"
    End
    
End Sub

Private Sub Command1_Click()


    Dim InputFile As String
    Dim OutputFile As String
    Dim PasswordKey As String
    
    InputFile = InputBox("输入需要加密的文件名", "加密/解密")
    OutputFile = InputBox("输入加密后的文件名", "加密/解密")
    PasswordKey = InputBox("输入密码", "加密/解密")
    
    Call FileEncodeAndDecode(InputFile, OutputFile, PasswordKey)
    
    MsgBox "已写入文件：" + OutputFile
    End
End Sub

Private Sub Form_Load()
    Command1.Caption = "加密/解密"
End Sub