Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[52.90.211.141] |
|
Сообщ.
#1
,
|
|
|
Здравствуйте!
Нашёл хороший пример по шифрованию файлов. Всё бы хорошо, но при дешифровке появляется лишний байт в файле в виде пробела. Не могу никак понять, в чём дело. Единственное, что опытным путём удалось установить, что эта операция перед запись файла позволяет избежать записи лишнего пробела, но это не решение. FN2 = FreeFile Open F_Name For Output As #FN2 Close #FN2 Нужно по существу решить задачу. Самое главное, когда замеряешь длину переменной перед записью в файл, то длина нормальная, а после команды PUT на 1 байт становится больше. Всю ночь сегодня просидел, так и не понял ничего. С чем это может быть связано? Прикреплённый файлFileBin.zip (48,75 Кбайт, скачиваний: 151) |
Сообщ.
#2
,
|
|
|
Код из аттача не смотрел, но не твой ли это случай Убрать лишний [NUL], дописываемый в конец файла. ?
|
Сообщ.
#3
,
|
|
|
B.V., я думаю, что нет, потому что у меня типы данных как Byte, так и String - одинаково не работают.
Замеряю Ubound байтового массива до и после сохранения - всё хорошо, а по факту записывается на 1 байт больше. |
Сообщ.
#4
,
|
|
|
Решение подсказали в другом месте.
Большое спасибо тем, кто помог. Один и тот же код работает как на закодирование, так и на раскодирование. Dim i As Integer Dim j As Integer Dim f As Integer Dim sz As Integer Dim Buf As String Dim key As String Dim keylen As Integer Dim a As String Dim b As String key = "xxx" f = FreeFile Open "A:\123.txt" For Binary As #f sz = LOF(f) Buf = Space(sz) Get #f, , Buf keylen = Len(key) j = 1 For i = 1 To sz a = Mid(Buf, i, 1) b = Mid(key, j, 1) a = Chr(Asc(a) Xor Asc(b)) Mid(Buf, i, 1) = a j = j + 1 If j > keylen Then j = 1 Next i Seek #f, 1 Put #f, , Buf Close #f |
Сообщ.
#5
,
|
|
|
Прикрепляю на всякий пожарный скрипты, которые до этого были у меня в коллекции:
Public Function Encrypt(ByVal Val4 As String, ByVal Val3 As String) As String Dim a As String Dim b As String Dim c As String Dim d As String Dim lentext As Long Dim lenpass As Long Dim cn As Long a = Val4 b = Val3 c = vbnullstring lentext = Len(a) lenpass = Len(b) For cn = 1 To lentext d = Trim(str(Asc(Mid(a, cn, 1)) Xor Asc(Mid(b, ((cn - 1) Mod lenpass) + 1, 1)))) Select Case Val(d) Case 0 To 9 d = "00" + d Case 10 To 99 d = "0" + d End Select c = c + d Next cn Encrypt = c End Function Public Function Decrypt(ByVal Val1 As String, ByVal Val2 As String) As String Dim a As String Dim b As String Dim c As String Dim lentext As Long Dim lenpass As Long Dim cn As Long a = vbnullstring b = Val2 c = Val1 lentext = Len(c) lenpass = Len(b) For cn = 1 To lentext Step 3 a = a + Chr(Val(Mid(c, cn, 3)) Xor Asc(Mid(b, (Int(cn / 3) Mod lenpass) + 1, 1))) Next cn Decrypt = a End Function Ну, а это старина SCINER постарался: Function XorEncryptDecrypt(ByVal Text As String, ByVal Pass As String) Dim i As Long Dim b() As Byte 'шифруемые данные Dim c() As Byte 'пароль, которым шифруется данные Dim TextLen As Long 'длина шифруемых данных Dim PassLen As Long 'длина пароля 'Если текст или пароль пусто значить шифрация бесполезна If Len(Text) = 0 Then GoTo EXIT_LABEL If Len(Pass) = 0 Then Exit Function 'Замеряем длину шифруемых данных TextLen = Len(Text) 'Замеряем длину пароля PassLen = Len(Pass) 'Создаем байтовый массив размера равного длине шифруемых данных ReDim b(TextLen * 2) 'Создаем байтовый массив размера равного длине пароля ReDim c(PassLen * 2) 'Копируем шифруемые данные в созданный байтовый массив 'т.е. Переводим тип String в байтовый массив Call CopyMemory(b(0), ByVal Text, TextLen * 2) 'Копируем пароль в созданный байтовый массив 'т.е. Переводим тип String в байтовый массив Call CopyMemory(c(0), ByVal Pass, PassLen * 2) 'непосредственно сама процедура шифрации данных переданным паролем 'пароль блочно накладывается на шифруемые данные операцией XOR For i = 0 To UBound(b) b(i) = b(i) Xor c(i Mod PassLen) Next 'Переводим байтовый массив в тип String Call CopyMemory(ByVal Text, b(0), TextLen * 2) 'Очистка памяти Erase b Erase c 'Сюда идет перенаправление, если текст или пароль пустые EXIT_LABEL: 'Возвращаем зашифрованные/дешифрованные данные XorEncryptDecrypt = Text End Function |
Сообщ.
#6
,
|
|
|
Написали код мне, который более рационален предыдущим.
Алгоритм (скрипт) шифрования XOR: Option Explicit Private Sub Form_Load() Dim bData() As Byte ' // Шифрование Open "C:\temp\EarthVB6.zip" For Binary As 1 ReDim bData(LOF(1) - 1) Get 1, , bData Close 1 CryptDecryptData bData, "Ключ Key" Open "C:\Temp\EarthVB6.crypt" For Binary As 1 Put 1, , bData Close 1 ' // Дешифрование Open "C:\temp\EarthVB6.crypt" For Binary As 1 ReDim bData(LOF(1) - 1) Get 1, , bData Close 1 CryptDecryptData bData, "Ключ Key" Open "C:\Temp\EarthVB6.zip" For Binary As 1 Put 1, , bData Close 1 End Sub Private Sub CryptDecryptData( _ ByRef bData() As Byte, _ ByRef sKey As String) Dim bKey() As Byte Dim lIndex As Long Dim lKeySize As Long If Len(sKey) <= 0 Then Exit Sub bKey = sKey: lKeySize = (UBound(bKey) - LBound(bData)) + 1 For lIndex = LBound(bData) To UBound(bData) bData(lIndex) = bData(lIndex) Xor bKey(lIndex Mod lKeySize) Next End Sub |