[VB] Avete TIN Messenger? Se si entrate

[jabjoint]

Se vi serve, ho fatto una funzione che decripta e cripta le password che il famoso programma salva nei file nick presenti nella cartella d' installazione.

Le funzioni sono molto semplici, se qualcuno le vuole me lo dica che le posto, premetto che non servono moltissimo pero', se qualcuno di voi si dovesse dimenticare la password e la vuole riavere al volo...

[michele79]

Ho scaricato un prog da internet che funziona sotto Dos che fa la stessa cosa... ma se la password non è salvata non trova un bel niente!

[xegallo]

che metodo di cifratura usi?

[jabjoint]

non so che cifratura è, cmq è molto semplice, la funzioni sono queste cmq: (come funzione privata occorre anche la HexToDec che ho aggiunto)

Function criptac6(word As String) As String

Dim pos(15) As String
Dim cwrd As String
Dim k As Integer

'b5c9c681d4c6d5d6d181d1d3d0c4c6
'a a a a a a a a a a a a a a a

pos(1) = 84 'b5
pos(2) = 104 'c9
pos(3) = 101 'c6
pos(4) = 32 '81
pos(5) = 115 'd4
pos(6) = 101 'c6
pos(7) = 116 'd5
pos(8) = 117 'd6
pos(9) = 112 'd1
pos(10) = 32 '81
pos(11) = 112 'd1
pos(12) = 114 'd3
pos(13) = 111 'd0
pos(14) = 99 'c4
pos(15) = 101 'c6

For k = 1 To Len(word)
cwrd = cwrd & Hex(Asc(Mid(word, k, 1)) + pos(k))
Next

criptac6 = cwrd

End Function


Function decriptac6(word As String) As String

On Error Resume Next

Dim pos(15) As String
Dim cwrd As String
Dim x As Integer
Dim k As Integer

'b5c9c681d4c6d5d6d181d1d3d0c4c6
'a a a a a a a a a a a a a a a

pos(1) = 84 'b5
pos(2) = 104 'c9
pos(3) = 101 'c6
pos(4) = 32 '81
pos(5) = 115 'd4
pos(6) = 101 'c6
pos(7) = 116 'd5
pos(8) = 117 'd6
pos(9) = 112 'd1
pos(10) = 32 '81
pos(11) = 112 'd1
pos(12) = 114 'd3
pos(13) = 111 'd0
pos(14) = 99 'c4
pos(15) = 101 'c6

x = 1

For k = 1 To Len(word) / 2

cwrd = cwrd & Chr(HexToDec(Mid(word, x, 2)) - pos(k))

x = x + 2

Next

If Err = 0 Then

decriptac6 = cwrd

Else

decriptac6 = "Non valido"

End If

End Function

Private Function HexToDec(Valore_HEX As String) As Integer

Dim v_Hex As String
Dim x As Integer
Dim z As Integer
Dim y As String

v_Hex = UCase(Valore_HEX)

For k = 1 To Len(v_Hex)

z = 16 ^ (Len(v_Hex) - k)

If z = 0 Then
z = 1
End If

y = Mid(v_Hex, k, 1)

If y = "A" Then
y = 10
ElseIf y = "B" Then
y = 11
ElseIf y = "C" Then
y = 12
ElseIf y = "D" Then
y = 13
ElseIf y = "E" Then
y = 14
ElseIf y = "F" Then
y = 15
End If

r = r + y * z

Next

HexToDec = r

End Function

[jabjoint]

ovviamente queste funzioni sono il succo del programma, non estraggono la password, ad estrarle basta aprire ogni file contenuto nella cartella TinMessenger(solitamente è "C:\TinMessenger") e splittare "MyPwd=" fino al "vbcrlf"