



Dim b As Byte
Open "file.txt" For Binary As 1
While Not EOF(1)
    Get 1, , b
    Put 1, , Not b
Wend
Close 1


Public Function Crypt(key, x As String)'key - ключ 
Dim y As String, i, j'x - строка которую надо шифрануть
On Error Resume Next
j = 1
For i = 1 To Len(x)
  If j = Len(key) + 1 Then j = 1
  Mid(x, i, 1) = Chr(Asc(Mid(x, i, 1)) Xor (Asc(Mid(x, j, 1))))
  j = j + 1
Next
Crypt = x
End Function



Dim b As Byte
Open "123.txt" For Binary As 1
While Not EOF(1)
    Get 1, , b
    Put 1, , Not Not b
Wend
Close 1

cashman писал(а):2VOS
Если так:
- Код: Выделить всё
Dim b As Byte
Open "123.txt" For Binary As 1
While Not EOF(1)
Get 1, , b
Put 1, , Not Not b
Wend
Close 1
то не получается...
Напиши свой код.



Сорри, меня сбили с толкуA.A.Z. писал(а):Дык там Not Not b - результат один и тот же
2 VOS: используй Not b и для шифровки, и для зашифровки
 



 
 
Const KeyRing = 157
Function Crypt(ByVal StrToCrypt As String) As String
Dim b As Byte, tmp As String
For I = 1 To Len(StrToCrypt)
tmp = tmp + Chr(Asc(Mid(StrToCrypt, I, 1)) Xor KeyRing)
Next I
Crypt = tmp
End Function
Private sub Form_Click()
st$="sadklsahdrulhnds"         'Ну, допустим...
print st$
print Crypt(st$)
print Crypt(crypt(st$))
end sub

Option Explicit
Function Crypt$(ByVal What$)
Dim b As Byte, FF&
FF = FreeFile
Open "C:\Temp" For Output As #FF
Print #FF, What
Close #FF
FF = FreeFile
Open "C:\Temp" For Binary As #FF
While Not EOF(FF)
Get #FF, , b
Put #FF, , Not b
Wend
Close #FF
FF = FreeFile
Open "C:\Temp" For Input As #FF
Crypt = Input(LOF(FF), #FF)
Close #FF
Kill "C:\Temp"
End Function
Private Sub Form_Load()
Dim S$
S = Crypt("jdfijdfjdf")
MsgBox S
MsgBox Crypt(S)
End Sub


 
 




Dim st, all
Open "xxx.txt" For Input as #1
Do While Not EOF(1)
Line Intput #1, st
all = all & Crypt(st, "your key") & vbCrLf
Loop
Close #1

VOS писал(а):ойй...
Скопировал код Темыча в VB - вроде прет... ОДИН И ТОТ ЖЕ код для шифрации и дешифрации! К сож. после дешифринга моего autoexec.bat в конце появились 2 непотребных символа!
По-моему, лучше делать с XOR, проверенный метод, все равно для шифрации и дешифр. нужен один код, к тому же XOR'ить можно на разные числа - появляется подобие паролей...
- Код: Выделить всё
Const KeyRing = 157
Function Crypt(ByVal StrToCrypt As String) As String
Dim b As Byte, tmp As String
For I = 1 To Len(StrToCrypt)
tmp = tmp + Chr(Asc(Mid(StrToCrypt, I, 1)) Xor KeyRing)
Next I
Crypt = tmp
End Function
Чтоб проверить эффективность:
- Код: Выделить всё
Private sub Form_Click()
st$="sadklsahdrulhnds" 'Ну, допустим...
print st$
print Crypt(st$)
print Crypt(crypt(st$))
end sub
 
   
 







Nikolka писал(а):Послушай, если какой-нить самый ламерский хакет новичок посмотрит на все эти припамбасы. Он просто возьмёт и словит твоё прямо в памяти и уже декодированное. Тобой же
 



 
 
Public Function EnDeCrypt(plaintxt As String, Password As String) As String
     Dim temp As Integer
     Dim a As Integer
     Dim b As Integer
     Dim cipherby As Byte
     Dim cipher As String
     b = 0
     For a = 0 To 255
         b = b + 1
         If b > Len(Password) Then
             b = 1
         End If
         kep(a) = Asc(Mid$(Password, b, 1))
     Next a
     For a = 0 To 255
         s(a) = a
     Next a
     
     b = 0
     For a = 0 To 255
         b = (b + s(a) + kep(a)) Mod 256
         temp = s(a)
         s(a) = s(b)
         s(b) = temp
     Next a
     
     For a = 1 To Len(plaintxt)
         cipherby = EnDeCryptSingle(Asc(Mid$(plaintxt, a, 1)))
         cipher = cipher & Chr(cipherby)
     Next
     EnDeCrypt = cipher
End Function
Public Function EnDeCryptSingle(plainbyte As Byte) As Byte
     Dim i As Integer
     Dim j As Integer
     Dim temp As Integer
     Dim k As Integer
     Dim cipherby As Byte
     
     i = (i + 1) Mod 256
     j = (j + s(i)) Mod 256
     temp = s(i)
     s(i) = s(j)
     s(j) = temp
     k = s((s(i) + s(j)) Mod 256)
     cipherby = plainbyte Xor k
     EnDeCryptSingle = cipherby
End Function


cashman писал(а):2tyomitch
твой код на кодирование работает - ничего не понять
а вот на декодирование - никак (хоть 2, хоть 3 раза повторить код) - он видимо пытается ее декодировать, но исходный текст не получается - идет новая белиберда
 
Dim b As Byte
Open "file.txt" For Binary As 1
While Not EOF(1)
    Get 1, , b
    Put 1, Loc(1), Not b
Wend
Close 1




tyomitch писал(а):Угу... Опечатался
- Код: Выделить всё
Dim b As Byte
Open "file.txt" For Binary As 1
While Not EOF(1)
Get 1, , b
Put 1, Loc(1), Not b
Wend
Close 1
"надо же, ошибка в шестом знаке, а такая разница" (с)



_Мика_ писал(а):Правда код не мой, но все таки
- Код: Выделить всё
***
kep(a) = Asc(Mid$(Password, b, 1))
***
b = (b + s(a) + kep(a)) Mod 256
***
 
 




Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6