На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! Правила раздела Visual Basic: Общие вопросы
Здесь обсуждаются вопросы по языку Visual Basic 1-6 (а так же по схожим языкам, как, например, PowerBASIC).
Вопросы по Visual Basic .NET (это который входит в состав Visual Studio 2002/2003/2005/2008+, для тех, кто не в курсе) обсуждаются в разделе .NET.

Обратите внимание:
1. Прежде чем начать новую тему или отправить сообщение, убедитесь, что Вы не нарушаете правил форума!
2. Обязательно воспользуйтесь поиском. Возможно, Ваш вопрос уже обсуждали. Полезные ссылки приведены ниже.
3. Темы с просьбой выполнить какую-либо работу за автора в этом разделе не обсуждаются. Студенты, вам сюда: ПОМОЩЬ СТУДЕНТАМ!
4. Используйте теги [ code=vba ] ...текст программы... [ /code ] для выделения текста программы подсветкой.
5. Помните, здесь телепатов нет. Формулируйте свой вопрос максимально грамотно и чётко: Как правильно задавать вопросы
6. Запрещено отвечать в темы месячной (и более) давности, без веских на то причин.

Полезные ссылки:
user posted image FAQ Сайта user posted image FAQ Раздела user posted image Кладовка user posted image Наши Исходники user posted image API-Guide user posted image Поиск по Разделу user posted image MSDN Library Online user posted image Google

Ваше мнение о модераторах: user posted image SCINER, user posted image B.V.
Модераторы: SCINER, B.V.
  
> Лишний байт (пробел) при записи файла в двоичном доступе , команда PUT ведёт себя странно
    Здравствуйте!
    Нашёл хороший пример по шифрованию файлов.
    Всё бы хорошо, но при дешифровке появляется лишний байт в файле в виде пробела.
    Не могу никак понять, в чём дело.

    Единственное, что опытным путём удалось установить, что эта операция перед запись файла позволяет избежать записи лишнего пробела, но это не решение.
    ExpandedWrap disabled
      FN2 = FreeFile
      Open F_Name For Output As #FN2
      Close #FN2


    Нужно по существу решить задачу.
    Самое главное, когда замеряешь длину переменной перед записью в файл, то длина нормальная, а после команды PUT на 1 байт становится больше.
    Всю ночь сегодня просидел, так и не понял ничего.
    С чем это может быть связано?
    Прикреплённый файлПрикреплённый файлFileBin.zip (48,75 Кбайт, скачиваний: 151)
    Сообщение отредактировано: salieri -
      Код из аттача не смотрел, но не твой ли это случай Убрать лишний [NUL], дописываемый в конец файла. ?
        B.V., я думаю, что нет, потому что у меня типы данных как Byte, так и String - одинаково не работают.
        Замеряю Ubound байтового массива до и после сохранения - всё хорошо, а по факту записывается на 1 байт больше.
          Решение подсказали в другом месте.
          Большое спасибо тем, кто помог. :)
          Один и тот же код работает как на закодирование, так и на раскодирование.

          ExpandedWrap disabled
            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
            Прикрепляю на всякий пожарный скрипты, которые до этого были у меня в коллекции:

            ExpandedWrap disabled
              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 постарался:

            ExpandedWrap disabled
              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
              Написали код мне, который более рационален предыдущим.

              Алгоритм (скрипт) шифрования XOR:
              ExpandedWrap disabled
                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
              Сообщение отредактировано: salieri -
              0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
              0 пользователей:


              Рейтинг@Mail.ru
              [ Script execution time: 0,0289 ]   [ 18 queries used ]   [ Generated: 28.03.24, 11:28 GMT ]