1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
| Option Explicit
Private StrClé As String
Private StrTexte As String
Public Property Let IniClé(Clé As String)
StrClé = Clé
Initialize
End Property
Public Property Let IniTexte(Texte As String)
StrTexte = Texte
End Property
Public Property Get IniTexte() As String
IniTexte = StrTexte
End Property
Public Sub DoXor()
Dim lngC As Long
Dim intB As Long
Dim LngN As Long
For LngN = 1 To Len(StrTexte)
lngC = Asc(Mid(StrTexte, LngN, 1))
intB = Int(Rnd * 256)
Mid(StrTexte, LngN, 1) = Chr(lngC Xor intB)
Next LngN
End Sub
Private Sub Initialize()
Dim LngN As Long
Randomize Rnd(-1)
For LngN = 1 To Len(StrClé)
Randomize Rnd(-Rnd * Asc(Mid(StrClé, LngN, 1)))
Next LngN
End Sub
Public Function Encrypt(Code As String, text As String) As String
Dim strHead As String
Dim strT As String
Dim strA As String
Dim CodageX As New CDETXT
Dim LngN As Long
CodageX.IniTexte = text
CodageX.IniClé = Code
CodageX.DoXor
strT = CodageX.IniTexte
strHead = strT
CodageX.IniClé = strHead
CodageX.IniTexte = strA
CodageX.DoXor
strA = CodageX.IniTexte
Encrypt = strHead
End Function
Public Function Decrypt(Code As String, Verif As String) As String
Dim strA As String
Dim strT As String
Dim CodageX As New CDETXT
Dim lnlN As Long
Decrypt = True
strT = Code 'Mid(Code, Len("[Crypting_AutoCâble]") + 1, Len(Code) - (Len("[Crypting_AutoCâble]")))
CodageX.IniClé = Code
CodageX.IniTexte = Verif
CodageX.DoXor
Decrypt = CodageX.IniTexte
'If CodageX.IniTexte <> Verif Then
' MsgBox "Mot de passe incorrect", vbExclamation + vbOKOnly
' Decrypt = False
' Exit Function
'End If
End Function
Public Function DefinSerialPass(UserName As String, Serial As String, Pass As String)
On Error Resume Next
Dim x
Dim Longcode
Dim y
Dim P As Integer
Dim I As Long
x = Right(UserName, 1) 'code pour coder le serial
Longcode = Len(UserName) + 3 'code pour coder le serial
y = Longcode * 10
Serial = Chr(Longcode * 5) & Asc(Right(UserName, 1)) & Asc(Left(UserName, 1)) & Asc(x) & Chr(y) 'code pour coder le serial
Pass = ""
For I = 1 To Len(UserName)
P = Asc(Mid(UserName, I, 1))
P = 90 - Asc(Mid(UserName, I, 1))
Reprise:
If (P < 48) And (P < 58) Then P = 48 + (48 - P)
If (P > 57) And (P < 90) Then P = 90 + (90 - P)
If (P > 122) Then P = 122 + (122 - P)
If (P > 90) And (P < 97) Then
P = 97 - P
GoTo Reprise
End If
Pass = Pass & Chr(P)
Debug.Print Pass
'Pass
Next
Private Function PeriodeVal(DateD As Date, DateEncours As Date, DateF As Date) As Boolean
PeriodeVal = True
If (DateD < DateEncours) And (DateEncours > DateF) Then
PeriodeVal = False
End If
End Function |
Récupérer une valeur unicode dans un fichier txt et le charger dans une var. String
Répondre avec citation
Envoyé par Zarkann
?
Partager