{ **** UBPFD *********** by delphibase.endimus.com ****
>> URL кодирование строки

Функция производит так назваемое URL кодирование строк для использования
в http запросах. Т.е. все алфавитно-цифровые символы и знак подчёикивания
'_' остаются неизменными, пробел заменяется на '+', а все остальные символы
на знак процента '%' с двумя шестнадцатеричными цифрами.

Зависимости: Windows
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 27 мая 2002 г.
***************************************************** }

function UrlEncode(Str: string): string;

 function CharToHex(Ch: Char): Integer;
 asm
 and eax, 0FFh
 mov ah, al
 shr al, 4
 and ah, 00fh
 cmp al, 00ah
 jl @@10
 sub al, 00ah
 add al, 041h
 jmp @@20
@@10:
 add al, 030h
@@20:
 cmp ah, 00ah
 jl @@30
 sub ah, 00ah
 add ah, 041h
 jmp @@40
@@30:
 add ah, 030h
@@40:
 shl eax, 8
 mov al, '%'
 end;

var
 i, Len: Integer;
 Ch: Char;
 N: Integer;
 P: PChar;
begin
 Result := '';
 Len := Length(Str);
 P := PChar(@N);
 for i := 1 to Len do
 begin
 Ch := Str[i];
 if Ch in ['0'..'9', 'A'..'Z', 'a'..'z', '_'] then
 Result := Result + Ch
 else
 begin
 if Ch = ' ' then
 Result := Result + '+'
 else
 begin
 N := CharToHex(Ch);
 Result := Result + P;
 end;
 end;
 end;
end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
 S: string;
begin
 S := UrlEncode('Delphi World');
 ShellExecute(Handle, 'open',
 PChar('http://www.yandex.ru/yandsearch?text=' + S), '', '', SW_SHOWNORMAL);
end;

{ **** UBPFD *********** by delphibase.endimus.com ****
>> URL декодирование строки

Функция выполняет URL декодирование строки, заменяя все подстроки вида
'%HH', где 'HH' - шестнадцатеричные цифры, на соответствующие символы.

Зависимости: Windows
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 27 мая 2002 г.
***************************************************** }

function UrlDecode(Str: string): string;

 function HexToChar(W: word): Char;
 asm
 cmp ah, 030h
 jl @@error
 cmp ah, 039h
 jg @@10
 sub ah, 30h
 jmp @@30
@@10:
 cmp ah, 041h
 jl @@error
 cmp ah, 046h
 jg @@20
 sub ah, 041h
 add ah, 00Ah
 jmp @@30
@@20:
 cmp ah, 061h
 jl @@error
 cmp al, 066h
 jg @@error
 sub ah, 061h
 add ah, 00Ah
@@30:
 cmp al, 030h
 jl @@error
 cmp al, 039h
 jg @@40
 sub al, 030h
 jmp @@60
@@40:
 cmp al, 041h
 jl @@error
 cmp al, 046h
 jg @@50
 sub al, 041h
 add al, 00Ah
 jmp @@60
@@50:
 cmp al, 061h
 jl @@error
 cmp al, 066h
 jg @@error
 sub al, 061h
 add al, 00Ah
@@60:
 shl al, 4
 or al, ah
 ret
@@error:
 xor al, al
 end;

 function GetCh(P: PChar; var Ch: Char): Char;
 begin
 Ch := P^;
 Result := Ch;
 end;

var
 P: PChar;
 Ch: Char;
begin
 Result := '';
 P := @Str[1];
 while GetCh(P, Ch) <> #0 do
 begin
 case Ch of
 '+': Result := Result + ' ';
 '%':
 begin
 Inc(P);
 Result := Result + HexToChar(PWord(P)^);
 Inc(P);
 end;
 else
 Result := Result + Ch;
 end;
 Inc(P);
 end;
end;