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

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

eu peguei esse link no site da microsoft: http://support.microsoft.com/kb/821762/pt-br , mas eu preciso da parte de descriptografia que esta em vb.net e eu n manjo nd e tb n consigo criar o arquivo executável da parte de criptografar, se alguém poder me ajudar eu agradeço.....preciso urgente disso.... obrigado a todos :wacko:

sim, mas acontece que esse programa vai rodar em 2 pcs, em 1 ele vai criptografar e no outro descriptografar, entaum vou ter q gerar 1 arquivo com ele criptografado, entaum acredito q a chave vai ter q ser inserida no arquivo e depois compreendido pelo programa na hr de descriptografar....e somente com a chave certa q ele descriptografa.....valeu....

Bom, eu tenho q criar 1 projeto p criptografar e descriptografar 1 texto d até 255 caracteres, eu tenho 1 ideia mas ta tendo erro... segue abaixo a codificação q usei: CRIPTOGRAFAR: Function Cripta(Texto As String) As String Dim a, b, c, d, e, f As Variant Dim g, h, i, j, k, l As Variant Dim m, n, o, p, q, r As Variant Dim s, t, u, v, x, w As Variant Dim y, z, Espaco, ç As Variant Dim ã, â, á, à, ä As Variant Dim ê, é, è, ë, î As Variant Dim í, ì, ï, õ, ô As Variant Dim ó, ò, ö, û, ú As Variant Dim ù, ü, não As Variant Dim um, dois, tres, quatro, cinco As Variant Dim seis, sete, oito, nove, zero As Variant Dim aspsim, exclam, arrob, sust, cifrao As Variant Dim porcento, comerc, asterisco, abpa, fepa As Variant Dim under, hif, cruz, igual, ss, abchave As Variant Dim abco, apqno, fechave, feco, opqno As Variant Dim menor, maior, virgula, pontofim, ponto As Variant Dim pontovi, interrog, barrainv, japo, barra As Variant Dim aspadu, ump, doisp, tresp, funder, ccortado As Variant Dim zoinfech, tio, chapeu, pdir, pesq, pp As Variant Dim Chave1 As Variant Dim chave As Variant a = Array("001") b = Array("002") c = Array("003") d = Array("004") e = Array("005") f = Array("006") g = Array("007") h = Array("008") i = Array("009") j = Array("010") k = Array("011") l = Array("012") m = Array("013") n = Array("014") o = Array("015") p = Array("016") q = Array("017") r = Array("018") s = Array("019") t = Array("020") u = Array("021") v = Array("022") w = Array("023") x = Array("024") y = Array("025") z = Array("026") Espaco = Array("027") ç = Array("028") ã = Array("029") â = Array("030") á = Array("031") à = Array("032") ä = Array("033") ê = Array("034") é = Array("035") è = Array("036") ë = Array("037") î = Array("038") í = Array("039") ì = Array("040") ï = Array("041") õ = Array("042") ô = Array("043") ó = Array("044") ò = Array("045") ö = Array("046") û = Array("047") ú = Array("048") ù = Array("049") ü = Array("050") não = Array("051") um = Array("052") dois = Array("053") tres = Array("054") quatro = Array("055") cinco = Array("056") seis = Array("057") sete = Array("058") oito = Array("059") nove = Array("060") zero = Array("061") aspsim = Array("062") exclam = Array("063") arrob = Array("064") sust = Array("065") cifrao = Array("066") porcento = Array("067") comerc = Array("068") asterisco = Array("069") abpa = Array("070") fepa = Array("071") under = Array("072") hif = Array("073") cruz = Array("074") igual = Array("075") ss = Array("076") abchave = Array("077") abco = Array("078") apqno = Array("079") fechave = Array("080") feco = Array("081") opqno = Array("082") menor = Array("083") maior = Array("084") virgula = Array("085") pontofim = Array("086") ponto = Array("087") pontovi = Array("088") interrog = Array("089") barrainv = Array("090") japo = Array("091") barra = Array("092") aspadu = Array("093") ump = Array("094") doisp = Array("095") tresp = Array("096") funder = Array("097") ccortado = Array("098") zoinfech = Array("099") tio = Array("100") pdir = Array("101") pesq = Array("102") pp = Array("103") chapeu = Array("104") Chave1 = Array("6") For busca = 0 To Len(Texto) chave = Int(1 * Rnd) Select Case LCase(Mid(Texto, busca + 1, 1)) Case "a" Cripta = Cripta + a(chave) Case "b" Cripta = Cripta + b(chave) Case "c" Cripta = Cripta + c(chave) Case "d" Cripta = Cripta + d(chave) Case "e" Cripta = Cripta + e(chave) Case "f" Cripta = Cripta + f(chave) Case "g" Cripta = Cripta + g(chave) Case "h" Cripta = Cripta + h(chave) Case "i" Cripta = Cripta + i(chave) Case "j" Cripta = Cripta + j(chave) Case "k" Cripta = Cripta + k(chave) Case "l" Cripta = Cripta + l(chave) Case "m" Cripta = Cripta + m(chave) Case "n" Cripta = Cripta + n(chave) Case "o" Cripta = Cripta + o(chave) Case "p" Cripta = Cripta + p(chave) Case "q" Cripta = Cripta + q(chave) Case "r" Cripta = Cripta + r(chave) Case "s" Cripta = Cripta + s(chave) Case "t" Cripta = Cripta + t(chave) Case "u" Cripta = Cripta + u(chave) Case "v" Cripta = Cripta + v(chave) Case "w" Cripta = Cripta + w(chave) Case "x" Cripta = Cripta + x(chave) Case "y" Cripta = Cripta + y(chave) Case "z" Cripta = Cripta + z(chave) Case " " Cripta = Cripta + Espaco(chave) Case "1" Cripta = Cripta + um(chave) Case "2" Cripta = Cripta + dois(chave) Case "3" Cripta = Cripta + tres(chave) Case "4" Cripta = Cripta + quatro(chave) Case "5" Cripta = Cripta + cinco(chave) Case "6" Cripta = Cripta + seis(chave) Case "7" Cripta = Cripta + sete(chave) Case "8" Cripta = Cripta + oito(chave) Case "9" Cripta = Cripta + nove(chave) Case "0" Cripta = Cripta + zero(chave) Case "'" Cripta = Cripta + aspsim(chave) Case "!" Cripta = Cripta + exclam(chave) Case "@" Cripta = Cripta + arrob(chave) Case "#" Cripta = Cripta + sust(chave) Case "$" Cripta = Cripta + cifrao(chave) Case "%" Cripta = Cripta + porcento(chave) Case "&" Cripta = Cripta + comerc(chave) Case "*" Cripta = Cripta + asterisco(chave) Case "(" Cripta = Cripta + abpa(chave) Case ")" Cripta = Cripta + fepa(chave) Case "_" Cripta = Cripta + under(chave) Case "-" Cripta = Cripta + hif(chave) Case "+" Cripta = Cripta + cruz(chave) Case "=" Cripta = Cripta + igual(chave) Case "§" Cripta = Cripta + ss(chave) Case "{" Cripta = Cripta + abchave(chave) Case "[" Cripta = Cripta + abco(chave) Case "ª" Cripta = Cripta + apqno(chave) Case "}" Cripta = Cripta + fechave(chave) Case "]" Cripta = Cripta + feco(chave) Case "º" Cripta = Cripta + opqno(chave) Case "<" Cripta = Cripta + menor(chave) Case ">" Cripta = Cripta + maior(chave) Case "," Cripta = Cripta + virgula(chave) Case "." Cripta = Cripta + pontofim(chave) Case ":" Cripta = Cripta + ponto(chave) Case ";" Cripta = Cripta + pontovi(chave) Case "?" Cripta = Cripta + interrog(chave) Case "/" Cripta = Cripta + barrainv(chave) Case "|" Cripta = Cripta + japo(chave) Case "\" Cripta = Cripta + barra(chave) Case """" Cripta = Cripta + aspadu(chave) Case "¹" Cripta = Cripta + ump(chave) Case "²" Cripta = Cripta + doisp(chave) Case "³" Cripta = Cripta + tresp(chave) Case "£" Cripta = Cripta + funder(chave) Case "¢" Cripta = Cripta + ccortado(chave) Case "¬" Cripta = Cripta + zoinfech(chave) Case "ã" Cripta = Cripta + ã(chave) Case "â" Cripta = Cripta + â(chave) Case "á" Cripta = Cripta + á(chave) Case "à" Cripta = Cripta + à(chave) Case "ä" Cripta = Cripta + ä(chave) Case "ê" Cripta = Cripta + ê(chave) Case "é" Cripta = Cripta + é(chave) Case "è" Cripta = Cripta + è(chave) Case "ë" Cripta = Cripta + ë(chave) Case "î" Cripta = Cripta + î(chave) Case "í" Cripta = Cripta + í(chave) Case "ì" Cripta = Cripta + ì(chave) Case "ï" Cripta = Cripta + ï(chave) Case "õ" Cripta = Cripta + õ(chave) Case "ô" Cripta = Cripta + ô(chave) Case "ó" Cripta = Cripta + ó(chave) Case "ò" Cripta = Cripta + ò(chave) Case "ö" Cripta = Cripta + ö(chave) Case "û" Cripta = Cripta + û(chave) Case "ú" Cripta = Cripta + ú(chave) Case "ù" Cripta = Cripta + ù(chave) Case "ü" Cripta = Cripta + ü(chave) Case "não" Cripta = Cripta + não(chave) Case "ç" Cripta = Cripta + ç(chave) Case "~" Cripta = Cripta + tio(chave) Case "^" Cripta = Cripta + chapeu(chave) Case "´" Cripta = Cripta + pdir(chave) Case "`" Cripta = Cripta + pesq(chave) Case "¨" Cripta = Cripta + pp(chave) End Select Next busca End Function Function Descripta(Texto As String) As String Dim chave As Variant Dim a, b, c, d, e, f As Variant Dim g, h, i, j, k, l As Variant Dim m, n, o, p, q, r As Variant Dim s, t, u, v, x, w As Variant Dim y, z, Espaco, ç As Variant Dim ã, â, á, à, ä As Variant Dim ê, é, è, ë, î As Variant Dim í, ì, ï, õ, ô As Variant Dim ó, ò, ö, û, ú As Variant Dim ù, ü, não As Variant Dim um, dois, tres, quatro, cinco As Variant Dim seis, sete, oito, nove, zero As Variant Dim aspsim, exclam, arrob, sust, cifrao As Variant Dim porcento, comerc, asterisco, abpa, fepa As Variant Dim under, hif, cruz, igual, ss, abchave As Variant Dim abco, apqno, fechave, feco, opqno As Variant Dim menor, maior, virgula, pontofim, ponto As Variant Dim pontovi, interrog, barrainv, japo, barra As Variant Dim aspadu, ump, doisp, tresp, funder, ccortado As Variant Dim zoinfech, tio, chapeu, pdir, pesq, pp As Variant a = Array("001") b = Array("002") c = Array("003") d = Array("004") e = Array("005") f = Array("006") g = Array("007") h = Array("008") i = Array("009") j = Array("010") k = Array("011") l = Array("012") m = Array("013") n = Array("014") o = Array("015") p = Array("016") q = Array("017") r = Array("018") s = Array("019") t = Array("020") u = Array("021") v = Array("022") w = Array("023") x = Array("024") y = Array("025") z = Array("026") Espaco = Array("027") ç = Array("028") ã = Array("029") â = Array("030") á = Array("031") à = Array("032") ä = Array("033") ê = Array("034") é = Array("035") è = Array("036") ë = Array("037") î = Array("038") í = Array("039") ì = Array("040") ï = Array("041") õ = Array("042") ô = Array("043") ó = Array("044") ò = Array("045") ö = Array("046") û = Array("047") ú = Array("048") ù = Array("049") ü = Array("050") não = Array("051") um = Array("052") dois = Array("053") tres = Array("054") quatro = Array("055") cinco = Array("056") seis = Array("057") sete = Array("058") oito = Array("059") nove = Array("060") zero = Array("061") aspsim = Array("062") exclam = Array("063") arrob = Array("064") sust = Array("065") cifrao = Array("066") porcento = Array("067") comerc = Array("068") asterisco = Array("069") abpa = Array("070") fepa = Array("071") under = Array("072") hif = Array("073") cruz = Array("074") igual = Array("075") ss = Array("076") abchave = Array("077") abco = Array("078") apqno = Array("079") fechave = Array("080") feco = Array("081") opqno = Array("082") menor = Array("083") maior = Array("084") virgula = Array("085") pontofim = Array("086") ponto = Array("087") pontovi = Array("088") interrog = Array("089") barrainv = Array("090") japo = Array("091") barra = Array("092") aspadu = Array("093") ump = Array("094") doisp = Array("095") tresp = Array("096") funder = Array("097") ccortado = Array("098") zoinfech = Array("099") tio = Array("100") pdir = Array("101") pesq = Array("102") pp = Array("103") chapeu = Array("104") For busca = 0 To Len(Texto) Step 3 For letra = 0 To 4 chave = UCase(Mid(Texto, busca + 1, 3)) If chave = a(letra) Then <---AQUI ESTA DANDO ERRO Descripta = Descripta + "A" ElseIf chave = b(letra) Then Descripta = Descripta + "B" ElseIf chave = c(letra) Then Descripta = Descripta + "C" ElseIf chave = d(letra) Then Descripta = Descripta + "D" ElseIf chave = e(letra) Then Descripta = Descripta + "E" ElseIf chave = f(letra) Then Descripta = Descripta + "F" ElseIf chave = g(letra) Then Descripta = Descripta + "G" ElseIf chave = h(letra) Then Descripta = Descripta + "H" ElseIf chave = i(letra) Then Descripta = Descripta + "I" ElseIf chave = j(letra) Then Descripta = Descripta + "J" ElseIf chave = k(letra) Then Descripta = Descripta + "K" ElseIf chave = l(letra) Then Descripta = Descripta + "L" ElseIf chave = m(letra) Then Descripta = Descripta + "M" ElseIf chave = n(letra) Then Descripta = Descripta + "N" ElseIf chave = o(letra) Then Descripta = Descripta + "O" ElseIf chave = p(letra) Then Descripta = Descripta + "P" ElseIf chave = q(letra) Then Descripta = Descripta + "Q" ElseIf chave = r(letra) Then Descripta = Descripta + "R" ElseIf chave = s(letra) Then Descripta = Descripta + "S" ElseIf chave = t(letra) Then Descripta = Descripta + "T" ElseIf chave = u(letra) Then Descripta = Descripta + "U" ElseIf chave = v(letra) Then Descripta = Descripta + "V" ElseIf chave = w(letra) Then Descripta = Descripta + "W" ElseIf chave = x(letra) Then Descripta = Descripta + "X" ElseIf chave = y(letra) Then Descripta = Descripta + "Y" ElseIf chave = z(letra) Then Descripta = Descripta + "Z" ElseIf chave = Espaco(letra) Then Descripta = Descripta + " " ElseIf chave = um(letra) Then Descripta = Descripta + "1" ElseIf chave = dois(letra) Then Descripta = Descripta + "2" ElseIf chave = tres(letra) Then Descripta = Descripta + "3" ElseIf chave = quatro(letra) Then Descripta = Descripta + "4" ElseIf chave = cinco(letra) Then Descripta = Descripta + "5" ElseIf chave = seis(letra) Then Descripta = Descripta + "6" ElseIf chave = sete(letra) Then Descripta = Descripta + "7" ElseIf chave = oito(letra) Then Descripta = Descripta + "8" ElseIf chave = nove(letra) Then Descripta = Descripta + "9" ElseIf chave = zero(letra) Then Descripta = Descripta + "0" ElseIf chave = aspsim(letra) Then Descripta = Descripta + "'" ElseIf chave = exclam(letra) Then Descripta = Descripta + "!" ElseIf chave = arrob(letra) Then Descripta = Descripta + "@" ElseIf chave = sust(letra) Then Descripta = Descripta + "#" ElseIf chave = cifrao(letra) Then Descripta = Descripta + "$" ElseIf chave = porcento(letra) Then Descripta = Descripta + "%" ElseIf chave = comerc(letra) Then Descripta = Descripta + "&" ElseIf chave = asterisco(letra) Then Descripta = Descripta + "*" ElseIf chave = abpa(letra) Then Descripta = Descripta + "(" ElseIf chave = fepa(letra) Then Descripta = Descripta + ")" ElseIf chave = under(letra) Then Descripta = Descripta + "_" ElseIf chave = hif(letra) Then Descripta = Descripta + "-" ElseIf chave = cruz(letra) Then Descripta = Descripta + "+" ElseIf chave = igual(letra) Then Descripta = Descripta + "= ElseIf chave = ss(letra) Then Descripta = Descripta + "§" ElseIf chave = abchave(letra) Then Descripta = Descripta + "{" ElseIf chave = abco(letra) Then Descripta = Descripta + "[" ElseIf chave = apqno(letra) Then Descripta = Descripta + "ª" ElseIf chave = fechave(letra) Then Descripta = Descripta + "}" ElseIf chave = feco(letra) Then Descripta = Descripta + ]" ElseIf chave = opqno(letra) Then Descripta = Descripta + "º" ElseIf chave = menor(letra) Then Descripta = Descripta + "<" ElseIf chave = maior(letra) Then Descripta = Descripta + ">" ElseIf chave = virgula(letra) Then Descripta = Descripta + "," ElseIf chave = pontofim(letra) Then Descripta = Descripta + "." ElseIf chave = ponto(letra) Then Descripta = Descripta + ":" ElseIf chave = pontovi(letra) Then Descripta = Descripta + ";" ElseIf chave = interrog(letra) Then Descripta = Descripta + "?" ElseIf chave = barrainv(letra) Then Descripta = Descripta + "/" ElseIf chave = japo(letra) Then Descripta = Descripta + "|" ElseIf chave = barra(letra) Then Descripta = Descripta + "\" ElseIf chave = aspadu(letra) Then Descripta = Descripta + """" ElseIf chave = ump(letra) Then Descripta = Descripta + "¹" ElseIf chave = doisp(letra) Then Descripta = Descripta + "²" ElseIf chave = tresp(letra) Then Descripta = Descripta + "³" ElseIf chave = funder(letra) Then Descripta = Descripta + "£" ElseIf chave = ccortado(letra) Then Descripta = Descripta + "¢" ElseIf chave = zoinfech(letra) Then Descripta = Descripta + "¬" ElseIf chave = ã(letra) Then Descripta = Descripta + "Ã" ElseIf chave = â(letra) Then Descripta = Descripta + "Â" ElseIf chave = á(letra) Then Descripta = Descripta + "Á" ElseIf chave = à(letra) Then Descripta = Descripta + "À" ElseIf chave = ä(letra) Then Descripta = Descripta + "Ä" ElseIf chave = ê(letra) Then Descripta = Descripta + "Ê" ElseIf chave = é(letra) Then Descripta = Descripta + "É" ElseIf chave = è(letra) Then Descripta = Descripta + "È" ElseIf chave = ë(letra) Then Descripta = Descripta + "Ë" ElseIf chave = î(letra) Then Descripta = Descripta + "Î" ElseIf chave = í(letra) Then Descripta = Descripta + "Í" ElseIf chave = ì(letra) Then Descripta = Descripta + "Ì" ElseIf chave = ï(letra) Then Descripta = Descripta + "Ï" ElseIf chave = õ(letra) Then Descripta = Descripta + "Õ" ElseIf chave = ô(letra) Then Descripta = Descripta + "Ô" ElseIf chave = ó(letra) Then Descripta = Descripta + "Ó" ElseIf chave = ò(letra) Then Descripta = Descripta + "Ò" ElseIf chave = ö(letra) Then Descripta = Descripta + "Ö" ElseIf chave = û(letra) Then Descripta = Descripta + "Û" ElseIf chave = ú(letra) Then Descripta = Descripta + "Ú" ElseIf chave = ù(letra) Then Descripta = Descripta + "Ù" ElseIf chave = ü(letra) Then Descripta = Descripta + "Ü" ElseIf chave = não(letra) Then Descripta = Descripta + "não" ElseIf chave = ç(letra) Then Descripta = Descripta + "Ç" ElseIf chave = tio(letra) Then Descripta = Descripta + "~" ElseIf chave = chapeu(letra) Then Descripta = Descripta + "^" ElseIf chave = pesq(letra) Then Descripta = Descripta + "`" ElseIf chave = pdir(letra) Then Descripta = Descripta + "´" ElseIf chave = pp(letra) Then Descripta = Descripta + "¨" End If Next letra Next busca End Function e eu qria fazer do seguinte modo: a pessoa digita 3 numeros numa text ou 1 numero em 3 text e esses 3 numeros ficam gravados no arquivo gerado e a soma dela gera a criptografia, tipo assim: digitei a letra 'a' e o codigo de 'a' é '001' e vamo fazer de conta que a pessoa digitou '123' 1+2+3=6 entaum ficaria assim: 001*6=006 e assim por diante o arquivo vai ficar assim: 123006 123 é a chave e 006 é a letra 'a' criptografada se alguém tiver 1 ideia mais pratica d como criar 1 projeto de criptografia com chave e simples, sou todo ouvidos....valeu

é q n consegui fazer do jeito q você colocou. n consigo criar 1 variavel p numeros, a n ser q eu esteja fazendo errado "Dim 1 as variant" da 1 erro quando eu dou enter aparece a mensagem: "Compile error: Expected: identifier" vou criar já as com acento. e como faço p criar 1 p a barra d espaço você poderia me falar como eu faço p fazer o programinha fazer o contrario(descriptografar) a mesmo mensagem? quanta duvida a minha.... valeu, T.H.U.G. L.I.F.E. (The Hate U Give Little Infantis Fuck Everybody)

Bom, eu já consegui fazer ele criptografar, mas preciso ainda de 1 ajudinha....ainda não consegui fazer ele converter os números e tb ficou faltando as palavras com acentos.....n sei como declarar as variáveis destes q faltam, abaixo segue o código p criptografar, mas não tenho a mínima idéia d como fazer ele descriptografar o código. valeu galera e quem poder me ajudar eu agradeço, segue o codigo: Private Sub Command1_Click() Dim Chave As Variant Dim organiza As String Dim SemEspaco As String Dim a, b, c, d, e, f As Variant Dim g, h, i, j, k, l As Variant Dim m, n, o, p, q, r As Variant Dim s, t, u, v, x, w As Variant Dim y, z As Variant a = Array("01", "02", "03", "04") b = Array("11", "12", "13", "14") c = Array("21", "22", "23", "24") d = Array("31", "32", "33", "34") e = Array("41", "42", "43", "44") f = Array("51", "52", "53", "54") g = Array("61", "62", "63", "64") h = Array("71", "72", "73", "74") i = Array("81", "82", "83", "84") j = Array("91", "92", "93", "94") k = Array("05", "06", "07", "08") l = Array("15", "16", "17", "18") m = Array("25", "26", "27", "28") n = Array("35", "36", "37", "38") o = Array("45", "46", "47", "48") p = Array("55", "56", "57", "58") q = Array("65", "66", "67", "68") r = Array("75", "76", "77", "78") s = Array("85", "86", "87", "88") t = Array("95", "96", "97", "98") u = Array("10", "20", "30", "40") v = Array("50", "60", "70", "80") w = Array("90", "00", "A0", "B0") x = Array("C0", "D0", "E0", "F0") y = Array("G0", "H0", "I0", "J0") z = Array("K0", "L0", "M0", "N0") SemEspaco = LCase(Replace(Text1.Text, " ", " ")) For busca = 0 To Len(SemEspaco) Chave = Int(4 * Rnd) Select Case Mid(SemEspaco, busca + 1, 1) Case "a" organiza = organiza + " " + a(Chave) Case "b" organiza = organiza + " " + b(Chave) Case "c" organiza = organiza + " " + c(Chave) Case "d" organiza = organiza + " " + d(Chave) Case "e" organiza = organiza + " " + e(Chave) Case "f" organiza = organiza + " " + f(Chave) Case "g" organiza = organiza + " " + g(Chave) Case "h" organiza = organiza + " " + h(Chave) Case "i" organiza = organiza + " " + i(Chave) Case "j" organiza = organiza + " " + j(Chave) Case "k" organiza = organiza + " " + k(Chave) Case "l" organiza = organiza + " " + l(Chave) Case "m" organiza = organiza + " " + m(Chave) Case "n" organiza = organiza + " " + n(Chave) Case "o" organiza = organiza + " " + o(Chave) Case "p" organiza = organiza + " " + p(Chave) Case "q" organiza = organiza + " " + q(Chave) Case "r" organiza = organiza + " " + r(Chave) Case "s" organiza = organiza + " " + s(Chave) Case "t" organiza = organiza + " " + t(Chave) Case "u" organiza = organiza + " " + u(Chave) Case "v" organiza = organiza + " " + v(Chave) Case "w" organiza = organiza + " " + w(Chave) Case "x" organiza = organiza + " " + x(Chave) Case "y" organiza = organiza + " " + y(Chave) Case "z" organiza = organiza + " " + z(Chave) End Select Next busca Label1.Caption = organiza Open "c:\mensagem_criptografada.txt" For Output As #1 Print #1, organiza Close #1 MsgBox ("Arquivo 'mensagem_criptografada.txt' gravado com sucesso em 'C:\'")

eu dei uma olhada pela net e vi umas dicas de como usar a função rnd(). para usa-la eu tenho q declarar assim como ta abaixo? Dim a(4) Dim b(4) Dim c(4) Dim d(4) Dim e(4) Dim f(4) Dim g(4) Dim h(4) Dim i(4) Dim j(4) Dim k(4) Dim l(4) Dim m(4) Dim n(4) Dim o(4) Dim p(4) Dim q(4) Dim r(4) Dim s(4) Dim t(4) Dim u(4) Dim v(4) Dim w(4) Dim x(4) Dim y(4) Dim z(4) a(0)="01 " a(1)="02 " a(2)="03 " a(3)="04 " b(0)="11 " b(1)="12 " b(2)="13 " b(3)="14 " e assim para todas as letras... aí eu vou criar outra text chamada por exemplo="txtresultado" q vai trazer o resultado da mensagem q foi codificada txtresultado.text=a(cint(rnd()*3)) - se a 1ª letra for A mas n sei fazer ele usar a variavel certa dependendo da letra e tb n sei como ele faz p tratar cada letra.... to pelo menos indo no caminho já???? valeu

Kuroi....procurei coisas aqui e n axei.... tm como você me explicar 1 pouco como funciona essa funçao Rnd()? porque eu nunk ouvi falar dela....muito obrigado se puder me ajudar

agora q eu vi q ficou faltando 2 letras....mas ve se consegue entender.... valeu entaum kuroi...vo correr atraz disso logo q chegar em casa e qualquer coisa eu posto aqui....mas valeu por enquanto....

o resultado ficou esse por causa do q eu digitei na text q eu excrevi logo acima e eu tocom dificuldade p ele escolher randomicamente tb.... valeu

Galera....tenho q fazer 1 form q contenha 1 botao e 1 caixa de texto com até 255 caracteres e eu gostaria de saber como eu faço para pegar cada 1 destes caracteres e trata-los. Quero praticamente criptografa-los q nem no exemplo abaixo: frase na text: "eu to fudido" a={01 , 02 , 03 , 04} b={11 , 12 , 13 , 14} c={21 , 22 , 23 , 24} d={31 , 32 , 33 , 34} e={41 , 42 , 43 , 44} f={51 , 52 , 53 , 54} g={61 , 62 , 63 , 64} h={71 , 72 , 73 , 74} i={81 , 82 , 83 , 84} j={91 , 92 , 93 , 94} k={05 , 06 , 07 , 08} l={15 , 16 , 17 , 18} m={25 , 26 , 27 , 28} n={35 , 36 , 37 , 38} o={45 , 46 , 47 , 48} p={55 , 56 , 57 , 58} q={65 , 66 , 67 , 68} r={75 , 76 , 77 , 78} s={85 , 86 , 87 , 88} t={95 , 96 , 97 , 98} u={10 , 20 , 30 , 40} v={50 , 60 , 70 , 80} w={90 , 00 , A0 , B0} x={C0 , D0 , E0 , F0} y={G0 , H0 , I0 , J0} z={K0 , L0 , M0 , N0} o resultado fica: "95 46 53 10 34 81 31 45" eu gostaria que ele pegasse os valores aleatoriamente.... podem dar ideias quem tiver 1 jeito melhor.... eu sei mais ou menos como faz isso, mas tm muito tmpo q n mexo com VB e aí eu to ferrado.... quem poder me ajudar.....meu muito obrigado :blush: