Mã hóa dữ liệu

Thảo luận trong 'Ứng dụng Excel' bắt đầu bởi levanduyet, 28 Tháng năm 2006.

2,252 lượt xem

  1. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    Mã hóa dữ liệu
    Đây cũng là một đề tài khá hấp dẫn một khi các bạn đã phát triển các ứng dụng của mình đến một giai đọan nào đó. Khi làm việc với các dữ liệu nhạy cảm như password, số tài khỏan,...vv...
    Tôi xin giới thiệu với các bạn một class module để làm việc này:
    'Option Compare Database
    Option Explicit
    ' Comersus 5.0x Sophisticated Cart
    ' Developed by Rodrigo S. Alhadeff for Comersus Open Technologies
    ' USA - 2003
    ' Open Source License can be found at documentation/readme.txt
    ' http://www.comersus.com
    ' Details: RC4 and DES redirection encryption functions
    ' This script performs 'RC4' Stream Encryption (Based on what is widely thought to be RSA's RC4 algorithm. It produces output streams that are identical to the commercial products). This script is Copyright © 1999 by Mike Shaffer ALL RIGHTS RESERVED WORLDWIDE

    Private sBox(255)
    Private rc4Key(255)
    Private pEncryptionMethod As String
    Private Password As String

    Property Let CryptoKey(CryptoPassword As String)
    Password = CryptoPassword
    End Property

    Property Get Encrypt(PlainText As String) As String
    If pEncryptionMethod = "DES" Then
    Encrypt = DESEncrypt(PlainText, Password)
    Else
    Encrypt = RC4EnCryptASC(PlainText, Password)
    End If
    End Property

    Property Get Decrypt(PlainText As String) As String
    If pEncryptionMethod = "DES" Then
    Decrypt = DESDecrypt(PlainText, Password)
    Else
    Decrypt = RC4DeCryptASC(PlainText, Password)
    End If
    End Property

    Function DESEncrypt(i1 As String, i2 As String)

    End Function

    Private Function DESDecrypt(i1 As String, i2 As String)

    End Function

    Private Sub RC4Initialize(strPwd As String)
    ' this routine called by EnDeCrypt function. Initializes the sbox and the key array
    Dim tempSwap, a, b
    Dim intLength
    ' get length of the key
    intLength = Len(strPwd)

    ' iterate through all characters contained in key repeating number of characters is 255
    For a = 0 To 255
    ' load ANSI for each char contained in the key
    rc4Key(a) = Asc(Mid(strPwd, (a Mod intLength) + 1, 1))
    ' load numbers from 0 to 255
    sBox(a) = a
    Next

    b = 0
    ' iterate through arrays
    For a = 0 To 255
    b = (b + sBox(a) + rc4Key(a)) Mod 256
    tempSwap = sBox(a)
    sBox(a) = sBox(b)
    sBox(b) = tempSwap
    Next
    End Sub

    Private Function EnDeCrypt(plaintxt As String, psw As String)
    Dim temp, a, i, J, k, cipherby, cipher
    i = 0
    J = 0

    RC4Initialize psw

    For a = 1 To Len(plaintxt)
    i = (i + 1) Mod 256
    J = (J + sBox(i)) Mod 256
    temp = sBox(i)
    sBox(i) = sBox(J)
    sBox(J) = temp

    k = sBox((sBox(i) + sBox(J)) Mod 256)

    cipherby = Asc(Mid(plaintxt, a, 1)) Xor k
    cipher = cipher & Chr(cipherby)
    Next

    EnDeCrypt = cipher
    End Function

    Private Function RC4EnCryptASC(plaintxt As String, psw As String)
    Dim temp, a, i, J, k, cipherby, cipher

    i = 0
    J = 0

    RC4Initialize psw

    For a = 1 To Len(plaintxt)
    i = (i + 1) Mod 256
    J = (J + sBox(i)) Mod 256
    temp = sBox(i)
    sBox(i) = sBox(J)
    sBox(J) = temp

    k = sBox((sBox(i) + sBox(J)) Mod 256)

    cipherby = Asc(Mid(plaintxt, a, 1)) Xor k
    cipher = cipher & "|" & cipherby
    Next

    RC4EnCryptASC = cipher

    End Function

    Private Function RC4DeCryptASC(plaintxt As String, psw As String)
    plaintxt = GetRC4String(plaintxt)
    Dim temp, a, i, J, k, cipherby, cipher
    i = 0
    J = 0
    Dim arrayEncrypted
    RC4Initialize psw
    For a = 1 To Len(plaintxt)
    i = (i + 1) Mod 256
    J = (J + sBox(i)) Mod 256
    temp = sBox(i)
    sBox(i) = sBox(J)
    sBox(J) = temp

    k = sBox((sBox(i) + sBox(J)) Mod 256)

    cipherby = Asc(Mid(plaintxt, a, 1)) Xor k
    cipher = cipher & Chr(cipherby)
    Next
    RC4DeCryptASC = cipher
    End Function

    Private Function GetRC4String(iString As String) As String
    Dim i As Long
    Dim J As Long
    ' remove dash
    Dim iStr As String
    Dim iRet As String
    iStr = iString
    While InStr(iStr, "|") <> 0
    i = InStr(1, iStr, "|")
    J = InStr(2, iStr, "|")
    If J = 0 Then
    iRet = iRet & Chr(Val(Mid(iStr, i + 1)))
    iStr = Mid(iStr, i + 1)
    Else
    iRet = iRet & Chr(Val(Mid(iStr, i + 1, J - i - 1)))
    iStr = Mid(iStr, J)
    End If
    Wend
    GetRC4String = iRet
    End Function

    Private Sub Class_Initialize()
    pEncryptionMethod = "RC4"
    End Sub

    Thân,

    Lê Văn Duyệt
    PS: hy vọng là chúng ta sẽ có một vài buổi học về chuyên đề class module để sử dụng được các nguồn tài nguyên OpenSource này.
     
    #1
  2. hai2hai

    hai2hai VNUNI Makes a difference

    Bài viết:
    2,012
    Đã được thích:
    128
    Nơi ở:
    Hà nội
    Cũng lại là Google :) : "Encryption + VB SourceCode"

    Thậm chí chỉ với google như vậy ta có thể có cả source code của 1 ứng dụng với hầu hết các kiểu mã hóa với giao diện chương trình chẳng kém gì 1 phần mềm thương mại của nước ngoài về món này (và hầu hết các món khác nữa như ZIP, UnZip, Rar, UnRAR, email client, ftp client/server,...)

    Chú ý: Nên tuân thủ luật khi sử dụng free/open source code (phải ghi rõ credit to tên (các) tác giả ở trong code nhé). Nếu dùng cho thương mại thì nên viết email xin phép quyền sử dụng (và vẫn phải ghi tên tác giả trong code, ko được xóa đi).
     
    #2

Chia sẻ trang này