Newsgroup: it.comp.lang.visual-basic
Titolo: [?] criptazione / scrambling

Qualcuno conosce dei semplici algoritmi di criptazione/scrambling?
Non mi serve una buona sicurezza, ma che siano il più veloce possibile
(escludendo il classico xor byte a byte che è un po' troppo semplice :)
soprattutto da decriptare)
Ciao

 Qualcuno conosce dei semplici algoritmi di criptazione/scrambling?
Il sistema più semplice è annegare l'informazione utile nel rumore di fondo.
Esempio:
Genera un numero casuale. Quello sarà l'offset del primo carattere utile.
Ora genera caratteri a caso fino a quell'offset, e mettici il tuo prima
carattere effettivo, xorato con il numero che preferisci.
Poi genera un numero di caratteri casuali pari al valore ascii dell'ultimo
carattere casuale generato meno Asc("A") e piazzaci il secondo.
Continua così fino alla fine, poi aggiungi in fondo il numero casuale che
hai generato all'inizio (debitamente trasformato in lettera).
Se vuoi fare il brillante, prima di salvare il tutto passa per un StrReverse
(puoi decidere di ribaltare anche solo la prima o la seconda metà della
stringa).
La velocità di decrittazione dell'informazione è di poco minore del semplice
Xor. Quella di crittazione è un po' inferiore, a causa del ciclo di
generazione di valori random, ma a mio parere più che accettabile.
Ciao
*Roby*

 ha scritto nel messaggio
news:3c57d3d4$1...@news.cis.it...

Ecco una classe usante le API:
Option Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias
"CryptAcquireContextA" (phProv As Long, ByVal pszContainer As Long, ByVal
pszProvider As String, ByVal dwProvType 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, phHash
As Long) 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 CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As
Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long,
phKey As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash 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, 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, ByVal
pbData As String, pdwDataLen As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv
As Long, ByVal dwFlags As Long) As Long
Private Const CRYPT_NEWKEYSET = &H8
Private Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL = 1
Private Const ALG_CLASS_DATA_ENCRYPT = 24576
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536
Private Const ALG_TYPE_STREAM = 2048
Private Const ALG_SID_RC2 = 2
Private Const ALG_SID_RC4 = 1
Private Const ALG_SID_MD5 = 3
Private Const CALG_MD5 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC2 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK) Or
ALG_SID_RC2)
Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or
ALG_SID_RC4)
Private Const ENCRYPT_ALGORITHM = CALG_RC4
Private Const ENCRYPT_BLOCK_SIZE = 1
Private Const CRYPT_EXPORTABLE = 1
Public Function Encrypt(ByVal InputBuffer As String, ByVal EncryptionKey As
String, Optional ByVal UseUUEncoding As Boolean = False) As String
Dim lHHash As Long
Dim lHkey As Long
Dim lResult As Long
Dim lHExchgKey As Long
Dim lHCryptprov As Long
Dim sContainer As String
Dim lCryptLength As Long
Dim lCryptBufLen As Long
Dim sCryptBuffer As String
Dim sProvider As String
Dim lngRet As Long
If InputBuffer = "" Then Exit Function
On Error Resume Next
sProvider = MS_DEF_PROV & vbNullChar
lngRet = CryptAcquireContext(lHCryptprov, 0&, sProvider, PROV_RSA_FULL, 0)
If lngRet = 0 Then
lngRet = CryptAcquireContext(lHCryptprov, 0&, sProvider, PROV_RSA_FULL,
CRYPT_NEWKEYSET)
End If
If lngRet Then
If CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash) Then
If CryptHashData(lHHash, EncryptionKey, Len(EncryptionKey), 0) Then
If CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey) Then
CryptDestroyHash (lHHash)
lHHash = 0
lCryptLength = Len(InputBuffer)
lCryptBufLen = lCryptLength * 2
sCryptBuffer = String(lCryptBufLen, vbNullChar)
LSet sCryptBuffer = InputBuffer
If CryptEncrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptLength, lCryptBufLen)
Then
sCryptBuffer = Mid$(sCryptBuffer, 1, lCryptLength)
If UseUUEncoding Then
sCryptBuffer = UUEncode(sCryptBuffer)
End If
Encrypt = sCryptBuffer
End If
End If
End If
End If
End If
If Err.LastDllError Then Err = Err.LastDllError
If lHkey Then lResult = CryptDestroyKey(lHkey)
If lHExchgKey Then CryptDestroyKey (lHExchgKey)
If lHHash Then CryptDestroyHash (lHHash)
If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)
If Err Then Err.Raise Err, "CryptoAPI.Encrypt"
End Function
Public Function Decrypt(ByVal InputBuffer As String, ByVal EncryptionKey As
String, Optional ByVal UUEncoded As Boolean = False) As String
Dim lHExchgKey As Long
Dim lHCryptprov As Long
Dim lHHash As Long
Dim lHkey As Long
Dim lResult As Long
Dim sProvider As String
Dim sCryptBuffer As String
Dim lCryptBufLen As Long
Dim lCryptPoint As Long
Dim lPasswordPoint As Long
Dim lPasswordCount As Long
If InputBuffer = "" Then Exit Function
On Error Resume Next
If UUEncoded Then
InputBuffer = UUDecode(InputBuffer)
End If
sProvider = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
If CryptAcquireContext(lHCryptprov, 0&, sProvider, PROV_RSA_FULL, 0) Then
If CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash) Then
If CryptHashData(lHHash, EncryptionKey, Len(EncryptionKey), 0) Then
If CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey) Then
CryptDestroyHash (lHHash)
lHHash = 0
lCryptBufLen = Len(InputBuffer) * 2
sCryptBuffer = String(lCryptBufLen, vbNullChar)
LSet sCryptBuffer = InputBuffer
If CryptDecrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptBufLen) Then
Decrypt = Mid$(sCryptBuffer, 1, lCryptBufLen / 2)
End If
End If
End If
End If
End If
If Err.LastDllError Then Err = Err.LastDllError
If (lHkey) Then lResult = CryptDestroyKey(lHkey)
If lHExchgKey Then CryptDestroyKey (lHExchgKey)
If lHHash Then CryptDestroyHash (lHHash)
If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)
If Err Then Err.Raise Err, "CryptoAPI.Decrypt"
End Function
Public Function UUEncode(ByVal InputBuffer As String) As String
Dim bytChar() As Byte
Dim bytBuffer() As Byte
Dim intStrPos As Integer
Dim strOutBuffer As String
On Error Resume Next
For intStrPos = 1 To Len(InputBuffer) Step 3
bytBuffer = StrConv(Mid(InputBuffer, intStrPos, 3), vbFromUnicode)
ReDim Preserve bytChar(IIf(UBound(bytBuffer) = 3, 3, UBound(bytBuffer) + 1))
If UBound(bytBuffer) < 3 Then ReDim Preserve bytBuffer(UBound(bytBuffer) +
1)
bytChar(0) = Int(bytBuffer(0) / 4)
bytChar(0) = IIf(bytChar(0), (bytChar(0) And 63) + 32, 96)
bytChar(1) = ((bytBuffer(0) * 16) And 48) Or (Int(bytBuffer(1) / 16) And 15)
bytChar(1) = IIf(bytChar(1), (bytChar(1) And 63) + 32, 96)
bytChar(2) = ((bytBuffer(1) * 4) And 60) Or (Int(bytBuffer(2) / 64) And 3)
bytChar(2) = IIf(bytChar(2), (bytChar(2) And 63) + 32, 96)
bytChar(3) = (bytBuffer(2) And 63)
bytChar(3) = IIf(bytChar(3), (bytChar(3) And 63) + 32, 96)
strOutBuffer = strOutBuffer & StrConv(bytChar, vbUnicode)
Next intStrPos
UUEncode = strOutBuffer
Err.Clear
End Function
Public Function UUDecode(ByVal InputBuffer As String) As String
Dim bytChar() As Byte
Dim intLen As Integer
Dim strOutBuffer As String
Dim intFill As Integer
On Error Resume Next
intLen = 1
intFill = Len(InputBuffer) Mod 4
InputBuffer = InputBuffer & String(intFill, "`")
Do While intLen <= Len(InputBuffer)
bytChar = StrConv(Mid(InputBuffer, intLen, 4), vbFromUnicode)
ReDim Preserve bytChar(3)
strOutBuffer = strOutBuffer & Chr(((((bytChar(0) - 32) And 63) * 4) Or
Int(((bytChar(1) - 32) And 63) / 16)) And &HFF)
strOutBuffer = strOutBuffer & Chr(((((bytChar(1) - 32) And 63) * 16) Or
Int(((bytChar(2) - 32) And 63) / 4)) And &HFF)
strOutBuffer = strOutBuffer & Chr(((((bytChar(2) - 32) And 63) * 64) Or
((bytChar(3) - 32) And 63)) And &HFF)
intLen = intLen + 4
Loop
Select Case intFill
Case 1: UUDecode = Left(strOutBuffer, Len(strOutBuffer) - intFill)
Case 2: UUDecode = Left(strOutBuffer, Len(strOutBuffer) - intFill)
Case 3: UUDecode = Left(strOutBuffer, Len(strOutBuffer) - intFill - 1)
Case Else: UUDecode = strOutBuffer
End Select
Err.Clear
End Function
Ciao
--
Timothy Redaelli
P.S. Perché uno xor non va bene????


Perchè è troppo banale da decifrare.
E' la prima cosa che uno proverebbe a fare, un bel giro di xor da 1 a 255 e
ci metterebbe trenta secondi a decifrare i dati (scrittura dell'algoritmo
compreso).
Ciao

 po' troppo semplice :) soprattutto da decriptare)
xor byte a byte troppo semplice da decriptare? E l'One Time Pad dove
lo metti? È l'unico sistema *assolutamente_impossibile* da
decriptare (previo utilizzo corretto).
Ciao.
--
BSD is for UNIX-lovers -- linux is for Windows-haters.

 decriptare (previo utilizzo corretto).
Spiega spiega!
Come funziona questo one-time-pad?
Ciao

 Come funziona questo one-time-pad?
In maniera semplicissima: basta fare uno XOR byte a byte fra quello
che si vuole criptare e la chiave, che però deve essere realmente
casuale (e questo è il problema minore), deve essere lunga quanto
ciò che si vuole criptare e deve essere utilizzata una sola volta.
Chiaramente questo lo rende un sistema poco utilizzabile (criptare
un file di 40 MB richiederebbe una chiave di 40MB), però è l'unico
assolutamente e totalmente impossibile da decifrare.
Vedi:
http://world.std.com/~franl/crypto/one-time-pad.html


 In maniera semplicissima: basta fare uno XOR byte a byte fra quello
[snip]
Ah!
E' quello a cui ero arrivato a fare io :)
Io ho risolto il problema della lunghezza della chiave con un loop sulla
lunghezza del dato usando come byte di criptazione
ByteKey = Mid$(Key, i mod len(Key) + 1, 1)
Ciao, grazie.

 ByteKey = Mid$(Key, i mod len(Key) + 1, 1)
Questo però fa parte dell'utilizzo "non corretto" dell'OTP, e di
fatto ne rompe la sicurezza.


 fatto ne rompe la sicurezza.
Ok, ma io questa chiave la devo dare via come password, e non posso dare una
password assolutamente casuale di lunghezza arbitraria :)
Ti posso sottoporre un altro problemino?
Ho bisogno di ottenere una cosa del genere
[in] Dato + [in] Chiave ==> [out] Firma
in modo che dall'altra parte uno deve avere sia il dato che la chiave
corretta per poter validare la "sua" firma con la mia.
Non mi interessa sapere quali dati e quali chiavi hanno generato la firma,
anzi sarebbe meglio non si possa sapere nemmeno invertendo l'algoritmo di
generazione.
Voglio solo sapere se l'utente ha un dato e una chiave corretta.
Ciao

 Ho bisogno di ottenere una cosa del genere
[cut]
Se ho capito quello che ti serve (oggi sono parecchio stanco e
faccio fatica a comprendere anche le cose più banali), cioè essere
sicuro dell'identità di chi ti scrive (o di chi ti manda un file),
la cosa migliore è utilizzare sistemi come pgp.
Se invece non ho capito non farci caso... oggi è così.


 ha scritto nel messaggio
news:J3Q68.18609$om6.4...@news1.tin.it...


 Prova magari a spiegare meglio...
E' esattamente quello che cerco.
Ma mi basta un algoritmo molto semplice, ho cercato l'implementazione
dell'MD5 e RSA ma (specie il primo) sono piuttosto complessi, anche perchč
vorrei implementarli direttamente in VB.
Ciao

 ha scritto nel messaggio
news:Agc78.21873$om6.5...@news1.tin.it...


 VB)
Non č che vuole tanto ad essere + veloci di VB :-))

 ha scritto nel

Gią, ma io posso usare solo VB, per motivi che non sto a spiegare :(
Ciao

 ha scritto nel
messaggio news:NwD78.20739$nI1.6...@twister1.libero.it...


 Se preferisci in ASP: 
http://www.freevbcode.com/ShowCode.Asp?ID=2366
Perfetto!
Proprio quello che cercavo! (Ora provo se funziona anche :))
Ho cercato per tre giorni in rete senza trovare niente che non sia stato
scritto in C o simil-C...
Ciao, grazie.

 ha scritto nel messaggio
news:o_P78.34534$3J1.1...@news2.tin.it...


 Anzi, come premio gradirei il codice tradotto... ;-DDD
No es problemo :)
Ci sono voluti 5 minuti per convertire il tutto in un bel modulino .bas
Chi l'ha scritto è veramente un grande!
Ciao