dsencrypr.cls

用户登陆This function is leting user load,but it is not very useful and very common

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "dsEncrypr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private MydsEncrypt As dsEncrypr
    '实例化对象
'   Set MydsEncrypt = New dsEncrypr
   '设置密钥
'   MydsEncrypt.KeyString = (密钥内容)
   '调用加密函数，并得到加密后的内容
'   加密后文本 = MydsEncrypt.Encrypt(需要加密文本)

Private LCW As Integer     '密钥长度
Private LS2E As Integer    '加密字符串长度
Private LAM As Integer     '字符表的长度
Private MP As Integer      '字符表的位置
Private Matrix As String   '字符矩阵
Private mov1 As String     '代替字符串的第一部分
Private mov2 As String     '代替字符串的第二部分
Private CodeWord As String '密钥
Private CWL As String      '密钥中的字符
Private Encryptedstring As String  '加密后的字符串
Private Encryptedletter As String  '加密后的字符
Private strCryptMatrix(97) As String '字符表
Public Property Let KeyString(sKeyString As String)
    CodeWord -sKeyString
End Property
Public Function Encrypt(mstext As String) As String
'加密函数
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim C2E As String
Dim str2Enerypt As String
'需要加密的字符串
str2Enerypt = mstext
'字符串长度
LS2E = Len(CodeWord)
Encryptedletter = ""
Encryptedstring = ""
Y = 1
For i = 1 To LS2E
    '获得要加密的字符
    C2E = Mid(str2Enerypt, X, 1)
    '在字符表中取相同字符
    MP = InStr(1, Matrix, C2E, 0)
    '获得当前密钥的字符
    CWL = Mid(CodeWord, Y, 1)
    For Z = 1 To LAM
        '判断字符表中是否有相同字符
        If Mid(strCryptMatrix(Z), MP, 1) = CWL Then
           Encryptedletter = Left(strCryptMatrix(Z), 1)
           Encryptedstring = Encryptedstring + Encryptedletter
           Exit For
        End If
    Next Z
    Y = Y + 1
    If Y > LCW Then Y = 1
Next X
    '返回加密后的字符串
    Encrypt = Encryptedstring
End Function
'类的初始化
Private Sub Class_Initialize()
Dim W As Integer
Dim X As Integer
'字符表
Matrix = "8x3p5BeabcdfghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1246790-.#^@$<>&*()';:,?=+~|%_"
'加入回车
Matrix = Matrix + Chr(13)
'加入换行符
Matrix = Matrix + Chr(10)
'加入引号
Matrix = Matrix + Chr(34)
'产生字符矩阵
W = 1
LAM = Len(Matrix)
strCryptMatrix(1) = Matrix
For X = 2 To LAM 'LAM=Length of Array Matrix
    mov1 = Left(strCryptMatrix(W), 1)  'First Character of strCryptMatrix
    mov2 = Right(strCryptMatrix(W), (LAM - 1)) 'All but first Character of strCryptMatrix
    strCryptMatrix(X) = mov1 + mov2 'Makes up each row of the Array
    W = W + 1
Next X
End Sub
'Private MydsEncrypt As dsEncrypr

      
'End Sub