функция декодированая UTF8URL в ANSI - Работа с сетью в Delphi

fatklass · 05.04.2017, 10:51

Добрый день, появилась необходимость. Декодировать UTF8 url в ANSI текст.
Функция ниже кодирует русский текст в urlutf8 нужно обратное действие, из получившейся строки получить текст
"%d0%bf%d1%80%d0%b8%d0%b2%d0%b5%d1% 82"
Получить "привет".
В делфи ноль, мб кто сможет из этой функции сделать обратную. Заранее благодарен, с меня тысячи благодарностей

Код HTML:

uses sysutils,classes;
function fnstUrlEncodeUTF8(stInput : widestring) : string;
  const
    hex : array[0..255] of string = (
     '%00', '%01', '%02', '%03', '%04', '%05', '%06', '%07',
     '%08', '%09', '%0a', '%0b', '%0c', '%0d', '%0e', '%0f',
     '%10', '%11', '%12', '%13', '%14', '%15', '%16', '%17',
     '%18', '%19', '%1a', '%1b', '%1c', '%1d', '%1e', '%1f',
     '%20', '%21', '%22', '%23', '%24', '%25', '%26', '%27',
     '%28', '%29', '%2a', '%2b', '%2c', '%2d', '%2e', '%2f',
     '%30', '%31', '%32', '%33', '%34', '%35', '%36', '%37',
     '%38', '%39', '%3a', '%3b', '%3c', '%3d', '%3e', '%3f',
     '%40', '%41', '%42', '%43', '%44', '%45', '%46', '%47',
     '%48', '%49', '%4a', '%4b', '%4c', '%4d', '%4e', '%4f',
     '%50', '%51', '%52', '%53', '%54', '%55', '%56', '%57',
     '%58', '%59', '%5a', '%5b', '%5c', '%5d', '%5e', '%5f',
     '%60', '%61', '%62', '%63', '%64', '%65', '%66', '%67',
     '%68', '%69', '%6a', '%6b', '%6c', '%6d', '%6e', '%6f',
     '%70', '%71', '%72', '%73', '%74', '%75', '%76', '%77',
     '%78', '%79', '%7a', '%7b', '%7c', '%7d', '%7e', '%7f',
     '%80', '%81', '%82', '%83', '%84', '%85', '%86', '%87',
     '%88', '%89', '%8a', '%8b', '%8c', '%8d', '%8e', '%8f',
     '%90', '%91', '%92', '%93', '%94', '%95', '%96', '%97',
     '%98', '%99', '%9a', '%9b', '%9c', '%9d', '%9e', '%9f',
     '%a0', '%a1', '%a2', '%a3', '%a4', '%a5', '%a6', '%a7',
     '%a8', '%a9', '%aa', '%ab', '%ac', '%ad', '%ae', '%af',
     '%b0', '%b1', '%b2', '%b3', '%b4', '%b5', '%b6', '%b7',
     '%b8', '%b9', '%ba', '%bb', '%bc', '%bd', '%be', '%bf',
     '%c0', '%c1', '%c2', '%c3', '%c4', '%c5', '%c6', '%c7',
     '%c8', '%c9', '%ca', '%cb', '%cc', '%cd', '%ce', '%cf',
     '%d0', '%d1', '%d2', '%d3', '%d4', '%d5', '%d6', '%d7',
     '%d8', '%d9', '%da', '%db', '%dc', '%dd', '%de', '%df',
     '%e0', '%e1', '%e2', '%e3', '%e4', '%e5', '%e6', '%e7',
     '%e8', '%e9', '%ea', '%eb', '%ec', '%ed', '%ee', '%ef',
     '%f0', '%f1', '%f2', '%f3', '%f4', '%f5', '%f6', '%f7',
     '%f8', '%f9', '%fa', '%fb', '%fc', '%fd', '%fe', '%ff');
 var
   iLen,iIndex : integer;
   stEncoded : string;
   ch : widechar;
 begin
   iLen := Length(stInput);
   stEncoded := '';
   for iIndex := 1 to iLen do
   begin
     ch := stInput[iIndex];
     if (ch >= 'A') and (ch <= 'Z') then
       stEncoded := stEncoded + ch
     else if (ch >= 'a') and (ch <= 'z') then
       stEncoded := stEncoded + ch
     else if (ch >= '0') and (ch <= '9') then
       stEncoded := stEncoded + ch
     else if (ch = ' ') then
       stEncoded := stEncoded + '+'
     else if ((ch = '-') or (ch = '_') or (ch = '.') or (ch = '!') or (ch = '*')
       or (ch = '~') or (ch = '\')  or (ch = '(') or (ch = ')')) then
       stEncoded := stEncoded + ch
     else if (Ord(ch) <= $07F) then
       stEncoded := stEncoded + hex[Ord(ch)]
     else if (Ord(ch) <= $7FF) then
     begin
        stEncoded := stEncoded + hex[$c0 or (Ord(ch) shr 6)];
        stEncoded := stEncoded + hex[$80 or (Ord(ch) and $3F)];
     end
     else
     begin
        stEncoded := stEncoded + hex[$e0 or (Ord(ch) shr 12)];
        stEncoded := stEncoded + hex[$80 or ((Ord(ch) shr 6) and ($3F))];
        stEncoded := stEncoded + hex[$80 or ((Ord(ch)) and ($3F))];
     end;
   end;
   result := (stEncoded);
 end;

begin
print(fnstUrlEncodeUTF8('привет'));
end.

Serge_Bliznykov · 05.04.2017, 11:17

попробуйте такой код:

Код:

function HTTPDecode(const AStr: String): String;
var
  Sp, Rp, Cp: PChar;
  S: String;
begin
  SetLength(Result, Length(AStr));
  Sp := PChar(AStr);
  Rp := PChar(Result);
  Cp := Sp;
  try
    while Sp^ <> #0 do
    begin
      case Sp^ of
        '+': Rp^ := ' ';
        '%': begin
               // Look for an escaped % (%%) or %<hex> encoded character
               Inc(Sp);
               if Sp^ = '%' then
                 Rp^ := '%'
               else
               begin
                 Cp := Sp;
                 Inc(Sp);
                 if (Cp^ <> #0) and (Sp^ <> #0) then
                 begin
                   S := '$' + Cp^ + Sp^;
                   Rp^ := Chr(StrToInt(S));
                 end
                 else
                   ShowMessage('sErrorDecodingURLText');
               end;
             end;
      else
        Rp^ := Sp^;
      end;
      Inc(Rp);
      Inc(Sp);
    end;
  except
    on E:EConvertError do
        ShowMessage('sInvalidURLEncodedChar');
      (*raise EConvertError.CreateFmt(sInvalidURLEncodedChar,
        ['%' + Cp^ + Sp^, Cp - PChar(AStr)]) *)
  end;
  SetLength(Result, Rp - PChar(Result));
end;


procedure TForm5.Button1Click(Sender: TObject);
var sutf8 : UTF8String;
   s : AnsiString;
begin
  sutf8 := HTTPDecode('%d0%bf%d1%80%d0%b8%d0%b2%d0%b5%d1%82');
  s := Utf8ToAnsi(sutf8);
  ShowMessage(s)
end;

fatklass · 05.04.2017, 11:34

Цитата:

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

попробуйте такой код:

Код:

function HTTPDecode(const AStr: String): String;
var
  Sp, Rp, Cp: PChar;
  S: String;
begin
  SetLength(Result, Length(AStr));
  Sp := PChar(AStr);
  Rp := PChar(Result);
  Cp := Sp;
  try
    while Sp^ <> #0 do
    begin
      case Sp^ of
        '+': Rp^ := ' ';
        '%': begin
               // Look for an escaped % (%%) or %<hex> encoded character
               Inc(Sp);
               if Sp^ = '%' then
                 Rp^ := '%'
               else
               begin
                 Cp := Sp;
                 Inc(Sp);
                 if (Cp^ <> #0) and (Sp^ <> #0) then
                 begin
                   S := '$' + Cp^ + Sp^;
                   Rp^ := Chr(StrToInt(S));
                 end
                 else
                   ShowMessage('sErrorDecodingURLText');
               end;
             end;
      else
        Rp^ := Sp^;
      end;
      Inc(Rp);
      Inc(Sp);
    end;
  except
    on E:EConvertError do
        ShowMessage('sInvalidURLEncodedChar');
      (*raise EConvertError.CreateFmt(sInvalidURLEncodedChar,
        ['%' + Cp^ + Sp^, Cp - PChar(AStr)]) *)
  end;
  SetLength(Result, Rp - PChar(Result));
end;


procedure TForm5.Button1Click(Sender: TObject);
var sutf8 : UTF8String;
   s : AnsiString;
begin
  sutf8 := HTTPDecode('%d0%bf%d1%80%d0%b8%d0%b2%d0%b5%d1%82');
  s := Utf8ToAnsi(sutf8);
  ShowMessage(s)
end;

Не работает, дело в том что функция нужна для программы в которую встроен скриптовый язык, компилятор.
Там довольно обрезанная версия делфи либо очень старая, нет например Utf8ToAnsi, форм
Из рабочмх примеров декодирования нашел только этот код он как я понял еще на делфи5 писался

Serge_Bliznykov · 05.04.2017, 11:48

Цитата:

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

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

так об этом надо предупреждать.

в принципе, написать функцию, обратную вашей fnstUrlEncodeUTF8()
несложно.
но у меня пока нет на это времени.
Ждите.

Цитата:

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

нет ... форм

а формы тут при чём?!

fatklass · 05.04.2017, 13:17

Цитата:

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

так об этом надо предупреждать.

в принципе, написать функцию, обратную вашей fnstUrlEncodeUTF8()
несложно.
но у меня пока нет на это времени.
Ждите.

а формы тут при чём?!

Нашел подобное решение на http://stackoverflow.com/questions/4...phi-prior-2009

Код HTML:

const
  SrcStr = 'file://localhost/G:/test/%E6%B0%97%E3%81%BE%E3%81%90%E3%82%8C%E3%83%AD%E3%83%9E%E3%83%B3%E3%83%86%E3%82%A3%E3%83%83%E3%82%AF.mp3';

function Src2Utf8(const S: string): string;
var
  I: Integer;
  S1: string;
  B: Byte;

begin
  I:= 0;
  Result:= '';
  SetLength(S1, 3);
  S1[1]:= '$';
  while I < Length(S) do begin
    Inc(I);
    if S[I] <> Char('%') then Result:= Result + S[I]
    else begin
      Inc(I);
      S1[2]:= S[I];
      Inc(I);
      S1[3]:= S[I];
      B:= StrToInt(S1);
      Result:= Result + Char(B);
    end;
  end;
end;


procedure TForm8.Button1Click(Sender: TObject);
var
  S: WideString;
  S1: string;

begin
  S:= Utf8Decode(Src2Utf8(SrcStr));
  SetLength(S1, 4 * Length(S));  // more than enough
  FillChar(PChar(S1)^, Length(S1), 0);
  WideCharToMultiByte(932 {shift-jis codepage}, 0, PWideChar(S), Length(S),
      PChar(S1), Length(S1), nil, nil);
  S1:= PChar(S1); // to remove ending zeroes
  Label1.Caption:= S1;
end;

Взял кусок

Код HTML:

 function Src2Utf8(const S: string): string;
var
  I: Integer;
  S1: string;
  B: Byte;

begin
  I:= 0;
  Result:= '';
  SetLength(S1, 3);
  S1[1]:= '$';
  while I < Length(S) do begin
    Inc(I);
    if S[I] <> Char('%') then Result:= Result + S[I]
    else begin
      Inc(I);
      S1[2]:= S[I];
      Inc(I);
      S1[3]:= S[I];
      B:= StrToInt(S1);
      Result:= Result + Char ( B );
    end;
  end;
end;

В результате получаю кракозябры "

" Лебедев говорит что это ISO-8859-1 и переводить в UTF-8 https://www.artlebedev.ru/tools/decoder/
Вероятно надо еще сделать Utf8Decode но она у меня не поддерживается :-(

Serge_Bliznykov · 05.04.2017, 13:39

Utf8Decode это обёртка над Utf8ToUnicode().
вот, например, как это выглядит в Delphi 2006 (модуль System.pas)

Код:

function Utf8Decode(const S: UTF8String): WideString;
var
  L: Integer;
  Temp: WideString;
begin
  Result := '';
  if S = '' then Exit;
  SetLength(Temp, Length(S));

  L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PChar(S), Length(S));
  if L > 0 then
    SetLength(Temp, L-1)
  else
    Temp := '';
  Result := Temp;
end;

Код:

function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal;
var
  i, count: Cardinal;
  c: Byte;
  wc: Cardinal;
begin
  if Source = nil then
  begin
    Result := 0;
    Exit;
  end;
  Result := Cardinal(-1);
  count := 0;
  i := 0;
  if Dest <> nil then
  begin
    while (i < SourceBytes) and (count < MaxDestChars) do
    begin
      wc := Cardinal(Source[i]);
      Inc(i);
      if (wc and $80) <> 0 then
      begin
        if i >= SourceBytes then Exit;          // incomplete multibyte char
        wc := wc and $3F;
        if (wc and $20) <> 0 then
        begin
          c := Byte(Source[i]);
          Inc(i);
          if (c and $C0) <> $80 then Exit;      // malformed trail byte or out of range char
          if i >= SourceBytes then Exit;        // incomplete multibyte char
          wc := (wc shl 6) or (c and $3F);
        end;
        c := Byte(Source[i]);
        Inc(i);
        if (c and $C0) <> $80 then Exit;       // malformed trail byte

        Dest[count] := WideChar((wc shl 6) or (c and $3F));
      end
      else
        Dest[count] := WideChar(wc);
      Inc(count);
    end;
    if count >= MaxDestChars then count := MaxDestChars-1;
    Dest[count] := #0;
  end
  else
  begin
    while (i < SourceBytes) do
    begin
      c := Byte(Source[i]);
      Inc(i);
      if (c and $80) <> 0 then
      begin
        if i >= SourceBytes then Exit;          // incomplete multibyte char
        c := c and $3F;
        if (c and $20) <> 0 then
        begin
          c := Byte(Source[i]);
          Inc(i);
          if (c and $C0) <> $80 then Exit;      // malformed trail byte or out of range char
          if i >= SourceBytes then Exit;        // incomplete multibyte char
        end;
        c := Byte(Source[i]);
        Inc(i);
        if (c and $C0) <> $80 then Exit;       // malformed trail byte
      end;
      Inc(count);
    end;
  end;
  Result := count+1;
end;

но я не знаю, что у Вас за Delphi (да и Delphi ли вообще),
что поддерживается, а что - нет...

fatklass · 05.04.2017, 14:52

Цитата:

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

Utf8Decode это обёртка над Utf8ToUnicode().
вот, например, как это выглядит в Delphi 2006 (модуль System.pas)

Код:

function Utf8Decode(const S: UTF8String): WideString;
var
  L: Integer;
  Temp: WideString;
begin
  Result := '';
  if S = '' then Exit;
  SetLength(Temp, Length(S));

  L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PChar(S), Length(S));
  if L > 0 then
    SetLength(Temp, L-1)
  else
    Temp := '';
  Result := Temp;
end;

Код:

function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal;
var
  i, count: Cardinal;
  c: Byte;
  wc: Cardinal;
begin
  if Source = nil then
  begin
    Result := 0;
    Exit;
  end;
  Result := Cardinal(-1);
  count := 0;
  i := 0;
  if Dest <> nil then
  begin
    while (i < SourceBytes) and (count < MaxDestChars) do
    begin
      wc := Cardinal(Source[i]);
      Inc(i);
      if (wc and $80) <> 0 then
      begin
        if i >= SourceBytes then Exit;          // incomplete multibyte char
        wc := wc and $3F;
        if (wc and $20) <> 0 then
        begin
          c := Byte(Source[i]);
          Inc(i);
          if (c and $C0) <> $80 then Exit;      // malformed trail byte or out of range char
          if i >= SourceBytes then Exit;        // incomplete multibyte char
          wc := (wc shl 6) or (c and $3F);
        end;
        c := Byte(Source[i]);
        Inc(i);
        if (c and $C0) <> $80 then Exit;       // malformed trail byte

        Dest[count] := WideChar((wc shl 6) or (c and $3F));
      end
      else
        Dest[count] := WideChar(wc);
      Inc(count);
    end;
    if count >= MaxDestChars then count := MaxDestChars-1;
    Dest[count] := #0;
  end
  else
  begin
    while (i < SourceBytes) do
    begin
      c := Byte(Source[i]);
      Inc(i);
      if (c and $80) <> 0 then
      begin
        if i >= SourceBytes then Exit;          // incomplete multibyte char
        c := c and $3F;
        if (c and $20) <> 0 then
        begin
          c := Byte(Source[i]);
          Inc(i);
          if (c and $C0) <> $80 then Exit;      // malformed trail byte or out of range char
          if i >= SourceBytes then Exit;        // incomplete multibyte char
        end;
        c := Byte(Source[i]);
        Inc(i);
        if (c and $C0) <> $80 then Exit;       // malformed trail byte
      end;
      Inc(count);
    end;
  end;
  Result := count+1;
end;

но я не знаю, что у Вас за Delphi (да и Delphi ли вообще),
что поддерживается, а что - нет...

Undeclared identifier "Utf8ToUnicode"

Serge_Bliznykov · 05.04.2017, 15:06

Цитата:

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

Undeclared identifier "Utf8ToUnicode"

а это

Цитата:

Код:

function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal;

не забыли?

fatklass · 05.04.2017, 16:00

Цитата:

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

а это не забыли?

забыл :-(
Теперь здесь ошибка Result := Cardinal(-1);
1111 (30): Constant expression violates subrange bounds

Serge_Bliznykov · 05.04.2017, 16:30

Цитата:

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

Теперь здесь ошибка Result := Cardinal(-1);

это фокусы Delphi!

замените эту строчку на

Код:

Result := 0;

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
c++ ansi c	MorgunZ	Общие вопросы C/C++	13	13.04.2015 07:46
Перекодировать файл в UTF-8->ANSI, ANSI -> UFT-8	Человек_Борща	Общие вопросы Delphi	7	19.05.2011 18:47
Ansi в UTF-8 и наоборот UTF-8 в Ansi	Alar	Работа с сетью в Delphi	3	09.12.2010 17:02
ANSI C ...	eva.t	Помощь студентам	11	11.02.2010 23:20
ANSI	HunterMan	Win Api	2	18.04.2008 23:17