Function XorString(sToXor As String) As String
Dim sTmp As String
Dim k As Long
Dim nLen As Integer, nLenPwd As Integer
Dim iChrPwd As Integer, idChrPwd As Integer
Dim iChrToXor As Integer, idChrToXor As Integer
Dim iChr As Integer
Dim sPwd As String
sPwd = "o9iweriHHwuiwn398fuionn98nxliwexur89xm84xum9roufmxrhf787mxi3"
nLen = Len(sToXor)
nLenPwd = Len(sPwd)
sTmp = Space$(nLen)
For idChrToXor = 1 To nLen
idChrPwd = idChrPwd + 1
If idChrPwd > nLenPwd Then idChrPwd = 1
iChrPwd = Asc(Mid$(sPwd, idChrPwd, 1))
iChrToXor = Asc(Mid$(sToXor, idChrToXor, 1))
iChr = iChrPwd Xor iChrToXor
Mid$(sTmp, idChrToXor, 1) = Chr$(iChr)
Next
XorString = sTmp
End Function
Function DecryptNumeriEstrazione(sRecord As String)
Dim k As Long
Dim iChrEncrypted As Integer, nLottrone As Integer, nRuota As Integer, nPos As Integer
ReDim aNum(1 To 10, 1 To 5)
nRuota = 1
For k = 9 To 58
iChrEncrypted = Asc(Mid$(sRecord, k, 1))
nLottrone = iChrEncrypted - 31
nPos = nPos + 1
If nPos > 5 Then
nPos = 1
nRuota = nRuota + 1
End If
aNum(nRuota, nPos) = nLottrone
Next
DecryptNumeriEstrazione = aNum
End Function
Sub LoadList(aNumPerRuota, lb As ListBox)
Dim r As Integer, p As Integer
Dim s As String
lb.Clear
For r = 1 To UBound(aNumPerRuota)
s = ""
For p = 1 To 5
If p < 5 Then
s = s & Format(aNumPerRuota(r, p), "00") & "."
Else
s = s & Format(aNumPerRuota(r, p), "00")
End If
Next
lb.AddItem s
Next
End Sub
Function EncryptEstrazione(sData As String, aNumPerRuota) As String
Dim sTmp As String, sRet As String
Dim r As Integer, p As Integer, idChr As Integer
sTmp = Space$(60)
sRet = Space$(60)
Mid$(sTmp, 1, 8) = Format(sData, "yyyymmdd")
idChr = 8
For r = 1 To 10
For p = 1 To 5
idChr = idChr + 1
Mid$(sTmp, idChr, 1) = Chr$(aNumPerRuota(r, p) + 31)
Next
Next
EncryptEstrazione = XorString(sTmp)
End Function
Private Sub Command1_Click()
Dim f As Integer
Dim nQEstrazioni As Integer, idEstrDaLeggere As Integer
Dim sRecordEncrypted As String * 60
Dim sDecryptedRecord As String
Dim aNumPerRuota
Dim sData As String
Dim sNewEncryptedRec As String
f = FreeFile
Open "C:\Programmi\Lotto Oracolo 2.0\archivio.dat" For Random As f Len = 60
nQEstrazioni = LOF(f) / 60 ' il record è lungo 60 byte
idEstrDaLeggere = Int(InputBox("Estrazione da leggere da 1 a " & nQEstrazioni, "IdEstrazione", nQEstrazioni))
If idEstrDaLeggere < 1 Or idEstrDaLeggere > nQEstrazioni Then
MsgBox "Id non valido"
Else
Get f, idEstrDaLeggere, sRecordEncrypted
sDecryptedRecord = XorString(sRecordEncrypted)
aNumPerRuota = DecryptNumeriEstrazione(sDecryptedRecord)
sData = Mid(sDecryptedRecord, 7, 2) & "/" & Mid(sDecryptedRecord, 5, 2) & "/" & Mid(sDecryptedRecord, 1, 4)
Label1 = sData
Call LoadList(aNumPerRuota, List1)
' per test esegue nuovamente l'encrypt dell'estrazione e la mostra in un altra lista
' dopo averla decriptata di nuovo
sNewEncryptedRec = EncryptEstrazione(sData, aNumPerRuota) ' record da scrivere nel file riceve la data in formato "dd/mm/yyyy" & la amtrice in chiaro dei numeri dell'estrazione
' ridecripta per verifica
sDecryptedRecord = XorString(sNewEncryptedRec)
aNumPerRuota = DecryptNumeriEstrazione(sDecryptedRecord)
sData = Mid(sDecryptedRecord, 7, 2) & "/" & Mid(sDecryptedRecord, 5, 2) & "/" & Mid(sDecryptedRecord, 1, 4)
Label2 = sData
Call LoadList(aNumPerRuota, List2)
End If
Close f
End Sub
m hai descritto perfettamente ciò che fa il codice che ho postato e ti è chiarissimo come devi procedere.
