frmceaser.frm

一个 ceaser转换文本加密技术(例子 )

VERSION 5.00
Begin VB.Form frmCeaser 
   Caption         =   "Ceaser Shift Cipher"
   ClientHeight    =   5985
   ClientLeft      =   2205
   ClientTop       =   1980
   ClientWidth     =   6585
   LinkTopic       =   "Form1"
   ScaleHeight     =   5985
   ScaleWidth      =   6585
   Begin VB.TextBox txtDepth 
      Height          =   285
      Left            =   360
      TabIndex        =   3
      Text            =   "0"
      Top             =   5160
      Width           =   1215
   End
   Begin VB.CommandButton cmddecode 
      Caption         =   "&Decode"
      Height          =   375
      Left            =   3600
      TabIndex        =   2
      Top             =   5400
      Width           =   1215
   End
   Begin VB.CommandButton cmdencode 
      Caption         =   "&Encode"
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   5400
      Width           =   1215
   End
   Begin VB.TextBox txtEnc 
      Height          =   4335
      Left            =   360
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   360
      Width           =   5895
   End
   Begin VB.Label Label2 
      Caption         =   "Text to Encode / Decode"
      Height          =   255
      Left            =   360
      TabIndex        =   5
      Top             =   120
      Width           =   1935
   End
   Begin VB.Label Label1 
      Caption         =   "Shift by 1-254"
      Height          =   255
      Left            =   360
      TabIndex        =   4
      Top             =   4920
      Width           =   1215
   End
End
Attribute VB_Name = "frmCeaser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Public Function Encode(Data As String, Optional Depth As Integer) As String

Dim TempChar As String
Dim TempAsc As Integer
Dim NewData As String
Dim vChar As Integer

For vChar = 1 To Len(Data)
    TempChar = Mid$(Data, vChar, 1)
        TempAsc = Asc(TempChar)
        If Depth = 0 Then Depth = 40 'DEFAULT DEPTH
        If Depth > 254 Then Depth = 254

        TempAsc = TempAsc + Depth
        If TempAsc > 255 Then TempAsc = TempAsc - 255
        TempChar = Chr(TempAsc)
        NewData = NewData & TempChar
Next vChar
Encode = NewData

End Function

Public Function Decode(Data As String, Optional Depth As Integer) As String

Dim TempChar As String
Dim TempAsc As Integer
Dim NewData As String
Dim vChar As Integer

For vChar = 1 To Len(Data)
    TempChar = Mid$(Data, vChar, 1)
        TempAsc = Asc(TempChar)
        If Depth = 0 Then Depth = 40 'DEFAULT DEPTH
        If Depth > 254 Then Depth = 254
    TempAsc = TempAsc - Depth
        If TempAsc < 0 Then TempAsc = TempAsc + 255
        TempChar = Chr(TempAsc)
        NewData = NewData & TempChar
Next vChar
Decode = NewData

End Function

Private Sub cmddecode_Click()
   txtEnc.Text = Decode(txtEnc.Text, CInt(txtDepth.Text))
End Sub

Private Sub cmdencode_Click()
   txtEnc.Text = Encode(txtEnc.Text, CInt(txtDepth.Text))
End Sub