reorder.frm

一个用vb编写的加密解密的小程序. 经过试用适合6位以内的加密和解密

VERSION 5.00
Begin VB.Form Asc 
   Caption         =   "加密"
   ClientHeight    =   5250
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   9480
   LinkTopic       =   "Form1"
   ScaleHeight     =   5250
   ScaleWidth      =   9480
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "Exit"
      Height          =   375
      Left            =   6720
      TabIndex        =   12
      Top             =   4440
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "deencrypt"
      Height          =   375
      Left            =   3000
      TabIndex        =   8
      Top             =   4440
      Width           =   1215
   End
   Begin VB.TextBox Txtencode 
      Height          =   495
      Left            =   1440
      TabIndex        =   7
      Top             =   2280
      Width           =   8055
   End
   Begin VB.TextBox Txtinput 
      Height          =   495
      Left            =   1440
      TabIndex        =   6
      Top             =   1200
      Width           =   8055
   End
   Begin VB.TextBox txtkey 
      Height          =   495
      Left            =   1320
      TabIndex        =   5
      Top             =   120
      Width           =   2415
   End
   Begin VB.TextBox txtRecode 
      Height          =   495
      Left            =   1440
      TabIndex        =   4
      Top             =   3360
      Width           =   8055
   End
   Begin VB.CommandButton cmdcls 
      Caption         =   "clear"
      Height          =   375
      Left            =   4920
      TabIndex        =   3
      Top             =   4440
      Width           =   1215
   End
   Begin VB.CommandButton cmdcode 
      Caption         =   "encrypt"
      Height          =   375
      Left            =   1200
      TabIndex        =   2
      Top             =   4440
      Width           =   1215
   End
   Begin VB.CommandButton cmdkey 
      Caption         =   "key"
      Height          =   375
      Left            =   4320
      TabIndex        =   1
      Top             =   240
      Width           =   1215
   End
   Begin VB.Label Label4 
      Caption         =   "Decode"
      Height          =   375
      Left            =   240
      TabIndex        =   11
      Top             =   3720
      Width           =   735
   End
   Begin VB.Label Label3 
      Caption         =   "Encode"
      Height          =   375
      Left            =   240
      TabIndex        =   10
      Top             =   2280
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "Input"
      Height          =   375
      Left            =   240
      TabIndex        =   9
      Top             =   1320
      Width           =   735
   End
   Begin VB.Label lblInput 
      Caption         =   "Keyword"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   735
   End
End
Attribute VB_Name = "Asc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strInput, strout As String * 70, Code As String * 70
Dim encode, decode, recode As String * 70, strTemp, a(10), b(10), b1(20) As String
Dim i As Integer, length As Integer
Dim iAsc As Integer
Dim j, m, n, keylength As Integer
Dim c(), d(), f(), ch As String * 1
Dim t

Private Sub cmdcls_Click()
      'txtCode.Text = ""
      txtRecode.Text = ""
      Txtinput.Text = ""
      txtkey.Text = ""
      Txtencode = ""
End Sub

Private Sub cmdkey_Click()
encode = ""
Txtencode = ""
encode = ""
Txtencode = ""
     strkey = "keyword"
     txtkey = strkey
     'strkey = txtkey
                 i = 1
      Code = ""
      strkey = Mid$(strkey, 1, 7)
      length = Len(strkey)
      keylength = length
      Do While (i <= length)
          strTemp = Mid$(strkey, i, 1)
          a(i) = strTemp
          For j = 0 To 25
          If Chr$(97 + j) = strTemp Then
          b(i) = 97 + j
        iAsc = 97 + j
         End If
          Next j
                Code = Left$(Code, i - 1) + Chr$(iAsc)
         
          i = i + 1
      Loop
      
      For i = 1 To 9
      b1(i) = b(i)
      Next i
      n = 10

For i = 1 To n - 1
For j = i + 1 To n
If b1(i) > b1(j) Then
t = b1(i): b1(i) = b1(j): b1(j) = t
End If
Next j
'Print b1(i), b(i)
Next i
'Print b1(n), b(i)
j = 1
For i = 4 To 10

b1(j) = b1(i)
'Print b1(j), j
j = j + 1
Next i
End Sub

Private Sub cmdcode_Click()
ReDim c(300), d(45, 45), f(300)
strInput = ""
Txtencode = ""
encode = ""
keylength = Len(txtkey)
strInput = Txtinput.Text
'strInput = "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"
length = Len(strInput)
length1 = length
 If length < 49 Then
 strInput = strInput + Space$(49 - length)
End If
length = 49
Txtinput = Trim$(Mid$(strInput, 1, length1))
 i = 1
      
      'Print Length
      Do While (i <= length)
          strTemp = Mid$(strInput, i, 1)
         ' If (strTemp >= "A" And strTemp <= "Z") Then
          ' LCase$ (strTemp)
         '  End If
         ' If IsNumeric(strTemp) Then
         ' strTemp = "a"
          'End If
         
          c(i) = strTemp
          i = i + 1
          'Print strTemp
         'txtCode = txtCode + strTemp
      Loop
      k = 1
      For i = 1 To 7
      For j = 1 To 7
      d(i, j) = c(k)
     k = k + 1
     Next j
     Next i
    
      encode = ""
      txtcode = ""
      
For i = 1 To 7
For j = 1 To 7
encode = encode + d(j, i)
Next j
Next i
txtcode = encode
'txtCode = Mid$(txtCode, 1, 49)
encode = ""
Txtencode = ""
For i = 1 To 7
'Print b1(i)
Next i

For i = 1 To 7
For j = 1 To 7
If b1(i) = b(j) Then
'Print j
j = 7 * (j - 1) + 1
'Print b1(i), j
'Txtencode = Mid$(txtCode, j, 7)
encode = encode + Mid$(txtcode, j, 7)
End If
Next j
'Txtencode = Txtencode + encode
Next i
Txtencode = Txtencode + encode
strout = Txtencode
Txtencode = ""
For k = 1 To 49
ch = Mid$(strout, k, 1)
 If ch <> " " Then
 Txtencode = Txtencode + ch
 End If
Next k
End Sub

Private Sub Command1_Click()
   decode = ""
   txtRecode = ""
Call recodep(1)
Call recodep(2)
Call recodep(3)
Call recodep(4)
Call recodep(5)
Call recodep(6)
Call recodep(7)

End Sub
Sub recodep(k)
For i = 1 To 7
For j = 1 To 7
If b(i) = b1(j) Then

j = 7 * (j - 1) + k

decode = decode + Mid$(strout, j, 1)

End If
Next j

Next i
txtRecode = decode

End Sub

Private Sub Command2_Click()
End
End Sub