|
Можно ли зашивровать записываемые в файл данные
#35459559
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
Участник
Откуда: Спб
Сообщения: 1 673
|
|
простенький шифрофщик дешировщик от юзера
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.
Option Explicit
Private HArr
äîëæíî áûòü ÷åòíûì
Private Const SymOfs = 64
Private key As Long
Public Function crypt(s As String) As String
Dim i As Long
Dim temp As String
Dim tempKey As String
Dim mKey As Long
mKey = random
key = mKey
fillHArr
i = 1
Do While i <= Len(s)
If Rnd(i) > 0 . 5 Then
temp = temp & cryptSymbol(Mid(s, i, 1 ))
i = i + 1
Else
temp = temp & Chr(HArr(Int(Rnd(i) * 16 )) Xor 1 )
End If
Loop
Do While Len(temp) < 2
If Rnd(i) > 0 . 5 Then
temp = temp & Chr(HArr(Int(Rnd(i) * 16 )) Xor 1 )
i = i + 1
End If
Loop
For i = 1 To 3
If Rnd(i) > 0 . 5 Then
temp = temp & Chr(HArr(Int(Rnd(i) * 16 )) Xor 1 )
i = i + 1
End If
Next i
For i = 0 To 7
tempKey = tempKey & Chr(HArr(mKey And &HF) Xor Round(Rnd(i)))
mKey = SHR(mKey, 4 )
Next i
temp = Left(temp, 2 ) & tempKey & Mid(temp, 3 )
crypt = temp
End Function
Public Function deCrypt(s As String) As String
Dim TMP As String
Dim tmp2 As String 'Ïàðà äëÿ äåêîäèðîâàíèÿ
Dim tmpC As String 'Ñèìâîë íà êàæäîé èòåðàöèè
Dim tmpL As Long '×èñëî êîòîðîå ìîã áû îáîçíà÷àòü/îáîçíà÷àåò ñèìâîë
Dim i As Long
If s <> "" Then
key = parseKey(Mid(s, 3 , 8 ))
fillHArr
i = 1
While i <= Len(s)
tmpC = Mid(s, i, 1 )
tmpL = (Asc(tmpC) - SymOfs) \ 2
If Asc(tmpC) = HArr(tmpL) Then
If Len(tmp2) <> 1 Then
tmp2 = tmpC
Else
tmp2 = tmp2 & tmpC
TMP = TMP & deCryptSymbol(tmp2)
End If
End If
i = i + 1
If i = 3 Then i = 11
Wend
deCrypt = TMP
Else
deCrypt = ""
End If
End Function
Private Function deCryptPart(s As String, key As Byte) As Byte
Dim b As Byte
b = Asc(s)
b = (b - SymOfs) \ 2
If ((b Xor (key And &HF)) - key \ &H10) < 0 Then
b = 16 + ((b Xor (key And &HF)) - key \ &H10)
Else
b = ((b Xor (key And &HF)) - key \ &H10)
End If
deCryptPart = b And &HF
End Function
Private Function cryptSymbol(sym As String) As String
Dim val As Byte
val = Asc(sym)
cryptSymbol = Chr(cryptPart(Asc(sym) And &HF, SHR(key, 8 ) And &HFF)) & Chr(cryptPart((Asc(sym) \ &H10) And &HF, key And &HFF))
End Function
Private Function cryptPart(ByVal b As Byte, key As Byte) As Long
b = b And &HF
b = (b + (key \ &H10) And &HF) Xor (key And &HF)
cryptPart = HArr(b And &HF)
End Function
Private Sub fillHArr()
Dim i As Long
For i = 0 To 15
HArr(i) = SymOfs + i * 2 + (getBit(key, 16 + i))
Next i
End Sub
Private Function deCryptSymbol(code As String) As String
deCryptSymbol = Chr(deCryptPart(code, SHR(key, 8 ) And &HFF&) + deCryptPart(Mid(code, 2 ), key And &HFF&) * &H10)
End Function
Private Function parseKey(s As String) As Long
Dim i As Long
Dim l As Long
For i = 1 To 8
l = l + (Asc(Mid(s, i, 1 )) - SymOfs) \ 2
l = ROR(l, 4 )
Next i
parseKey = l
End Function
Private Sub Class_Initialize()
HArr = Array( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 0 , 1 , 2 , 3 , 4 , 5 , 6 )
End Sub
|
|
|
