Преобразование string в Bin и обратно. Русский текст. Пр.облема при Bin=>Str

@Человек_Борща · Регистрация: 21.06.2012

Студворк — интернет-сервис помощи студентам

Доброго времени суток!

Пишу клиент-серверное приложение.
Есть смысл кодировать информацию в бинарный вид.

Написал 2 функции:

Delphi
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
function Str2Bin(aStr: string): string;
type
  TBitsPerChar = 1..8;
var
  iChar, iBit: Integer;
  s: string;
begin
  s := aStr;
  for iChar := 1 to Length(s) do
    for iBit := High(TBitsPerChar) downto Low(TBitsPerChar) do
      Result := Result + IntToStr((Byte(s[iChar]) shr (iBit - 1)) and 1)[1];
end;
 
function Bin2Str(aStr: string): string;
var
  s: string;
  iChar,i: Integer;
  rs: string;
begin
  iChar:=0;
  i:=0;
  result := '';
  s := aStr;
  while Length(s) > 0 do
  begin
  iChar:=0; //re init
    if Length(s) < 8 then
      Break;
    for i := 1 to 7 do
    begin
      iChar := (iChar + ord(s[i]) - 48) shl 1;
    end;
    rs := rs + Chr(iChar);
    Delete(s, 1, 7);
  end;
  Result := rs;
end;

Проблема №1:
F => 01000110
01000110 => F

Hello => 0100100001100101011011000110110001101111 0000110100001010
0100100001100101011011000110110001101111 0000110100001010 => H2ZЊЖx4

Непорядок. Почему так?

Проблема №2:
Не может раскодировать русские символы.
Скармиливаю ему А
Возврашает О

Что можете посоветовать?

P.S. Пишу в Delphi 7. Есть и юникодная, но заказчику нужно именно в delphi 7 проект сделать.

Добавлено через 5 часов 58 минут
Проблему решил сдвигом iChar вправо на 1 бит, после выполнения цикла, и передачей символа в строку.

@Mawrat · 24.06.2012, 10:32

Ещё предложу такой код. Он заточен на высокую скорость обработки:

Delphi
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
//На кодировочной странице CP1251 (Win-1251):
//"ABCDEF" -> "010000010100001001000011010001000100010101000110".
function StrToBinStr(const aStr : AnsiString) : AnsiString;
const
  BitsInByte = 8;
var
  i, j, k, Len : Integer;
  Num : Byte;
begin
  Len := Length(aStr);
  SetLength(Result, Len * BitsInByte);
  k := 0;
  for i := 1 to Len do begin
    Num := Byte(aStr[i]);
    for j := 1 to BitsInByte do begin
      Inc(k);
      case Num and $80 of
        0   : Result[k] := '0';
        $80 : Result[k] := '1'; //$80(16) = 10000000(2)
      end;
      Num := Num shl 1;
    end;
  end;
end;
 
//На кодировочной странице CP1251 (Win-1251):
//"010000010100001001000011010001000100010101000110" -> "ABCDEF".
function BinStrToStr(const aBinStr : AnsiString) : AnsiString;
const
  BitsInByte = 8;
var
  i, j, Len : Integer;
  Num, Weight : Byte;
begin
  Len := Length(aBinStr);
  if Len mod BitsInByte = 0 then
    SetLength(Result, Len div BitsInByte)
  else
    SetLength(Result, Len div BitsInByte + 1)
  ;
  j := 0;
  Num := 0;
  Weight := $80; //Вес старшего разряда в байте.
  for i := 1 to Len do begin
    if aBinStr[i] = '1' then Inc(Num, Weight);
    Weight := Weight div 2; //Вес следующего младшего разряда.
    if (Weight = 0) or (i = Len) then begin
      Inc(j);
      Result[j] := AnsiChar(Num);
      Num := 0;
      Weight := $80;
    end;
  end;
end;

Скорость можно ещё увеличить, если добавить директиву отключения проверки границ диапазонов:{$R-}/{$R+}

murderer · 27.06.2012, 12:57

Для повышения скорости можно использовать таблицы

Pascal
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
{$APPTYPE CONSOLE}
const
Str2Bin: array[0..255,0..7] of char =('00000000','00000001','00000010','00000011','00000100','00000101','00000110','00000111',
                                      '00001000','00001001','00001010','00001011','00001100','00001101','00001110','00001111',
                                      '00010000','00010001','00010010','00010011','00010100','00010101','00010110','00010111',
                                      '00011000','00011001','00011010','00011011','00011100','00011101','00011110','00011111',
                                      '00100000','00100001','00100010','00100011','00100100','00100101','00100110','00100111',
                                      '00101000','00101001','00101010','00101011','00101100','00101101','00101110','00101111',
                                      '00110000','00110001','00110010','00110011','00110100','00110101','00110110','00110111',
                                      '00111000','00111001','00111010','00111011','00111100','00111101','00111110','00111111',
                                      '01000000','01000001','01000010','01000011','01000100','01000101','01000110','01000111',
                                      '01001000','01001001','01001010','01001011','01001100','01001101','01001110','01001111',
                                      '01010000','01010001','01010010','01010011','01010100','01010101','01010110','01010111',
                                      '01011000','01011001','01011010','01011011','01011100','01011101','01011110','01011111',
                                      '01100000','01100001','01100010','01100011','01100100','01100101','01100110','01100111',
                                      '01101000','01101001','01101010','01101011','01101100','01101101','01101110','01101111',
                                      '01110000','01110001','01110010','01110011','01110100','01110101','01110110','01110111',
                                      '01111000','01111001','01111010','01111011','01111100','01111101','01111110','01111111',
                                      '10000000','10000001','10000010','10000011','10000100','10000101','10000110','10000111',
                                      '10001000','10001001','10001010','10001011','10001100','10001101','10001110','10001111',
                                      '10010000','10010001','10010010','10010011','10010100','10010101','10010110','10010111',
                                      '10011000','10011001','10011010','10011011','10011100','10011101','10011110','10011111',
                                      '10100000','10100001','10100010','10100011','10100100','10100101','10100110','10100111',
                                      '10101000','10101001','10101010','10101011','10101100','10101101','10101110','10101111',
                                      '10110000','10110001','10110010','10110011','10110100','10110101','10110110','10110111',
                                      '10111000','10111001','10111010','10111011','10111100','10111101','10111110','10111111',
                                      '11000000','11000001','11000010','11000011','11000100','11000101','11000110','11000111',
                                      '11001000','11001001','11001010','11001011','11001100','11001101','11001110','11001111',
                                      '11010000','11010001','11010010','11010011','11010100','11010101','11010110','11010111',
                                      '11011000','11011001','11011010','11011011','11011100','11011101','11011110','11011111',
                                      '11100000','11100001','11100010','11100011','11100100','11100101','11100110','11100111',
                                      '11101000','11101001','11101010','11101011','11101100','11101101','11101110','11101111',
                                      '11110000','11110001','11110010','11110011','11110100','11110101','11110110','11110111',
                                      '11111000','11111001','11111010','11111011','11111100','11111101','11111110','11111111');
procedure StrToBinStr(InStr,OutStr: PAnsiChar);register;assembler;
asm
  jmp @2
  @1:movzx ecx,byte[eax]
     movq  mm0,qword[Str2Bin+ecx*8]
     movq  [edx],mm0
     inc   eax
     add   edx,8
  @2:cmp   byte[eax],0
  jnz @1
  emms
  mov byte[edx],0
end;
procedure BinStrToStr(InStr,OutStr: PAnsiChar);register;assembler;
const
 reverse: array[0..255] of byte=(0,128,64,192,32,160,96,224,16,144,80,208,48,176,112,240,8,136,72,200,40,168,104,232,24,152,88,216,56,184,120,248,4,132,68,196,36,164,100,228,20,148,84,212,52,180,116,244,12,140,76,204,44,172,108,236,28,156,92,220,60,188,124,252,2,130,66,194,34,162,98,226,18,146,82,210,50,178,114,242,10,138,74,202,42,170,106,234,26,154,90,218,58,186,122,250,6,134,70,198,38,166,102,230,22,150,86,214,54,182,118,246,14,142,78,206,46,174,110,238,30,158,94,222,62,190,126,254,1,129,65,193,33,161,97,225,17,145,81,209,49,177,113,241,9,137,73,201,41,169,105,233,25,153,89,217,57,185,121,249,5,133,69,197,37,165,101,229,21,149,85,213,53,181,117,245,13,141,77,205,45,173,109,237,29,157,93,221,61,189,125,253,3,131,67,195,35,163,99,227,19,147,83,211,51,179,115,243,11,139,75,203,43,171,107,235,27,155,91,219,59,187,123,251,7,135,71,199,39,167,103,231,23,151,87,215,55,183,119,247,15,143,79,207,47,175,111,239,31,159,95,223,63,191,127,255);
asm
  jmp @2
  @1:movq     mm0,[eax]
     pcmpeqb  mm0,qword[Str2Bin+255*8]
     pmovmskb ecx,mm0
     mov      ecx,dword[reverse+ecx]
     mov      [edx],cl
     add      eax,8
     inc      edx
  @2:cmp      byte[eax],0
  jnz @1
  emms
  mov byte[edx],0
end;
var
Bin: array[0..48] of AnsiChar;
Str: array[0..5] of AnsiChar;
begin
StrToBinStr('ABCDEF',@Bin);
writeln(Bin);
BinStrToStr('010000010100001001000011010001000100010101000110',@Str);
writeln(Str);
readln;
end.

Новые блоги и статьи Все статьи Все блоги /
AkelPad-скрипты, структуры, и немного лирики.. testuser2 05.04.2026 Такая программа, как AkelPad существует уже давно, и также давно существуют скрипты под нее. Тем не менее, прога живет, периодически что-то не спеша дополняется, улучшается. Что меня в первую очередь. . .	Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .
Программный контроль заполнения реквизитов табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: 1. Реализовать контроль заполнения реквизита. . .	wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .	Вывод данных в справочнике через динамический список Maks 01.04.2026 Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .