Delphi7 и (Windows-1251, UTF-16) как сдружить?

[Ship_1]

Vapaamies, спасибо за примеры, но что-то не то у меня получается (код скопировал полностью). Пример с "Фрагмент.txt".
Программа выдаёт

1П- К \Ж68731--5-3.3-1ЖК1-И_мз . 42(_2212_10 6\)68731--5-3.3-1ЖК1-Л_9.= ШДЛ си т

.
а 2cyr (исходная кодировка: Windows-1251; отображается как: UTF-16) декодирует как

0-15-Р\М-8\04. ПП1 - КЖ\8637-15-3-3.1-КЖ-1_Изм. 4 (22_12_2016 )\8637-15-3-3.1-КЖ-1_Л.9 =ДШ Лист

А у Вас что получалось?

[Vapaamies]

У меня так же. Поменяйте первое условие в while на (P^ < #$80). Раскодируемый кусок увеличится, но совпадения не будет. 2cyr наверняка использует какой-то интеллектуальный алгоритм, а я просто подсунул данные без всякого раскодирования. Как они там лежат -- так и выводятся. Фиг знает, из-за чего перестановка. Смотрите отладчиком коды символов в Source (UTF-16), сверяйтесь по стандарту Unicode, что они обозначают. Моя задача -- показать путь, далее -- самостоятельно.

[Ship_1]

Я правильно понимаю, что у Вас просто берётся символ и по определённому алгоритму меняется? Меня смущает, что, например, 1 в закодированной строке совпадает с разными символами...

[Vapaamies]

Сообщение от Ship_1

у Вас просто берётся символ и по определённому алгоритму меняется?

Никакого алгоритма нет. Исходя из опыта работы с кодировками, я основывался на допущении, что у вас строка в windows-1251 программно всунута в UTF-16. Для раскодирования надо проделать обратную операцию.

Поскольку исходник -- в UTF-8 (сработало автоопределение в Far и PSPad), вначале я раскодирую UTF-8 в UTF-16, а потом интерпретирую эти данные как 1251 безо всякого перекодирования -- просто через указатель на те же данные.

Походу оказалось, что ваш UTF-16 -- Big Endian. Добавил перестановку байт, получилось:

procedure SwapWideCharBytes(Source, Dest: PWideChar; Count: Integer);
asm
        TEST ECX, ECX
        JZ @@exit

        PUSH EBX

        PUSH ECX
        SHR ECX, 1
@@repeat2:
        MOV EBX, [EAX]
        BSWAP EBX
        ROL EBX, 16
        MOV [EDX], EBX
        LEA EAX, [EAX+4]
        LEA EDX, [EDX+4]
        LOOP @@repeat2

        POP ECX
        AND ECX, 1
        JZ @@complete
        MOV BX, [EAX]
        XCHG BL, BH
        MOV [EDX], BX
@@complete:
        POP EBX
@@exit:
end;

procedure TMainForm.Button3Click(Sender: TObject);
var
  Source: WideString;
  P, Head, Tail, Limit: PWideChar;
  S, Decoded: AnsiString;
  I: Integer;
begin
  with TFileStream.Create('T:\Фрагмент.txt', fmOpenRead or fmShareDenyWrite) do
  try
    SetLength(S, Size);
    ReadBuffer(S[1], Length(S));
  finally
    Free;
  end;
  Source := Utf8Decode(S);
  P := Pointer(Source);
  if P <> nil then
  begin
    Limit := P + Length(Source);
    while (P^ < #$80) and (P < Limit) do
      Inc(P);
    if P < Limit then
    begin
      Head := P;
      Inc(P);
      while (P^ <> '<') and (P < Limit) do // проверяем до открывающего <font>
        Inc(P);
      if P < Limit then
      begin
        Tail := P;
        SwapWideCharBytes(Head, Head, Tail - Head);
        SetString(Decoded, PAnsiChar(Head), (Tail - Head) * SizeOf(WideChar));
        ShowMessage(Decoded);
      end;
    end;
  end;
end;

[Ship_1]

Даже не слышал про такое... Спасибо большое! Здорово!
Решил воспользоватся Яндексом, чтоб хоть узнать что это такое. Увидел ссылку на НОУ ИНТУИТ. Решил глянуть где там такое объясняют. "Ассемблер в Linux для программистов на C".
Но, кажется, смысл я уловил. Это когда байты задом наперёд идут?
А как-нибудь можно программно понять: стандартная кодировка или такая?..

[Vapaamies]

Сообщение от Ship_1

Увидел ссылку на НОУ ИНТУИТ. Решил глянуть где там такое объясняют. "Ассемблер в Linux для программистов на C".

Ну, там ассемблер и тут ассемблер, что в этом странного? Раз у вас внезапно Big Endian -- сразу в Linux посылать, что ли? На самом деле код поворота байт можно написать и на Паскале, но у меня уже была готовая ассемблерная функция, так что легче оказалось ее скопипастить и напугать вопрошающего.

Сообщение от Ship_1

А как-нибудь можно программно понять: стандартная кодировка или такая?..

У вас вырожденный случай, написал для него парочку функций IsBigEndian. Передается исходная строка, набор контрольных символов, по которым будет палиться разворот (это должны быть знаки препинания), и числовое значение порога срабатывания, после которого поворот можно считать определенным.

Попутно решил проблему с CodeText.txt. Оказалось, что читал его не полностью.

Это окончательный вариант кода. Задача решена, больше исправлений не будет.

procedure SwapWideCharBytes(Source, Dest: PWideChar; Count: Integer);
asm
        TEST ECX, ECX
        JZ @@exit

        PUSH EBX

        PUSH ECX
        SHR ECX, 1
@@repeat2:
        MOV EBX, [EAX]
        BSWAP EBX
        ROL EBX, 16
        MOV [EDX], EBX
        LEA EAX, [EAX+4]
        LEA EDX, [EDX+4]
        LOOP @@repeat2

        POP ECX
        AND ECX, 1
        JZ @@complete
        MOV BX, [EAX]
        XCHG BL, BH
        MOV [EDX], BX
@@complete:
        POP EBX
@@exit:
end;

type
  TControlSet = set of #$0..#$7F;

function IsBigEndian(Source: PWideChar; Count: Integer; ControlSet: TControlSet;
  Threshold: Integer): Boolean; overload;
var
  Limit: PWideChar;
  BigEndian: Integer;
  B: Word;
begin
  if Source <> nil then
  begin
    BigEndian := 0;
    Limit := Source + Count;
    while Source < Limit do
    begin
      B := Swap(Word(Source^)) and $FF;
      Inc(BigEndian, Byte((B < $80) and (Char(B) in ControlSet)));
      if BigEndian >= Threshold then
      begin
        Result := True;
        Exit;
      end;
      Inc(Source);
    end;
  end;
  Result := False;
end;

function IsBigEndian(Source: WideString; ControlSet: TControlSet;
  Threshold: Integer): Boolean; overload;
begin
  Result := IsBigEndian(Pointer(Source), Length(Source), ControlSet, Threshold);
end;

procedure TMainForm.Button3Click(Sender: TObject);
var
  Source: WideString;
  P, Head, Tail, Limit: PWideChar;
  S, Decoded: AnsiString;
  I: Integer;
begin
  with TFileStream.Create('T:\Фрагмент.txt', fmOpenRead or fmShareDenyWrite) do
  try
    SetLength(S, Size);
    ReadBuffer(S[1], Length(S));
  finally
    Free;
  end;
  Source := Utf8Decode(S);
  P := Pointer(Source);
  if P <> nil then
  begin
    Limit := P + Length(Source);
    while (P^ < #$80) and (P < Limit) do
      Inc(P);
    if P < Limit then
    begin
      Head := P;
      Inc(P);
      while (P^ <> '<') and (P < Limit) do // берем до начала </font>
        Inc(P);
      if P < Limit then
      begin
        Tail := P;
        if IsBigEndian(Head, Tail - Head, [' ', ',', '.', '\', '(', ')', '_'], 3) then
          SwapWideCharBytes(Head, Head, Tail - Head);
        SetString(Decoded, PAnsiChar(Head), (Tail - Head) * SizeOf(WideChar));
        ShowMessage(Decoded);
      end;
    end;
  end;
end;

procedure TMainForm.btFileClick(Sender: TObject);
var
  Source: WideString;
  P, Head, Tail, Limit: PWideChar;
  S, Decoded: AnsiString;
  I: Integer;
begin
  with TFileStream.Create('T:\CodeText.txt', fmOpenRead or fmShareDenyWrite) do
  try
    SetLength(Source, Size div SizeOf(WideChar));
    ReadBuffer(Source[1], Length(Source) * SizeOf(WideChar));
  finally
    Free;
  end;
  P := Pointer(Source);
  if P <> nil then
  begin
    Inc(P);
    Limit := P + Length(Source);
    Head := P;
    while P < Limit do
    begin
      while (P^ <> #13) and (P^ <> #10) and (P < Limit) do
        Inc(P);
      Tail := P;
      if IsBigEndian(Head, Tail - Head, [' ', ',', '.', '\', '(', ')', '_'], 3) then
      begin
        SwapWideCharBytes(Head, Head, Tail - Head);
        SetString(Decoded, PAnsiChar(Head), (Tail - Head) * SizeOf(WideChar));
      end
      else
      begin
        SetLength(Decoded, Tail - Head);
        SetLength(Decoded, WideCharToMultiByte(CP_ACP, 0, Head, Tail - Head, Pointer(Decoded), Length(Decoded), nil, nil));
      end;
      ShowMessage(Decoded);
      if (P^ = #13) and (P[1] = #10) then
        Inc(P);
      Inc(P);
      Head := P;
    end;
  end;
end;