能给出几个vb对字符串加密的代码吗?

Question

如何对字符串进行加密解密
 
本人在操作数据库时，考虑到该数据库还有可能被其他软件打开，所以想能否有另外一种方式把数据库中数据进行加密呢，也
就是说，即使别人利用其他的软件打开了该数据库，看到的也是一片乱码，根本不知道数据库进而是什么内容。出于这种情况，本人利用VB中自带
RND（）函数的功能编写了如下加密解密方法。
当RND（）的参数（我们称它为种子）为负值时，同一种子产生同一个随机序列，同时VB还具有强大的二进制技术功能。
这样我们可以按以下方法实现字符串内容的加密解密。源程序如下：Public Function StringEnDeCodecn(strSource As String, MA) As String
'该函数只对中西文起到加密作用
'参数为：源文件，密码
On Error GoTo ErrEnDeCode
Dim X As Single
Dim CHARNUM As Long, RANDOMINTEGER As Integer
Dim SINGLECHAR As String * 1
Dim strTmp As String
If MA < 0 Then
MA = MA * (-1)
End If
X = Rnd(-MA)
For i = 1 To Len(strSource) Step 1 '取单字节内容
SINGLECHAR = Mid(strSource, i, 1)
CHARNUM = Asc(SINGLECHAR)
g: RANDOMINTEGER = Int(127 * Rnd)
If RANDOMINTEGER < 30 Or RANDOMINTEGER > 100 Then GoTo g
CHARNUM = CHARNUM Xor RANDOMINTEGER
strTmp = strTmp & Chr(CHARNUM)
Next i
StringEnDeCodecn = strTmp
Exit Function
ErrEnDeCode:
StringEnDeCodecn = ""
MsgBox Err.Number & "\" & Err.Description
End Function使用方法：
tmp=stringEnDecn("中华人民共和国",75)
如果要解密的话，只须键入以下语句：
tmp1=stringendecn(tmp,75)如有不妥之处，请与我联系：
如何对字符串进行加密解密
作者：Flea_cyp 
本人在操作数据库时，考虑到该数据库还有可能被其他软件打开，所以想能否有另外一种方式把数据库中数据进行加密呢，也
就是说，即使别人利用其他的软件打开了该数据库，看到的也是一片乱码，根本不知道数据库进而是什么内容。出于这种情况，本人利用VB中自带
RND（）函数的功能编写了如下加密解密方法。
当RND（）的参数（我们称它为种子）为负值时，同一种子产生同一个随机序列，同时VB还具有强大的二进制技术功能。
这样我们可以按以下方法实现字符串内容的加密解密。源程序如下：Public Function StringEnDeCodecn(strSource As String, MA) As String
'该函数只对中西文起到加密作用
'参数为：源文件，密码
On Error GoTo ErrEnDeCode
Dim X As Single
Dim CHARNUM As Long, RANDOMINTEGER As Integer
Dim SINGLECHAR As String * 1
Dim strTmp As String
If MA < 0 Then
MA = MA * (-1)
End If
X = Rnd(-MA)
For i = 1 To Len(strSource) Step 1 '取单字节内容
SINGLECHAR = Mid(strSource, i, 1)
CHARNUM = Asc(SINGLECHAR)
g: RANDOMINTEGER = Int(127 * Rnd)
If RANDOMINTEGER < 30 Or RANDOMINTEGER > 100 Then GoTo g
CHARNUM = CHARNUM Xor RANDOMINTEGER
strTmp = strTmp & Chr(CHARNUM)
Next i
StringEnDeCodecn = strTmp
Exit Function
ErrEnDeCode:
StringEnDeCodecn = ""
MsgBox Err.Number & "\" & Err.Description
End Function使用方法：
tmp=stringEnDecn("中华人民共和国",75)
如果要解密的话，只须键入以下语句：
tmp1=stringendecn(tmp,75)如有不妥之处，请与我联系：
[email protected]   
 

Answer 1

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Encrypt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit   Private LCW As Integer                 'Length of CodeWord
   Private LS2E As Integer                 'Length of String to be Encrypted
   Private LAM As Integer                 'Length of Array Matrix
   Private MP As Integer                    'Matrix Position
   Private Matrix As String                  'Starting Matrix
   Private mov1 As String                    'First Part of Replacement String
   Private mov2 As String                    'Second Part of Replacement String
   Private CodeWord As String            'CodeWord
   Private CWL As String                    'CodeWord Letter
   Private EncryptedString As String     'String to Return for Encrypt or String to UnEncrypt for UnEncrypt
   Private EncryptedLetter As String     'Storage Variable for Character just Encrypted
   Private strCryptMatrix(97) As String 'Matrix Array
Public Property Let KeyString(sKeyString As String)
    CodeWord = sKeyString
End Property
Public Function Encrypt(mstext As String) As String
    Dim X As Integer                    ' Loop Counter
    Dim Y As Integer                    'Loop Counter
    Dim Z As Integer                     'Loop Counter
    Dim C2E As String                   'Character to Encrypt
    Dim Str2Encrypt As String        'Text from TextBox    Str2Encrypt = mstext
    LS2E = Len(mstext)
    LCW = Len(CodeWord)
    EncryptedLetter = ""
    EncryptedString = ""    Y = 1
    For X = 1 To LS2E
        C2E = Mid(Str2Encrypt, 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 = EncryptedStringEnd Function
Private Sub Class_Initialize()    Dim W As Integer 'Loop Counter to set up Matrix
    Dim X As Integer     'Loop through Matrix
    
    Matrix = "8x3p5BeabcdfghijklmnoqrstuvwyzACDEFGHIJKLMNOPQRSTUVWXYZ 1246790-.#/\!@$<>&*()[]{}';:,?=+~`^|%_"
    Matrix = Matrix + Chr(13)  'Add Carriage Return to Matrix
    Matrix = Matrix + Chr(10)  'Add Line Feed to Matrix
    Matrix = Matrix + Chr(34)  'Add "
    ' Unique String used to make Matrix - 8x3p5Be
    ' Unique String can be any combination that has a character only ONCE.
    ' EACH Letter in the Matrix is Input ONLY once.
    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) = mov2 + mov1  'Makes up each row of the Array
        W = W + 1
    Next X
End Sub使用
'加密/解密字符串
Function Encrypt_String(OldStr As String) As String
    Dim MyEncrypt As New Encrypt
    
    MyEncrypt.KeyString = "SG"
    Encrypt_String = MyEncrypt.Encrypt(OldStr)
End Function

Answer 2

'------------------------------------------------------
'功  能：通过Password串，加密字符串
'
'参  数：  strEnTxt    需求加密的字符串
'          strPassword 加密串
'
'返回值：加密后的字符串
'
'------------------------------------------------------
Public Function EncryptStr(ByVal strEnTxt As String, _
ByVal strPassword As String) As String    Dim i As Integer
    Dim j As Long
    Dim X As Long
    Dim Y As Long
    Dim g As Long
    Dim str As String
    On Error Resume Next
    
    For i = 1 To Len(strPassword)
        j = Asc(Mid(strPassword, i, 1))
        X = X + j
    Next i
        
    X = X Mod 6
    Y = X
    g = 0
    For i = 1 To Len(strEnTxt)
        j = Asc(Mid(strEnTxt, i, 1))
        g = g + 1
        If g = 6 Then g = 0
        Select Case g
            Case 0
                X = j - (Y - 2)
            Case 1
                X = j + (Y - 5)
            Case 2
                X = j - (Y - 4)
            Case 3
                X = j + (Y - 2)
            Case 4
                X = j - (Y - 3)
            Case 5
                X = j + (Y - 5)
        End Select
        X = X + g
        str = str & Chr(X)
    Next i
    
    EncryptStr = str
    
End Function

Answer 3

lihonggen0(用VB) 给出的方法不好，因为VB所用的是unicode字符，而unicode字符中会出现同一字符而编码不一样的情况，所以有时加密后，解出来的结果错误。
gump2000(阿甘)的方法看起来还可以。