Visual Basic 6 - Criptare(scusate per prima)

20/12/07 6:23

Vorrei una routine per criptare una stringa in vb6
P.S.Scusate per prima ma nn ho molta esperienza con la criptazione :k:

aaa

20/12/07 19:13

gius

nessuno che mi aiuta 8-|

aaa

20/12/07 19:59

gantonio

Ti avevo gia' risposto con un esempio di codice nel primo thread ... perche' non usi quello?

aaa

21/12/07 18:30

P4p3r0g4

il metodo migliore (a mio parere) di criptazione per frasi brevi o per parole è quello di sostituzione.
prendi i codici ascii dei singoli caratteri (con mid non si può fare una conversione globale) e mischiarli con i codici ascii della passkey.
con mischiarli intendo sommarli, dividerli elevarli insomma trasformarli in qualsiasi maniera che ammetta un'inversa.
e poi riconventirli in char.
questo metodo non può funzionare per testi lunghi o per file. quindi presta attenzione a cosa cripti.

aaa

21/12/07 20:54

gius

Un esempio

aaa

22/12/07 14:54

gius, ti mando un codice che avevo scritto molti anni fa, scopiazzando di qua e di la.
anche sel la criptazione non credo sia molto sicura

Public ww, wh, n, m, p, t, maxid, h1, h2, finito, limite
Public nomefile As String
Dim k(400)

Private Function decifra(infile As String) As Boolean
Dim numfile1 As Integer
Dim numfile2 As Integer
Dim outfile As String
Dim xpos As Long
Dim x As Byte
Dim t(3) As Byte
MousePointer = 11
xpos = 4
outfile = "c:\temp.jpg"

numfile1 = FreeFile
Open infile For Binary As numfile1
numfile2 = FreeFile
Get #numfile1, 1, t(0)
Get #numfile1, 2, t(1)
Get #numfile1, 3, t(2)
Get #numfile1, 4, t(3)
If (t(0) = 0 And t(1) = 128 And t(2) = 0 And t(3) = 128) Then
Open outfile For Binary As numfile2

Do While Not EOF(numfile1)
xpos = xpos + 1
Get #numfile1, xpos, x
Put #numfile2, xpos - 4, x + 128
Loop
Close numfile2
Close numfile1
Kill infile
FileCopy outfile, infile
Kill outfile
decifra = True
Else
decifra = False
End If
MousePointer = 0

End Function
Function critto(infile As String) As Boolean
Dim numfile1 As Integer
Dim numfile2 As Integer
Dim outfile As String
Dim xpos As Long
Dim x As Byte
Dim t(3) As Byte
MousePointer = 11
xpos = 4
outfile = "c:\temp.enc"
numfile1 = FreeFile
Open infile For Binary As numfile1
numfile2 = FreeFile
Open outfile For Binary As numfile2
Get #numfile1, 1, t(0)
Get #numfile1, 2, t(1)
Get #numfile1, 3, t(2)
Get #numfile1, 4, t(3)
If (t(0) = 0 And t(1) = 128 And t(2) = 0 And t(3) = 128) Then
critto = False
MousePointer = 0
Close numfile2
Close numfile1
Exit Function
Else
Put #numfile2, 1, 0
Put #numfile2, 2, 128
Put #numfile2, 3, 0
Put #numfile2, 4, 128
Do While Not EOF(numfile1)
xpos = xpos + 1
Get #numfile1, xpos - 4, x
Put #numfile2, xpos, x + 128
Loop
Close numfile2
Close numfile1
Kill infile
FileCopy outfile, infile
Kill outfile
critto = True
End If
MousePointer = 0
End Function
Function getfile() As String
cd.CancelError = True
On Error GoTo filerr
cd.FileName = ""
cd.Filter = "Immagini (*.bmp;*.jp*;*.gif)|*.bmp;*.jp*;*.gif"
cd.ShowOpen
getfile = cd.FileName
Exit Function
filerr:
getfile = ""
End Function
Private Sub Command1_Click()
nomefile = getfile()
If nomefile <> "" Then
If critto(nomefile) = False Then
MsgBox "errore - file gia cifrato"
End If
End If
End Sub

Private Sub Command3_Click()
nomefile = getfile()
If nomefile <> "" Then
If decifra(nomefile) = False Then
MsgBox "errore nella decifrazione"
End If
End If
End Sub

22/12/07 20:43

gius

nn funge

aaa

23/12/07 20:50

P4p3r0g4

non è difficile.
ho scritto questo in 5 min.

text1 (testo da crittare)
text2 (chiave per la crittatura)
text3 (dove apparirà il testo crittato)
command1 (pulsante per crittare)

text4 (testo da decrittare)
text5 (chiave per la decrittatura)
text6 (dove apparirà il testo decrittato)
command2 (pulsante per decrittare)

Private Sub Command1_Click()
Dim x As Integer
Text3.Text = ""
For x = 1 To Len(Text1.Text)
Text3.Text = Text3.Text & Chr((Asc(Mid(Text1.Text, x, 1)) + Asc(Mid(Text2.Text, ((x - 1) Mod (Len(Text2.Text))) + 1, 1))) Mod 256)
Next x
End Sub

Private Sub Command2_Click()
Dim x As Integer
Text6.Text = ""
For x = 1 To Len(Text4.Text)
Text6.Text = Text6.Text & Chr((256 + Asc(Mid(Text4.Text, x, 1)) - Asc(Mid(Text5.Text, ((x - 1) Mod (Len(Text5.Text))) + 1, 1))) Mod 256)
Next x
End Sub

aaa

1 2