blowfishの実装について

質問

はじめまして！

現在暗号化アルゴリズムであるblowfishを実装しようと試みている最中なのですが、いまいちうまくいきません。
http://www.di-mgt.com.au/crypto.html
上記のページにあるフリーのサンプルを利用し、
・任意の文字列を暗号化してファイルに吐き出し
・ファイルから暗号化した文字列を取り出して複合化
という処理をしようとしているのですが、複合化がうまくいきません。
暗号化はサンプルアプリと同じ結果になるのでうまくいっているようです。
サンプルは暗号化した文字列変数をそのまま複合化しているのですが、そこにポイントがありそうなことまではわかりました。
処理単位が8ビットらしいのですが、当方、いかんせん英語がからっきしダメなことと、VB自体にそれほど精通していないので全く先に進みません。
どなたかご教授いただけないでしょうか？
VBのサンプルや日本語での解説のあるサイト、書籍の紹介などでも結構です。
よろしくお願い致します。

回答No.2

Azzuri

サンプルを見てみましたが、複合化する際にファイル
から取り出した文字列をUnicodeからシステムコードに
変換する必要があります。
例）
Dim a() as Byte
a = StrConv("複合化対象文字列", vbFromUnicode)
この結果をblf_BytesDecで使用すれば大丈夫だと
思います。

補足

お返事遅くなり申し訳ありません。
いただいた回答ですが、実は既に試していたのですが
やはり結果が安定しません（問題なく複合化できるときもありますが、基本的にはうまくいきません）

複合化の処理を行うボタンを押したときのコードは以下です。

Dim abPlain() As Byte
Dim abtemp() As Byte
Dim strTemp As String　（暗号化後の表示文字列）

　　'暗号化された値の取得
strTemp = Text3.Text
abtemp = StrConv(strTemp, vbFromUnicode)

　　'複合化
abPlain = blf_BytesDec(abtemp)

　　'複合化後の結果をテキストボックスに表示
Text2.Text = StrConv(abPlain, vbUnicode)

まだどこかに見落としがあるのでしょうか？・・・・

回答No.1

Azzuri

以下の内容を標準モジュールに記述してください。

Option Explicit

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" ( _
ByRef phProv As Long, _
ByVal pszContainer As String, _
ByVal pszProvider As String, _
ByVal dwProvType As Long, _
ByVal dwFlags As Long) As Long

Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
ByVal hProv As Long, _
ByVal dwFlags As Long) As Long

Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _
ByVal hProv As Long, _
ByVal Algid As Long, _
ByVal hKey As Long, _
ByVal dwFlags As Long, _
ByRef phHash As Long) As Long

Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _
ByVal hHash As Long) As Long

Private Declare Function CryptHashData Lib "advapi32.dll" ( _
ByVal hHash As Long, _
pbData As Any, _
ByVal dwDataLen As Long, _
ByVal dwFlags As Long) As Long

Private Declare Function CryptDeriveKey Lib "advapi32.dll" ( _
ByVal hProv As Long, _
ByVal Algid As Long, _
ByVal hBaseData As Long, _
ByVal dwFlags As Long, _
ByRef phKey As Long) As Long

Private Declare Function CryptDestroyKey Lib "advapi32.dll" ( _
ByVal hKey As Long) As Long

Private Declare Function CryptEncrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, _
ByVal hHash As Long, _
ByVal Final As Long, _
ByVal dwFlags As Long, _
pbData As Any, _
ByRef pdwDataLen As Long, _
ByVal dwBufLen As Long) As Long

Private Declare Function CryptDecrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, _
ByVal hHash As Long, _
ByVal Final As Long, _
ByVal dwFlags As Long, _
pbData As Any, _
ByRef pdwDataLen As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Dest As Any, _
Src As Any, _
ByVal Ln As Long)

Private Const PROV_RSA_FULL = 1

Private Const CRYPT_NEWKEYSET = &H8

Private Const ALG_CLASS_HASH = 32768
Private Const ALG_CLASS_DATA_ENCRYPT = 24576&

Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536&
Private Const ALG_TYPE_STREAM = 2048&

Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4

Private Const ALG_SID_DES = 1
Private Const ALG_SID_3DES = 3
Private Const ALG_SID_RC2 = 2
Private Const ALG_SID_RC4 = 1

Enum HashAlgorithm
MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
End Enum

Enum EncAlgorithm
DES = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_DES
[3DES] = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_3DES
RC2 = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_RC2
RC4 = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM Or ALG_SID_RC4
End Enum

'暗号化
Public Function EncryptData(ByRef Data() As Byte, _
ByVal Password As String, _
Optional ByVal HashAlgorithm As HashAlgorithm = MD5, _
Optional ByVal EncAlgorithm As EncAlgorithm = RC4) As Byte()
Dim lRes As Long
Dim hProv As Long
Dim hHash As Long
Dim hKey As Long
Dim lBufLen As Long
Dim lDataLen As Long
Dim abData() As Byte

' Get default provider context handle
lRes = CryptAcquireContext(hProv, _
vbNullString, _
vbNullString, _
PROV_RSA_FULL, _
0)

If lRes = 0 And Err.LastDllError = &H80090016 Then
' There's no default keyset container!!!
' Get the provider context and create
' a default keyset container
lRes = CryptAcquireContext(hProv, _
vbNullString, _
vbNullString, _
PROV_RSA_FULL, _
CRYPT_NEWKEYSET)
End If

If lRes <> 0 Then
' Create a hash
lRes = CryptCreateHash(hProv, _
HashAlgorithm, _
0, _
0, _
hHash)
If lRes <> 0 Then
' Hash the password
lRes = CryptHashData(hHash, _
ByVal Password, _
Len(Password), _
0)
If lRes <> 0 Then
' Derive a key from the hash
lRes = CryptDeriveKey(hProv, _
EncAlgorithm, _
hHash, _
0, _
hKey)
If lRes <> 0 Then
' Calculate the array size
lBufLen = UBound(Data) - LBound(Data) + 1
lDataLen = lBufLen
' Get required buffer size
lRes = CryptEncrypt(hKey, 0&, 1, 0, ByVal 0&, lBufLen, 0)
If lRes <> 0 Then
' Initialize the buffer
If lBufLen < lDataLen Then lBufLen = lDataLen
ReDim abData(0 To lBufLen - 1)
MoveMemory abData(0), Data(LBound(Data)), lDataLen
' Encrypt the data
lRes = CryptEncrypt(hKey, _
0&, _
1, _
0, _
abData(0), _
lDataLen, _
lBufLen)
If lRes <> 0 Then
' Resize the array if the encrypted
' size is <> than the data size
If lDataLen <> lBufLen Then
ReDim Preserve abData(0 To lBufLen - 1)
End If
' Return the encrypted data
EncryptData = abData
End If
End If
End If
' Destroy the key
CryptDestroyKey hKey
End If
' Destroy the hash
CryptDestroyHash hHash
End If
' Release the provider context
CryptReleaseContext hProv, 0
End If

' Raise an error if lRes = 0
If lRes = 0 Then Err.Raise Err.LastDllError
End Function

'複合化
Public Function DecryptData(ByRef Data() As Byte, _
ByVal Password As String, _
Optional ByVal HashAlgorithm As HashAlgorithm = MD5, _
Optional ByVal EncAlgorithm As EncAlgorithm = RC4) As Byte()
Dim lRes As Long
Dim hProv As Long
Dim hHash As Long
Dim hKey As Long
Dim lBufLen As Long
Dim abData() As Byte

' Get default provider context handle
lRes = CryptAcquireContext(hProv, _
vbNullString, _
vbNullString, _
PROV_RSA_FULL, _
0)

If lRes = 0 And Err.LastDllError = &H80090016 Then
' There's no default keyset container!!!
' Get the provider context and create
' a default keyset container
lRes = CryptAcquireContext(hProv, _
vbNullString, _
vbNullString, _
PROV_RSA_FULL, _
CRYPT_NEWKEYSET)
End If

If lRes <> 0 Then
' Create a hash
lRes = CryptCreateHash(hProv, _
HashAlgorithm, _
0, _
0, _
hHash)
If lRes <> 0 Then
' Hash the password
lRes = CryptHashData(hHash, _
ByVal Password, _
Len(Password), _
0)
If lRes <> 0 Then
' Derive a key from the hash
lRes = CryptDeriveKey(hProv, _
EncAlgorithm, _
hHash, _
0, _
hKey)
If lRes <> 0 Then
' Calculate the array size
lBufLen = UBound(Data) - LBound(Data) + 1
' Initialize the buffer
ReDim abData(0 To lBufLen - 1)
MoveMemory abData(0), Data(LBound(Data)), lBufLen
' Decrypt the data
lRes = CryptDecrypt(hKey, 0&, 1, 0, abData(0), lBufLen)
If lRes <> 0 Then
ReDim Preserve abData(0 To lBufLen - 1)
' Return the encrypted data
DecryptData = abData
End If
End If
' Destroy the key
CryptDestroyKey hKey
End If
' Destroy the hash
CryptDestroyHash hHash
End If
' Release the provider context
CryptReleaseContext hProv, 0
End If

' Raise an error if lRes = 0
If lRes = 0 Then Err.Raise Err.LastDllError
End Function

使用方法は、
Dim a() As Byte
Dim b() As Byte
a = "あいうえお" & vbCrLf & "かきくけこ"
'暗号化
b = EncryptData(a, "PASSWARD")
MsgBox b
'複合化
a = DecryptData(b, "PASSWARD")
MsgBox a

MD5に対応していますが、御使用は自己責任でお願いします。

補足

Azzuri様
ご回答ありがとうございます。

ですが、暗号化ロジックとしてMD5ではなくblowfishを使用しなければならないのです。
コピーするだけで使用できるサンプルをいただいて
とてもありがたいのですが。。。。

申し訳ありません。