Срочно необходим алгоритм шифрования строки

[Gemini]

Люди надо алгоритм (хороший и не медленный) для шифрования текстовой строки!
З.Ы.
Только не надо xor

[Tarik]

Есть у меня такая прога... Сам недавно делал для конкурса. Основана на простых числах. Т.е. при загрузке проги формируется список простых чисел, к каждому из них прибавляется от 1 до 3 случайных цифр. Потом каждый символ заменяется на определённое число в соответствии с его ASCII-кодом. Список чисел шифруется встроенным алгоритмом и сохраяется вместе с зашифрованным файлом. В принципе, без файла-ключа взломать такой шифр достаточно сложно. Один БОЛЬШОЙ минус : прога очень трмозит (по крайней мере на моём CEL433) Если надо, могу прислать.

[Mikle]

А чем не устраивает XOR, только XOR не с одним значением, а с псевдослучайной последовательностью (новая буква - новое случайное число), генерируемой каким-то своим алгоритмом. Не зная алгоритм, такой шифр расшифровать НЕВОЗМОЖНО. Только нужно инициализировать алгоритм при каждом сеансе разным числом, а само число будет ключем к шифру.

[FaKk2]

Только нужно инициализировать алгоритм при каждом сеансе разным числом, а само число будет ключем к шифру.

Ты понял что сам сказал как можно расшифровать текст?
Если подсмотреть этот самый псевдослучайный ключик, то...........

[Gemini]

Mikle
мне таким образом (по одной строке) нужно зашифровать/расшифровать файл в 200 кб.
(да и скинь на мыло)

я пробывал делать такую бадягу
dim u&
for i = 1 to len(text)
u = u +1
if u > 255 then u = 1
chr(asc(mid(text,i,1))-u)

next

но он слабоват.

[Ronin_1978]

Есть вариант шифрования на основе 10-ти значного ключа, задаваемого пользователем.
Если интересно - могу выслать.

[Mikle]

Если подсмотреть этот самый псевдослучайный ключик
вот тож. А если не подсмотреть...
Твой вариант действительно слабоват, т. к. это ЦИКЛИЧЕСКАЯ последовательность, длиной всего 255. Здесь:
http://www.tuapse-mikle.narod.ru/password.zip
лежит готовая программа с исходниками. То, что это программу может скачать любой, не поможет ему взломать файл. Используется простая формула:
PassWord = Sin(1000.1 / (PassWord + 1.0001))
NewByte = ((PassWord * 10000#) And 255) xor OldByte
вместо нее можно подставить любую свою, лишь бы она не сходилась и не была цикличной. Сомневаюсь, что все спецслужбы мира вместе взятые, смогут раскодировать такой код не зная пароль.
Но в этом алгоритме есть подводный камень: я не смог раскодировать на AMD K6-2 файл, закодированный на Celeron. Сначала удивился, а потом вспомнил шумиху вокруг того, что AMD округляют вычисления сопросессора. Так что формулу придется сменить на целочисленную (long) или использовать для вычисления синуса эмуляцию сопроцессора.

[Gemini]

а есть такие алгоритмы чтобы точно работали на любых машинах.
(вобщем путёвые)

З.Ы.
А то я уже много их перепробовал и всё время приходиться останавливаться на примерно таком : Chr(268-mid(text,i,1))

Я только что вспомнил (гдето прочитал давно:)) что если шифрованый текст xor и пароль на него равняется размеру текста то его практически невозможно сломать .

[Dr. Implex]

2ALL
Вообще говоря ЛЮБОЙ алгоритм шифрования должен быть основан на предположении того, что потенциальный взломщик его знает, а стойкость шифра обеспечивается ТОЛЬКО ключом, который взломщик не знает. Если ключ равен длине шифруемого файла, то независимо от алгоритма шифрования такой шифратор называется шифратором с бесконечной ключевой гаммой (или безусловно стойким), то есть если предположить теоритическую возможность перебора всех ключей, то из шифрованного сообщения можно получить ЛЮБОЕ по содержанию сообщение. Такие шифры не поддаются ни одному из методов (доказано!) криптоанализа. Алгоритмы с циклическим употреблением ключевого слова являются ненадежными, взламываются на основе избыточности информации. Устойчивость шифра возрастает, если перед шифрацией файл заархивировать. Данные умные мысли меня посетили после пролистывания книги "Криптография. Скоростные шифры." Спасибо за внимание.

[alibek]

Где-то я видел шифрацию по 3DES (вроде бы на planet-source), не помню где.
Кроме того, на http://www.ietf.org/ можно найти описание алгоритма DES-шифрования (про остальные не уверен). Либо стоит поискать в инете алгоритм шифрования по ГОСТ'у (номер ГОСТ тоже не помню )

Если же тебе не нужен супер-надежный алгоритм, то могу порекомендовать Enigma. Сейчас он конечно устарел, но возможно он вполне подойдет для твоей задачи.

[Mikle]

..Dr. Implex
Спасибо, все разложил по полочкам грамотным языком.
..Gemini
а есть такие алгоритмы чтобы точно работали на любых машинах?

Я же пишу - любой целочисленный, главное проследить, что бы не был короткий цикл и за ключ взять как минимум Long Integer - 4 миллиарда вариантов.

[Gemini]

alibek
что за Enigma. (если можно то поподробней)

[alibek]

Во время второй мировой войны немцы разработали этот алгоритм и его так и не смогли взломать
Потом просто сумели спереть шифровальную машину и разобраться в алгоритме.

Чтобы оценить, можешь посмотреть приаттаченный файл. В нем есть запись, касающеяся пользователя "admin" (пароль "0012") и пользователя "oper" (пароль "0"). Если сумеешь хотя бы определить, хотя бы сколько всего пользователей в списке, то я удивлюсь

[Gemini]

А сам алгоритм не можеш приаттачить?
А юзеров помойму около 10 (это только довод)

[alibek]

Юзеров 16
В данном файле храняться: версия (строка, например версия программы, для которой предназначен этот файл), произвольный комментарий (неограниченной длинны), дата, до которой данный файл действителен и записи на каждого пользователя. На каждого пользователя указываентся: логин, имя, пароль, категория (админ, менеджер и т.п.), набор прав (изначально определяется категорией, но можно настроить индивидуально, есть доступ вообще, доступ на чтение, запись, добавление, изменение, удаление, групповые операции для объектов: программа, документы, справочники, настройки, служебные процедуры), произвольный комментарий и статус (отключен, активен).

Здесь (http://alibek7.narod.ru/USEREDIT.ZIP) лежит редактор пользователей плюс файл со списком пользователей. Посмотрите, оцените

А алгоритм я выложу вечером.

[Gemini]

Ладно. Я раскажу поточнее что мне надо.
У меня есть фаил с постоянно повторяющимися одинаковыми функциями.
Пример ( и так весь фаил):

[First]
ref
imn
snd
msп
msg
iff
dim
act
act
act
[end]

Я шифрую его простым способом.
У меня получаеться примерно так ( через xor ):

XqvwlC^
c`w
%khl
akv
Єvh
bvh
ccl
hla
qfd
qfd
qfd
Xak`^

т.е. тут видно что всё повторяеться.
Мне нужно так его зашифровать что бы невозможно было узнать что это за функции, и что бы можно было каждую строку засунуть в массив строк.

З.Ы.
если что-то не понятно спрашивайте.

alibek: кстати user'ов было 8

[Trojan Lord]

попробуй какой-нить более сложный алгоритм. например RSA

[Хой]

А я вот бьюсь над скоростью шифровки\дешифровки файлов...
Сделал прогу на усовершенствованном (мною) *движке* RC4, но он скотина, 1мб кодирует (декодирует) за 1.25 мин.
А ещё сегодня письмо получил, вот такого содержания:

Ну в общем разбирайся. Сделай так, чтобы это было:

а) быстро
б) надежно
в) стабильно

Может у кого-нибудь есть исходники (или предложения) подходяшие под выше указанные требования??

[alibek]

Блин, вчера не успел, работы много было.
Вообщем, вот:

--- clsCrypt.cls ---

Код: Выделить всё

Option Explicit

Private LCW As Integer 'Length of CodeWord
Private LS2E As Integer 'Length of String to be Encrypted
Private LAM As Integer 'Length of Array Matrix
Private MP As Integer 'Matrix Position
Private Matrix As String 'Starting Matrix
Private mov1 As String 'First Part of Replacement String
Private mov2 As String 'Second Part of Replacement String
Private CodeWord As String 'CodeWord
Private CWL As String 'CodeWord Letter
Private EncryptedString As String 'Return/Encrypt or UnEncrypt/UnEncrypt
Private EncryptedLetter As String 'Character just Encrypted
Private strCryptMatrix(255) As String 'Matrix Array

Public Property Let KeyString(KeyString As String)
CodeWord = KeyString
End Property

Public Function Encrypt(Text As String) As String
Dim X As Integer, Y As Integer, Z As Integer
Dim C2E As String, Str2Encrypt As String
Str2Encrypt = Text: LS2E = Len(Text): LCW = Len(CodeWord)
EncryptedLetter = "": EncryptedString = ""
Y = 1
For X = 1 To LS2E
  C2E = Mid(Str2Encrypt, X, 1)
  MP = InStr(1, Matrix, C2E, 0)
  CWL = Mid(CodeWord, Y, 1)
  For Z = 1 To LAM
  If Mid(strCryptMatrix(Z), MP, 1) = CWL Then
     EncryptedLetter = Left(strCryptMatrix(Z), 1)
     EncryptedString = EncryptedString + EncryptedLetter
     Exit For
  End If
  Next Z
  Y = Y + 1
  If Y > LCW Then Y = 1
Next X
Encrypt = EncryptedString
End Function

Private Sub Class_Initialize()
Dim W As Integer, X As Integer
Matrix = ""
For X = 1 To 255
  Matrix = Matrix & Chr$(X)
Next X
W = 1
LAM = Len(Matrix): strCryptMatrix(1) = Matrix
For X = 2 To LAM ' LAM = Length of Array Matrix
  mov1 = Left(strCryptMatrix(W), 1)
  mov2 = Right(strCryptMatrix(W), (LAM - 1))
  strCryptMatrix(X) = mov2 + mov1  'Makes up each row of the Array
  W = W + 1
Next X
End Sub


Использование:

Код: Выделить всё

Dim C As Crypt, T1 As String, T2 As String, T3 As String
Set C = New Crypt
C.KeyString = "MyKeyString"
T1 = InputBox("Input text")
T2 = C.Encrypt(T1)
T3 = C.Encrypt(T2)
MsgBox "Text" & _
  VbNewLine & "Original: " & T1 & _
  VbNewLine & "Encrypted: " & T2 & _
  VbNewLine & "Decrypted: " & T3


Единственно - в шифруемой строке не должно быть символов с кодом 0 (Chr$(0))

P.S. Gemini, юзеров 16 Просто в том архиве, куда я выложил, я немного подправил файл -- удалил часть юзеров и у всех очистил пароли. Подсунь первоначальный .usr-файл, если он у тебя сохранился, и убедишься сам.

[Gemini]

А что за RC4, и почему он такой гадкий????

[Хой]

Да не какой он не гадкий!
Очень даже хороший и надёжный.
А вот что мне в нём больше всего нравиться:

Код: Выделить всё

Шифрование выполняется примерно в 10 раз быстрее , чем DES.
Утверждается, что алгоритм устойчив к дифференциальному и линейному криптоанализу, что в нём нет никаких коротких циклов, и что он в высокой степени нелинеен. RC4 может находиться в ,примерно, 2^1700 возможных состояниях.S -блок медленно изменяется при использовании: i обеспечивает изменение каждого элемента, а j - что элементы изменяются случайным образом. Идею можно обобщить на S -блоки и слова больших размеров.


Это мошьный способ шифровки!

[ShadowCaster]

Для того, чтобы убрать повторяющиеся группы символов, используй наряду с xor'ом ещё и зависимость от позиции в строке

[Gemini]

не могли бы вы RC4 приаттачить или выслать мне на мыло?

З.Ы.
В сиходниках.

[Powersoft]

Шифрование методом RC4. Быстро и надежно:

Думаю, с использованием разберешься

Код: Выделить всё

Option Explicit


Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Event Progress(Percent As Long)

Private m_Key As String
Private m_sBox(0 To 255) As Integer
Private byteArray() As Byte
Private hiByte As Long
Private hiBound As Long
Public Function EncryptFile(InFile As String, OutFile As String, Overwrite As Boolean, Optional Key As String) As Boolean
    On Error GoTo errorhandler
    If FileExist(InFile) = False Then
        EncryptFile = False
        Exit Function
    End If
    If FileExist(OutFile) = True And Overwrite = False Then
        EncryptFile = False
        Exit Function
    End If
    Dim FileO As Integer, Buffer() As Byte
    FileO = FreeFile
    Open InFile For Binary As #FileO
        ReDim Buffer(0 To LOF(FileO) - 1)
        Get #FileO, , Buffer()
    Close #FileO
    Call EncryptByte(Buffer(), Key)
    If FileExist(OutFile) = True Then Kill OutFile
    FileO = FreeFile
    Open OutFile For Binary As #FileO
        Put #FileO, , Buffer()
    Close #FileO
    EncryptFile = True
    Exit Function

errorhandler:
    EncryptFile = False
End Function
Public Function DecryptFile(InFile As String, OutFile As String, Overwrite As Boolean, Optional Key As String) As Boolean
    On Error GoTo errorhandler
    If FileExist(InFile) = False Then
        DecryptFile = False
        Exit Function
    End If
    If FileExist(OutFile) = True Then
        DecryptFile = False
        Exit Function
    End If
    Dim FileO As Integer, Buffer() As Byte
    FileO = FreeFile
    Open InFile For Binary As #FileO
        ReDim Buffer(0 To LOF(FileO) - 1)
        Get #FileO, , Buffer()
    Close #FileO
    Call DecryptByte(Buffer(), Key)
    If FileExist(OutFile) = True Then Kill OutFile
    FileO = FreeFile
    Open OutFile For Binary As #FileO
        Put #FileO, , Buffer()
    Close #FileO
    DecryptFile = True
    Exit Function

errorhandler:
    DecryptFile = False
End Function

Public Sub DecryptByte(byteArray() As Byte, Optional Key As String)
    Call EncryptByte(byteArray(), Key)
End Sub
Public Function EncryptString(Text As String, Optional Key As String, Optional OutputInHex As Boolean) As String
    Dim byteArray() As Byte
    byteArray() = StrConv(Text, vbFromUnicode)
    Call EncryptByte(byteArray(), Key)
    EncryptString = StrConv(byteArray(), vbUnicode)
    If OutputInHex = True Then EncryptString = EnHex(EncryptString)
End Function
Public Function DecryptString(Text As String, Optional Key As String, Optional IsTextInHex As Boolean) As String
    Dim byteArray() As Byte
    If IsTextInHex = True Then Text = DeHex(Text)
    byteArray() = StrConv(Text, vbFromUnicode)
    Call DecryptByte(byteArray(), Key)
    DecryptString = StrConv(byteArray(), vbUnicode)
End Function
Public Sub EncryptByte(byteArray() As Byte, Optional Key As String)
Dim i As Long, j As Long, Temp As Byte, Offset As Long, OrigLen As Long, CipherLen As Long, CurrPercent As Long, NextPercent As Long, sBox(0 To 255) As Integer

If (Len(Key) > 0) Then Me.Key = Key
Call CopyMem(sBox(0), m_sBox(0), 512)
OrigLen = UBound(byteArray) + 1
CipherLen = OrigLen

For Offset = 0 To (OrigLen - 1)
    i = (i + 1) Mod 256
    j = (j + sBox(i)) Mod 256
    Temp = sBox(i)
    sBox(i) = sBox(j)
    sBox(j) = Temp
    byteArray(Offset) = byteArray(Offset) Xor (sBox((sBox(i) + sBox(j)) Mod 256))
    If (Offset >= NextPercent) Then
        CurrPercent = Int((Offset / CipherLen) * 100)
        NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
        RaiseEvent Progress(CurrPercent)
    End If
Next
If (CurrPercent <> 100) Then RaiseEvent Progress(100)
End Sub
Private Sub Reset()
    hiByte = 0
    hiBound = 1024
    ReDim byteArray(hiBound)
End Sub
Private Sub Append(ByRef StringData As String, Optional Length As Long)
    Dim DataLength As Long
    If Length > 0 Then DataLength = Length Else DataLength = Len(StringData)
    If DataLength + hiByte > hiBound Then
        hiBound = hiBound + 1024
        ReDim Preserve byteArray(hiBound)
    End If
    CopyMem ByVal VarPtr(byteArray(hiByte)), ByVal StringData, DataLength
    hiByte = hiByte + DataLength
End Sub
Private Function DeHex(Data As String) As String
    Dim iCount As Double
    Reset
    For iCount = 1 To Len(Data) Step 2
        Append Chr$(Val("&H" & Mid$(Data, iCount, 2)))
    Next
    DeHex = GData
    Reset
End Function
Private Function EnHex(Data As String) As String
    Dim iCount As Double, sTemp As String
    Reset
    For iCount = 1 To Len(Data)
        sTemp = Hex$(Asc(Mid$(Data, iCount, 1)))
        If Len(sTemp) < 2 Then sTemp = "0" & sTemp
        Append sTemp
    Next
    EnHex = GData
    Reset
End Function
Private Function FileExist(Filename As String) As Boolean
    On Error GoTo errorhandler
    Call FileLen(Filename)
    FileExist = True
    Exit Function

errorhandler:
    FileExist = False
End Function
Private Property Get GData() As String
    Dim StringData As String
    StringData = Space(hiByte)
    CopyMem ByVal StringData, ByVal VarPtr(byteArray(0)), hiByte
    GData = StringData
End Property
Public Property Let Key(New_Value As String)
    Dim a As Long, b As Long, Temp As Byte, Key() As Byte, KeyLen As Long
    If (m_Key = New_Value) Then Exit Property
    m_Key = New_Value
    Key() = StrConv(m_Key, vbFromUnicode)
    KeyLen = Len(m_Key)
    For a = 0 To 255
        m_sBox(a) = a
    Next a
    For a = 0 To 255
        b = (b + m_sBox(a) + Key(a Mod KeyLen)) Mod 256
        Temp = m_sBox(a)
        m_sBox(a) = m_sBox(b)
        m_sBox(b) = Temp
    Next
End Property



[Mikle]

Я перечитал название темы и узрел там слово "СРОЧНО"...