Программа шифрования: исправить код - VB

Option Explicit
 
' ....----==== API Declarations ====----....
 
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
 
'---------------------------------------------------------------------------------------
' Procedure : EncryptData
' Purpose   : Encrypts a byte array.
'---------------------------------------------------------------------------------------
'
Public Function EncryptData( _
   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)
   
   ' ····----==== Added 11/04/2003 ====----····
   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 object
      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), lBufLen, lDataLen)
                  
                  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

Private Sub Command3_Click()
intFH = FreeFile
Open Text1.Text For Input As #intFH
Text1.Text = Input$(LOF(intFH), intFH)
Close #intFH
StrEnc = EncryptData(Text1.Text)
intFH = FreeFile
Open "M.txt" For Output As #intFH
Print #intFH, StrEnc
Close #intFH
End Sub