Собираем URL

[Shouldercannon]

Есть функция, которая собирает URL перебирая все символы в строке

function GetUrl(txt: String): String;
var
  I: Integer;
  Passed: Boolean;
begin
  Result := '';

  for I := 1 to Length(txt) do
  begin
    Passed := False;
    if not Passed then if ((Ord(txt[I]) >= 33) and (Ord(txt[I]) <= 47)) then Passed := True; // ! - /
    if not Passed then if ((Ord(txt[I]) >= 58) and (Ord(txt[I]) <= 64)) then Passed := True; // : - @
    if not Passed then if ((Ord(txt[I]) >= 91) and (Ord(txt[I]) <= 96)) then Passed := True; // [ - `
    if not Passed then if ((Ord(txt[I]) >= 123) and (Ord(txt[I]) <= 126)) then Passed := True; // { - ~
    if not Passed then if ((Ord(txt[I]) >= 48) and (Ord(txt[I]) <= 57)) then Passed := True; // 0 - 9
    if not Passed then if ((Ord(txt[I]) >= 65) and (Ord(txt[I]) <= 90)) then Passed := True; // A - Z
    if not Passed then if ((Ord(txt[I]) >= 97) and (Ord(txt[I]) <= 122)) then Passed := True; // a - z
    if not Passed then if ((Ord(txt[I]) >= 192) and (Ord(txt[I]) <= 223)) then Passed := True; // А - Я
    if not Passed then if ((Ord(txt[I]) >= 224) and (Ord(txt[I]) <= 255)) then Passed := True; // а - я
    if Passed then Result := Result + txt[I] else Break;
  end;
end;

Так как это делается в Delphi XE10, то сразу возникает проблема с кириллицей. В данном случае символы кодировки ASCII от а до я (224 - 255) и от А до Я (192 - 223) не совпадают. От а до я (1072 - 1103) и от А до Я (1040 - 1071). ё - 1105 и Ё - 1025. Как поправить функцию, чтобы Delphi получал Ord кириллицы по таблице

Это просто пример, который работает верно, но как его применить к функции?

procedure TForm5.Button1Click(Sender: TObject);
var
  A: AnsiChar;
begin
  A := 'а';
  ShowMessage('а = ' + IntToStr(Ord(A)));
end;

[Пепел Феникса]

замените свои магические цифра на коды символа:
33=Ord('!')
и тп

[Аватар]

Не считая магических цифирей всю ту конструкцию можно заменить одной командой:

  Passed:=((Ord(txt[I]) >= 33) and (Ord(txt[I]) <= 47)) or
          ((Ord(txt[I]) >= 58) and (Ord(txt[I]) <= 64)) or
          ((Ord(txt[I]) >= 91) and (Ord(txt[I]) <= 96)) or
          ((Ord(txt[I]) >= 123) and (Ord(txt[I]) <= 126)) or и т.д.

или IN использовать вместо двух сравнений. И Ord(txt[I]) вычислить только один раз. И вообще можно без ord обойтись

[Shouldercannon]

Сообщение от Аватар

Не считая магических цифирей всю ту конструкцию можно заменить одной командой:

  Passed:=((Ord(txt[I]) >= 33) and (Ord(txt[I]) <= 47)) or
          ((Ord(txt[I]) >= 58) and (Ord(txt[I]) <= 64)) or
          ((Ord(txt[I]) >= 91) and (Ord(txt[I]) <= 96)) or
          ((Ord(txt[I]) >= 123) and (Ord(txt[I]) <= 126)) or и т.д.

или IN использовать вместо двух сравнений. И Ord(txt[I]) вычислить только один раз. И вообще можно без ord обойтись

Можете набросать часть варианта без Ord?

[Аватар]

txt[I] in ['a'..'z','0','>']

[Shouldercannon]

function GetUrl(txt: String): String;
var
  I: Integer;
  Passed: Boolean;
begin
  Result := '';

  for I := 1 to Length(txt) do
  begin
    Passed := False;
    if not Passed then if (AnsiChar(txt[I]) in ['!', '"', '#', '$', '%', '&', '''', '(', ')', '*', '+', ',', '-', '.', '/', ':', ';', '<', '=', '>', '?', '@', '[', ']', '^', '_', '`', '{', '|', '}', '~']) then Passed := True;
    if not Passed then if (AnsiChar(txt[I]) in ['0'..'9', 'a'..'z', 'A'..'Z', 'а'..'я', 'А'..'Я']) then Passed := True;
    if Passed then Result := Result + txt[I] else Break;
  end;
end;

procedure TForm5.Button1Click(Sender: TObject);
var
  s: String;
begin
//  s := 'ya.ru';
//  s := 'abcdefghijklmnopqrstuvwxyz';
//  s := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
//  s := 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
//  s := 'АБВГДЕЁЗЖИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
//  s := '0123456789';
  Edit2.Text := GetUrl(Edit1.Text);
  Self.Caption := IntToStr(Length(Edit2.Text));
end;

Сначала была проблема с буквой ё, всё что после неё просто отрезалось. Добавил эту букву и всё стало норм, но потом убрал и опять всё норм. Но теперь кириллица в верхнем регистре выводится на половину - СТУФХЦЧШЩЪЫЬЭЮЯ. Если есть любая буква кириллицы в верхнем регистре перед С, то в поле ничего не выведется, при этом кириллица в нижнем регистре и всё остальное не мешают выводу.

[Аватар]

WideCharToMultiByte

[northener]

Сообщение от Аватар

txt[I] in ['a'..'z','0','>']

Какой in в юникодной версии Дельфи для национальных кодировок?

[Shouldercannon]

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

Какой in в юникодной версии Дельфи для национальных кодировок?

Какие будут предложения?

[Pavia]

const
 PS:WideChar=#$2029;
 LS:WideChar=#$2028;
 TB:WideChar=#09;
 NL:String=#13#10;
...
  
function IsAlfa(const ch:WideChar):Boolean;
begin
Result:=(('А'<=Ch) and (CH<='Я') ) or (Ch='Ё') or
        (('а'<=Ch) and (CH<='я') ) or (Ch='ё') or
        (('A'<=Ch) and (CH<='Z') ) or
        (('a'<=Ch) and (CH<='z') );
end;

function isUpAlfa(const ch:WideChar):Boolean;
begin
Result:=(('А'<=Ch) and (CH<='Я') ) or (Ch='Ё') or
        (('A'<=Ch) and (CH<='Z') );
end;


function IsWordAlfa(const ch:WideChar):Boolean;
begin
Result:=IsAlfa(ch);
result:=Result or ('_'=Ch) or ('-'=Ch) or ('¬'=Ch);
end;

function IsNumber(const ch:WideChar):Boolean;
begin
Result:=CharInSet(Ch, ['0'..'9']);
end;

function IsNewLineChar(const ch:WideChar):Boolean;
begin
Result:=CharInSet(Ch, [#10, #13]);
Result:= Result or (Ch=LS) or (Ch=PS);
end;

function IsSpace(const ch:WideChar):Boolean;
begin
Result:=CharInSet(Ch, [#9, #10, #11, #12, #13, #32]);
Result:= Result or IsNewLineChar(ch);
end;

function IsPunctuation(const ch:WideChar):Boolean;
begin
Result:=CharInSet(Ch, ['!', '"', '#', '$', '%', '&', '''', '(', ')', '*',
                       '+', ',', '-', '.', '/', ':', ';', '<', '=', '>',
                       '?', '@', '[', '\', ']', '^', '`', '{', '|', '}',
                       '~']);

end;

function IsOther(ch:WideChar):Boolean;
begin
Result:=Not (IsNumber(ch) or IsWordAlfa(ch) or IsSpace(ch) or IsPunctuation(ch));
end;

function IsUri_gen_delims(ch:WideChar):Boolean;
begin
Result:=CharInSet(Ch, [':', '/', '?', '#', '[', ']', '@']);
end;

function IsUri_sub_delims(ch:WideChar):Boolean;
begin
Result:=CharInSet(Ch, ['!', '$', '''', '(', ')', '*', '+', ',', ';', '=']);
end;

function IsUri_reserved(ch:WideChar):Boolean;
begin
Result:=IsUri_gen_delims(ch) or IsUri_sub_delims(ch);
end;

function IsUri_unreserved(ch:WideChar):Boolean;
begin
Result:=IsAlfa(Ch) or IsNumber(Ch);
Result:=Result or CharInSet(Ch, ['-', '.', '_', '~']);
end;

function IsUriChar(ch:WideChar):Boolean;
begin
Result:=IsUri_unreserved(Ch) or
        CharInSet(Ch,['%', ';', '?', ':', '@', '&', '=', '+', '$', ',', '/']);
end;