form1.frm

该VB程序对输入的字串,拆分成Bit,然后随即插入新的字节.达到加密的目的.很难解密.该程序还提供解密功能.请在WinXPx下测试通过.

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Encipher & Decrypt"
   ClientHeight    =   5985
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8850
   LinkTopic       =   "Form1"
   ScaleHeight     =   5985
   ScaleWidth      =   8850
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Picture2 
      Height          =   1935
      Left            =   3240
      ScaleHeight     =   1875
      ScaleWidth      =   5235
      TabIndex        =   6
      Top             =   3960
      Width           =   5295
   End
   Begin VB.PictureBox Picture1 
      Height          =   3255
      Left            =   3240
      ScaleHeight     =   3195
      ScaleWidth      =   5235
      TabIndex        =   5
      Top             =   360
      Width           =   5295
   End
   Begin VB.TextBox Text2 
      Height          =   735
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   1  'Horizontal
      TabIndex        =   4
      Top             =   2280
      Width           =   2895
   End
   Begin VB.TextBox Text1 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   120
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   360
      Width           =   2895
   End
   Begin VB.CommandButton Command1 
      Caption         =   "先 加密 再 解密"
      Enabled         =   0   'False
      Height          =   615
      Left            =   120
      TabIndex        =   0
      Top             =   1080
      Width           =   2775
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "解密后的字节："
      Height          =   180
      Left            =   3240
      TabIndex        =   8
      Top             =   3720
      Width           =   1260
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "加密后的字节："
      Height          =   180
      Left            =   3240
      TabIndex        =   7
      Top             =   120
      Width           =   1260
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "解密的字串："
      Height          =   180
      Left            =   120
      TabIndex        =   3
      Top             =   2040
      Width           =   1080
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "要加密的字串："
      Height          =   180
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   1260
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub Command1_Click()

Dim X As Integer
Dim Y As Integer
Const Xd = 1
Const Yd = 2
Dim TxtByte() As Byte
Dim I As Integer
Dim txtPassWord() As Byte
Dim J As Integer
Dim str1 As String
If Encipher(Text1.Text, TxtByte) = False Then
    MsgBox "Encipher Error( at least 1 byte) "
    Exit Sub
End If

Dim FileNo As Integer
FileNo = FreeFile

Open "d:\guest.ppp" For Binary Access Write As #FileNo
'str1 = Str(TxtByte)
I = UBound(TxtByte)
Put #FileNo, , I
For J = 0 To I

    Put #FileNo, , TxtByte(J)
Next J


Close #FileNo


Open "d:\guest.ppp" For Binary Access Read As #FileNo
Get #FileNo, , I
ReDim TxtByte(0 To I)
For J = 0 To I

    Get #FileNo, , TxtByte(J)
Next J
Close #FileNo




If Decrypt(TxtByte, txtPassWord) = False Then MsgBox "Decrypt Error"
Text2.Text = txtPassWord 'Str(txtPassWord)

With Picture1
    .Cls
    Picture1.Scale (0, 0)-(12, 22)
    For I = LBound(TxtByte) To UBound(TxtByte)
        If I Mod 10 Then
            X = X + Xd
        Else
            X = 0
            Y = Y + Yd
        End If
        .CurrentX = X
        .CurrentY = Y
        Picture1.Print TxtByte(I)
    Next I
End With
X = 0
Y = 0
With Picture2
    .Cls
    Picture2.Scale (0, 0)-(12, 22)
    For I = LBound(txtPassWord) To UBound(txtPassWord)
        If I Mod 10 Then
            X = X + Xd
        Else
            X = 0
            Y = Y + Yd
        End If
        .CurrentX = X
        .CurrentY = Y
        Picture2.Print txtPassWord(I)
    Next I
End With
  
  
  
  
End Sub

Private Function Encipher(txtPassWord() As Byte, txtEncipher() As Byte) As Boolean

Dim MaskBit1 As Byte    '掩码变量
Dim MaskBit2 As Byte    '掩码变量
Dim I As Integer

If LenB(CStr(txtPassWord)) = 0 Then '错误拦截，判断要加密的字串的长度是否为零，为零退出。
    Encipher = False '加密不成功，返回FALSE。
    Exit Function
End If

ReDim txtEncipher(0 To LenB(CStr(txtPassWord)) * 2) '为动态数组变量重新分配存储空间，用于存储加密后的字串。

Randomize '初始化随机数生成器
For I = 0 To LenB(CStr(txtPassWord)) * 2   '产生2N+1个随机数字节。
    txtEncipher(I) = CByte(255 * Rnd + 0)
Next I
Call CreateMask(txtEncipher(0), MaskBit1, MaskBit2) '创建两个掩码

For I = 1 To LenB(CStr(txtPassWord)) * 2 Step 2 '根据掩码中”1“的位置，把随机序列的相应位置清零。
    txtEncipher(I) = txtEncipher(I) And (Not MaskBit1)
    txtEncipher(I + 1) = txtEncipher(I + 1) And (Not MaskBit2)
Next I


'下面的程序段把待加密的字串的每一位插入随机数列中，插入的位置与两掩码中1的位置相同，待加密字节(BYTE)中的前4位(BIT)由MASKBIT1确定，后4位(BIT)由MASKBIT1确定。
Dim SP As Integer '指示待加密字串中位(BIT)位置的变量。
Dim M As Integer '指示掩码中的位(BIT)的位置的变量
Dim T1 As Byte  ' 中间变量。
For I = 1 To LenB(CStr(txtPassWord)) * 2 Step 2
    '待加密的字串中字节(BYTE)的第0 到3位插入MASKBIT1规定的位置
    SP = 0
    For M = 0 To 7
        If (MaskBit1 And 2 ^ M) <> 0 Then ' 判断掩码中”1“的位置。
            T1 = (txtPassWord((I - 1) / 2) And 2 ^ SP) * 2 ^ (M - SP) ' / 2 ^ SP * 2 ^ M '把待加密的字节(BYTE)中的SP位，插入随机序列的第M位。
            txtEncipher(I) = txtEncipher(I) Or T1
            SP = SP + 1
           '  Exit For
        End If
    Next M
       
    '把待加密的字串中字节(BYTE)的 第4 到7位插入MASKBIT2规定的位置
    SP = 4
         
    For M = 0 To 7
      If (MaskBit2 And 2 ^ M) <> 0 Then
          T1 = (txtPassWord((I - 1) / 2) And 2 ^ SP) / 2 ^ SP * 2 ^ M
          txtEncipher(I + 1) = txtEncipher(I + 1) Or T1
          SP = SP + 1
      End If
    Next M
    
    txtEncipher(I) = txtEncipher(I) Xor txtEncipher(0) '随机序列的第1到2N个字节与第一个字节相异或(XOR)，你可以拿任任意一个随机字节来与其他字节相异或(XOR)而得到不同的加密方法。
    txtEncipher(I + 1) = txtEncipher(I + 1) Xor txtEncipher(0)
      
Next I
Encipher = True '加密成功，返回TRUE。

End Function


Private Function Decrypt(txtEncipher() As Byte, txtPassWord() As Byte) As Boolean

Dim MaskBit1 As Byte
Dim MaskBit2 As Byte
Dim I As Integer
If LenB(CStr(txtEncipher)) < 3 Or LenB(CStr(txtEncipher)) Mod 2 = 0 Then '错误拦截，判断要加密的字串的长度是否为零，为零退出
    Decrypt = False
    Exit Function
End If
ReDim txtPassWord(0 To (LenB(CStr(txtEncipher)) - 1) / 2 - 1)

Call CreateMask(txtEncipher(0), MaskBit1, MaskBit2) '创建两个掩码

Dim SP As Integer
Dim M As Integer
Dim T1 As Byte
For I = 1 To LenB(CStr(txtEncipher)) - 1 Step 2
    txtEncipher(I) = txtEncipher(I) Xor txtEncipher(0)
    txtEncipher(I + 1) = txtEncipher(I + 1) Xor txtEncipher(0)

    SP = 0
    For M = 0 To 7
        If (MaskBit1 And 2 ^ M) <> 0 Then
            T1 = (txtEncipher(I) And 2 ^ M) / 2 ^ M * 2 ^ SP
            txtPassWord((I - 1) / 2) = txtPassWord((I - 1) / 2) Or T1
            SP = SP + 1
         
        End If
    Next M
    SP = 4
    For M = 0 To 7
        If (MaskBit2 And 2 ^ M) <> 0 Then
            T1 = (txtEncipher(I + 1) And 2 ^ M) / 2 ^ M * 2 ^ SP
            txtPassWord((I - 1) / 2) = txtPassWord((I - 1) / 2) Or T1
            SP = SP + 1
         End If
    Next M
Next I
  Decrypt = True
End Function

Private Sub CreateMask(TempByte As Byte, MaskBit1 As Byte, MaskBit2 As Byte)
Dim Number1 As Integer ' 记录掩码中1的个数
Dim BitZero As Byte    '记录掩码中0的位置
For I = 0 To 7 Step 2  '先检测第一个随机数字节的第0，2，4，6 位是否为1，并把为1的位(BIT)移植到掩码中。
    If TempByte And 2 ^ I Then
        MaskBit1 = MaskBit1 Or 2 ^ I
        Number1 = Number1 + 1 '记录掩码中1的个数。
        If Number1 >= 4 Then Exit For '如果掩码中为1的位(BIT)的个数达到4，停止检测。
    Else
        BitZero = BitZero Or 2 ^ I '记录掩码中不为1的位(BIT)
    End If
Next I
If Number1 >= 4 Then GoTo FF '如果掩码中为1的位(BIT)的个数达到4，停止检测第1，3，5，7位。
For I = 1 To 7 Step 2 '检测第一个随机数字节的第1，3，5，7 位是否为1，并把为1的位(BIT)移植到掩码中。
    If TempByte And 2 ^ I Then
        MaskBit1 = MaskBit1 Or 2 ^ I
        Number1 = Number1 + 1
        If Number1 >= 4 Then Exit For
     Else
        BitZero = BitZero Or 2 ^ I
     End If
Next I

For I = Number1 + 1 To 4 '确包掩码中1的个数等于4。
    For J = 0 To 7
        If BitZero And 2 ^ J Then '检测掩码中不为1的位(BIT)，并移植到掩码中。
            BitZero = BitZero - 2 ^ J  '标记该位(BIT)已被使用。
            MaskBit1 = MaskBit1 Or 2 ^ J '把1移植到掩码中
            Exit For '移植1位后退出该此循环
        End If
    Next J
Next I
FF:
MaskBit2 = Not MaskBit1  '产生第二个掩码。

End Sub


Private Sub Text1_Change()

    If Len(Text1.Text) > 0 Then
        Command1.Enabled = True
    Else
        Command1.Enabled = False
    End If

End Sub