Ir para conteúdo
Fórum Script Brasil
  • 0

Erro na compilação do arquivo executavel


T.H.U.G. L.I.F.E.

Pergunta

Quando vou compilar o arquivo executavel de 1 projeto aparece a seguinte mensagem:

"The Project 'Encrypt' can not be built because it references project

'C:\projeto\CryptWrap.vbp' which does not have a binary compatibility file set."

tenho 1 class module chamada clsCryptoAPI(clsCryptoAPI.cls) que ta dentro do projeto CryptWrap.vbp e tenho 1 form dentro d 1 projeto chamado Encrypt, abaixo vou colocar a programação:

clsCryptoAPI:

Option Explicit
' ---------------------------------------------------------------------------
' Module level variables
' ---------------------------------------------------------------------------
    Private g_lngCryptoContext       As Long
    Private g_strInData          As String
    Private g_abytOutData()      As Byte
    Private g_abytPassword()           As Byte
    '
    Private Const ALG_CLASS_ANY     As Long = 0
    Private Const ALG_TYPE_ANY      As Long = 0
    Private Const ALG_CLASS_HASH    As Long = 32768
    Private Const ALG_TYPE_BLOCK    As Long = 1536
    Private Const ALG_CLASS_DATA_ENCRYPT  As Long = 24576
    Private Const ALG_SID_RC2       As Long = 2
    Private Const ALG_SID_SHA1      As Long = 4
    ' Hash algorithms
    Private Const CALG_SHA1         As Long = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
    ' Block ciphers
    Private Const CALG_RC2          As Long = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_RC2
    ' CryptSetProvParam
    Private Const PROV_RSA_FULL        As Long = 1
    ' used when aquiring the provider
    Private Const CRYPT_VERIFYCONTEXT  As Long = &HF0000000
    ' Microsoft provider data
    Private Const MS_DEFAULT_PROVIDER  As String = _
                  "Microsoft Base Cryptographic Provider v1.0"
    ' used to specify not to use any salt value while deriving the key
    Private Const CRYPT_NO_SALT As Long = &H10
' ---------------------------------------------------------------------------
' Declares
' ---------------------------------------------------------------------------
    '
      Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
              (dest As Any, source As Any, ByVal bytes As Long)
    '
      Private Declare Function GetLastError Lib "kernel32" () As Long
    '
      Private Declare Function CryptHashData Lib "advapi32.dll" _
              (ByVal hhash As Long, ByVal pbData As String, _
              ByVal dwDataLen 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 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 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, ByVal pbData As String, _
              ByRef pdwDataLen As Long, ByVal dwBufLen As Long) As Long
    '
    '---------------------------Properties-------------------------
    '
    Public Property Let InputData(arInData() As Byte)
    '
      g_strInData = ByteArrayToString(arInData())
    '
    End Property
    '
    Public Property Get OutputData() As Byte()
    '
      OutputData = g_abytOutData
    '
    End Property
    '
    Public Property Let Password(arPWord() As Byte)
    '
      Erase g_abytPassword()                  ' Empty module level password array
      ReDim g_abytPassword(0)                 ' resize to smallest size
      '
      If UBound(arPWord) > 0 Then
          g_abytPassword = arPWord            ' transfer pass array to module array
          Erase arPWord()                  ' erase passed array
      End If
    '
    End Property
    '
    Public Property Get Password() As Byte()
    '
      Password = g_abytPassword()
    '
    End Property

'
'----------------------Functions and Procedures-------------------------
'
    Public Function ByteArrayToString(arByte() As Byte) As String
    '
    ' ------------------Define variables---------------------------------
    '
      Dim lngCounter          As Long
      Dim lngMax           As Long
      Dim lngLen        As Long
      Dim lngPadLen    As Long
      Dim lngIdx  As Long
      Dim strTemp          As String
      Dim strOut        As String
      
      Const ADD_SPACES     As Long = 10000
      
    '
    ' -----------------Determine amount of data in the byte array.--------------------
    '
      strTemp = ""
      lngIdx = 1                 ' index pointer for output string
      lngMax = UBound(arByte)    ' determine number of elements in array
      lngPadLen = (ADD_SPACES * 9)    ' 90000 blank spaces
      strOut = Space$(lngPadLen)   ' preload output string
      
    '
    ' ------------Unload the byte array and convert each character back to its ASCII-------------
    ' ----------------------------------------character value------------------------------------
    '
      For lngCounter = 0 To lngMax - 1
          
          strTemp = Chr$(arByte(lngCounter))  ' Convert each byte to an ASCII character
          lngLen = Len(strTemp)         ' save the length of the converted data
          
          ' see if some more padding has to be added to the output string
          If (lngIdx + lngLen) >= lngPadLen Then
              lngPadLen = lngPadLen + ADD_SPACES ' boost blank space counter
              strOut = strOut & Space$(ADD_SPACES) ' append some blank spaces
          End If
          
          ' insert data into output string
          Mid$(strOut, lngIdx, lngLen) = strTemp
          
          ' increment output string pointer
          lngIdx = lngIdx + lngLen
                 
      Next
      
    '
    '---------------------------- Return the string data----------------------------------
    '
      strOut = RTrim$(strOut)  ' remove trailing blanks
      ByteArrayToString = strOut  ' return data string
      
    '
    '------------------------ Empty variables-----------------------------
    '
      strOut = String$(250, 0)
      
    End Function
    Public Function Encrypt(Optional intHashType As Integer = 1, _
                            Optional intCipherType As Integer = 1) As Boolean
      Encrypt = CryptoEncrypt(intHashType, intCipherType)
    End Function
    
    Private Function CryptoEncrypt(intHashType As Integer, _
                                   intCipherType As Integer) As Boolean
        
    '
    '---------------------- Define local variables-----------------------------
    '
    Dim lngHashHnd      As Long     ' Hash handle
    Dim lngkey         As Long
    Dim lngRetCode      As Long     ' return value from an API call
    Dim lngHashType     As Long
    Dim lngLen       As Long
    Dim lngAlgoType   As Long
    Dim lngHExchgKey    As Long
    Dim lngEncDataLength  As Long
    Dim lngEnctBuffLen  As Long
    Dim strEncBuffer  As String
    Dim strOutData   As String
    Dim strPassword     As String
      
    '
    '--------------------------- Initialize variables-------------------------------
    '
    CryptoEncrypt = False        ' preset to FALSE
    Erase g_abytOutData()
    strOutData = ""
    strEncBuffer = ""
    strPassword = ""
    lngHashType = CALG_SHA1
    lngAlgoType = CALG_RC2
    '
    '----------------------- Aquire the provider handle---------------------------
    '
    If g_lngCryptoContext = 0 Then
        If Not GetProvider Then
            Call Class_Terminate       ' Failed.  Time to leave.
            Exit Function
        End If
    End If
    
    On Error GoTo CryptoEncrypt_Error
    '
    '---------------------- convert password to string-----------------------------
    '
    If UBound(g_abytPassword) > 0 Then
        strPassword = ByteArrayToString(g_abytPassword())
    End If
    '
    '----------------------- Create a hash object----------------------------------
    '
    If Not CBool(CryptCreateHash(g_lngCryptoContext, lngHashType, ByVal 0&, _
                 ByVal 0&, lngHashHnd)) Then
                 
        MsgBox "Erro: " & CStr(GetLastError) & " during CryptCreateHash!", _
               vbExclamation Or vbOKOnly, "Encryption Errors"
        GoTo CleanUp
    End If
    '
    '------------------------- Hash in the password text----------------------------
    '
    If Not CBool(CryptHashData(lngHashHnd, strPassword, Len(strPassword), ByVal 0&)) Then
        MsgBox "Erro: " & CStr(GetLastError) & " during CryptHashData!", _
               vbExclamation Or vbOKOnly, "Encryption Errors"
        GoTo CleanUp
    End If
    '
    '-------------- Create a session key from the hash object--------------------
    '
    If Not CBool(CryptDeriveKey(g_lngCryptoContext, lngAlgoType, _
                 lngHashHnd, ByVal CRYPT_NO_SALT, lngkey)) Then
                 
        MsgBox "Error: " & CStr(GetLastError) & " during CryptDeriveKey!", _
               vbExclamation Or vbOKOnly, "Encryption Errors"
        GoTo CleanUp
    End If
    '
    '----------------------- Destroy hash object--------------------------------
    '
    If lngHashHnd <> 0 Then
        lngRetCode = CryptDestroyHash(lngHashHnd)
    End If
    lngHashHnd = 0
    
    '
    '------------------------- Prepare data for encryption.-----------------------
    '
    lngEncDataLength = Len(g_strInData)
    lngEnctBuffLen = lngEncDataLength * 2
    strEncBuffer = String$(lngEnctBuffLen, vbNullChar)
    LSet strEncBuffer = g_strInData
    
    '
    '--------------------- Encrypt the text data---------------------------------
    '
    If Not CBool(CryptEncrypt(lngkey, ByVal 0&, ByVal 1&, ByVal 0&, _
                              strEncBuffer, lngEncDataLength, lngEnctBuffLen)) Then
        
        MsgBox "Bytes necessários:" & CStr(lngEnctBuffLen) & vbCrLf & vbCrLf & _
               "Erro: " & CStr(GetLastError) & " during CryptEncrypt!", _
               vbExclamation Or vbOKOnly, "Encryption Errors"
        GoTo CleanUp
    End If
    
    '
    '--------------- Return the encrypted data string in a byte array-------------
    '
    strOutData = Mid$(strEncBuffer, 1, lngEncDataLength)
    g_abytOutData = StringToByteArray(strOutData)
    CryptoEncrypt = True     ' Successful finish
      
CleanUp:
    '
    ' -------------------------Destroy session key.-----------------------------
    '
    
    If lngkey <> 0 Then
        lngRetCode = CryptDestroyKey(lngkey)
    End If
      
    '
    '-------------------------- Destroy key exchange key handle---------------------
    '
    If lngHExchgKey <> 0 Then
        lngRetCode = CryptDestroyKey(lngHExchgKey)
    End If
      
    '
    '---------------------------- Destroy hash object--------------------------------
    '
    If lngHashHnd <> 0 Then
        lngRetCode = CryptDestroyHash(lngHashHnd)
    End If
      
    '
    '----------------------------- Empty variables-----------------------------------
    '
    lngHashHnd = 0
    strPassword = String$(250, 0)
    Exit Function
    
CryptoEncrypt_Error:
    '
    '----------------------- An error ocurred during the encryption process---------------------
    '
    MsgBox "Error: " & CStr(Err.Number) & "  " & Err.Description & vbCrLf & _
         vbCrLf & "A critical error ocurred during the encryption process.", _
         vbCritical Or vbOKOnly, "Encryption Error"

    Resume CleanUp
    '
    End Function
    '
    Public Function StringToByteArray(varInput As Variant) As Byte()
    '
    '--------------------------- Define local variables----------------------------
    '
    Dim lngIdx     As Long
    Dim lngLen    As Long
    Dim bytBuffer()  As Byte
    Dim bytData()    As Byte
        
    '
    '----Store length of data string in a variable.  Speeds up the process by not----
    '----having to constantly evaluate the data length.  Works great with loops------
    '--------------and long strings of data.  Good habit to get into.---------------
    '
    lngLen = Len(varInput)
    If lngLen < 1 Then
        ReDim bytData(0)
        StringToByteArray = bytData
        Exit Function
    End If
      
    '
    '------------- Resize the array based on length on input string--------------
    '
    ReDim bytBuffer(lngLen)
    ReDim bytData(lngLen)
        
    '
    '----Convert each character in the data string to its ASCII numeric equivalent.------------
    '----I use the VB function CByte() because sometimes the ASC() function returns------------
    '------------data that does not convert to a value of 0 to 255 cleanly.--------------------
    '
    For lngIdx = 0 To lngLen - 1
        bytBuffer(lngIdx) = CByte(Asc(Mid$(varInput, lngIdx + 1, 1)))
    Next
        
    '
    '--------------- Copy data from memory to variable----------------------
    '
    CopyMemory bytData(0), bytBuffer(0), lngLen
      
    '
    '--------------- Return the byte array------------------------------------
    '
    StringToByteArray = bytData()
      
    '
    '---------------- Resize arrays to smallest size---------------------------
    '
    ReDim bytData(0)
    ReDim bytBuffer(0)
    '
    End Function
    '
    Private Function GetProvider() As Boolean
    '
    '------------------------ Define local variables-----------------------------
    '
    Dim strTemp       As String
    Dim strProvider  As String
    Dim strErrorMsg   As String
      
    On Error Resume Next
    '
    '------------------------ Prepare string buffers-----------------------------
    '
    strTemp = vbNullChar
    strProvider = MS_DEFAULT_PROVIDER & vbNullChar
    '
    '------------------------ Gain Access To CryptoAPI.---------------------------
    '
    If CBool(CryptAcquireContext(g_lngCryptoContext, ByVal strTemp, _
             ByVal strProvider, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)) Then
        GetProvider = True
        Exit Function
    End If
    '
    End Function
    '
    Private Sub Class_Initialize()
    '
       ReDim g_abytPassword(0)
    '
    End Sub
    '
    Private Sub Class_Terminate()
    '
      Dim lngRetValue As Long
    '
    '----------------------- If we managed to load a Microsoft Provider ID, then release it.--------------------
    '
      If g_lngCryptoContext <> 0 Then
          lngRetValue = CryptReleaseContext(g_lngCryptoContext, ByVal 0&)
      End If
    '
    End Sub
frmEncFiles.frm(form):
Option Explicit
  Private g_strFilename     As String
  Private g_strEncryptName  As String
  Private arData()          As Byte
  Private arPassword()         As Byte
Private Sub Encrypt_File()

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngFileSize  As Long
  Dim hFile        As Integer
  Dim strText      As String
  Dim intCipher       As Integer
  Dim intHashType      As Integer
  Dim strPassword As String
  Dim objCryptWrap      As CryptWrap.clsCryptoAPI
' ---------------------------------------------------------------------------
' Make sure that the file exists and is not empty.
' ---------------------------------------------------------------------------
  Set objCryptWrap = New CryptWrap.clsCryptoAPI
  On Error Resume Next
  '
  lngFileSize = FileLen(g_strFilename)
  '
  If Err <> 0 Or lngFileSize = 0 Then
      MsgBox "Não foi possível localizar: " & vbCrLf & _
             g_strFilename & vbCrLf & "ou é um arquivo vazio.", _
             vbOKOnly, "Arquivo não encontrado"
      Clear_Variables
      Exit Sub
  End If
  '
  On Error GoTo 0     ' nullify the previous "On Error"
  '
  On Error GoTo Encrypt_File_Errors
' ---------------------------------------------------------------------------
' resize the data array to accommodate the file contents
'
' For encrypting, leave one extra element in the array to handle the last
' NULL appended to the excrypted file
' ---------------------------------------------------------------------------
  ReDim arData(lngFileSize)
' ---------------------------------------------------------------------------
' Create empty receiving files
' ---------------------------------------------------------------------------
  hFile = FreeFile  ' get first free file handle
  Open g_strEncryptName For Output As #hFile
  Close #hFile
' ---------------------------------------------------------------------------
' load the byte array with the file contents from the input file using one
' command then close file.
' ---------------------------------------------------------------------------
  Open g_strFilename For Binary Access Read As #hFile
  Get hFile, , arData
  Close #hFile
  strPassword = "hitesh"
  arPassword = objCryptWrap.StringToByteArray(strPassword)
  objCryptWrap.Password = arPassword()
  
' ---------------------------------------------------------------------------
' set up parameters prior to encryption
' ---------------------------------------------------------------------------
  objCryptWrap.InputData = arData()
  intHashType = 4 'SHA-1 hasing algorithm
  intCipher = 2   'RC2 encryption algorithm
' ---------------------------------------------------------------------------
' Encrypt the data and return in a byte array
' ---------------------------------------------------------------------------
  If objCryptWrap.Encrypt(intHashType, intCipher) Then
      arData = objCryptWrap.OutputData
  Else
      GoTo CleanUp
  End If
' ---------------------------------------------------------------------------
' Write the encrypted data into the encrypted output file
' ---------------------------------------------------------------------------
  Open g_strEncryptName For Binary Access Write As #hFile
  Put hFile, , arData
  Close #hFile
'
  MsgBox "Successful Finish!" & vbCrLf & _
         "Use a text editor to veiw the file formats.", _
         vbInformation Or vbOKOnly, "Encrypt Files"
'
CleanUp:
  On Error GoTo 0         ' nullify the previous "On Error"
  Set objCryptWrap = Nothing   ' free class from memory
  Erase arData()          ' empty the data array
  strText = String$(250, 0)
  Exit Sub
  
Encrypt_File_Errors:
' ---------------------------------------------------------------------------
' Display error message
' ---------------------------------------------------------------------------
  MsgBox "Erro: " & CStr(Err.Number) & "  " & Err.Description & vbCrLf & vbCrLf & _
         "Module:  frmEncFiles" & vbCrLf & _
         "Routine:  Encrypt_File", vbExclamation Or vbOKOnly, "Erro ao Criptografar Arquivo"
  
  Call CloseOpenFiles
  Resume CleanUp
  
End Sub
Public Function CloseOpenFiles() As Boolean
' ---------------------------------------------------------------------------
' Closes any files that were opened with an "Open" statement
' ---------------------------------------------------------------------------
  While FreeFile > 1
      Close #FreeFile - 1
  Wend
'
End Function
Private Sub Generate_FileName()
Dim intPosition As Integer
g_strFilename = Trim$(txtData(0).Text)
' ---------------------------------------------------------------------------
' look for last period in the path\filename
' ---------------------------------------------------------------------------
  intPosition = InStrRev(g_strFilename, ".", Len(g_strFilename))
  g_strEncryptName = Left$(g_strFilename, intPosition) & "enc"
  txtData(1).Text = g_strEncryptName
End Sub
Private Sub Clear_Variables()
  Erase arData()
  g_strFilename = ""
  g_strEncryptName = ""
  With frmEncFiles
       .txtData(1).Text = ""
       .txtData(2).Text = ""
  End With
End Sub
Private Sub cmdChoice_Click(Index As Integer)
Select Case Index
    Case 0  'Test encryption is clicked
        If (txtData(0).Text = "") Then
            Exit Sub
        End If
        Encrypt_File
    Case 1  'Exit is clicked
        End
End Select
End Sub
Private Sub txtData_LostFocus(Index As Integer)
  If Len(Trim$(txtData(0).Text)) > 0 Then
      Generate_FileName
  Else
      txtData(1).Text = ""
  End If
End Sub

OBS: não foi eu que fiz esse codigo

obrigado pela ajuda

Editado por kuroi
Adicionar tag CODE
Link para o comentário
Compartilhar em outros sites

2 respostass a esta questão

Posts Recomendados

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,5k
×
×
  • Criar Novo...