URL кодирование строки
Автор: Dimka Maslov
WEB-сайт: http://delphibase.endimus.com
{ **** 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;
|