URLEncode/Decode ( 积分: 200 )

如何做到和php一样的 urlencode/decode。
我如果直接用一下代码，不行。
function urlencode(const s:string):string;
var i:integer;
begin
for i:=0 to length(s) do
if not (s in ['A'..'Z','a'..'z','-','_','.'] then
result := result + '%' + inttohex(ord(s),2) else
result := result + s;
end;

这样不好。好像在内码不是中文的系统中，比如法语，就无法转换中文成正确编码了。

此外，数值超过127的ascii字符也会自动转换成问号。
如果我事先对这些字符进行判断，然后手动转换成转义字符，如：

如何做到和php一样的 urlencode/decode。
我如果直接用一下代码，不行。
function urlencode(const s:string):string;
var i:integer;
begin
for i:=0 to length(s) do
if not (s in ['A'..'Z','a'..'z','-','_','.'] then
result := result + '%' + inttohex(ord(s),2) else
result := result + s;
end;

这样不好。好像在内码不是中文的系统中，比如法语，就无法转换中文成正确编码了。

此外，数值超过127的ascii字符也会自动转换成问号。
如果我事先对这些字符进行判断，然后手动转换成转义字符，如：

HTTPApp.HTMLEncode
HTTPApp.HTMLDecode
HTTPApp.HTTPDecode
HTTPApp.HTTPEncode

function urlencode(const s:string):string;
var i:integer;
begin
Result := '';
for I := 1 to Length(msg) do begin
if msg = ' ' then
Result := Result + '+'
else if msg in ['a'..'z', 'A'..'Z', '0'..'9'] then
Result := Result + msg
else
Result := Result + '%' + IntToHex(ord(msg), 2);
end;
试试应该可以

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence }
{ Team Coherence is Copyright 2002 by Quality Software Components }
{ }
{ For further information / comments, visit our WEB site at }
{ http://www.TeamCoherence.com }
{**********************************************************************}
{}
{ $Log: 11809: IdURI.pas
{
{ Rev 1.9 10.10.2004 13:46:00 ARybin
{ dont add default port to URI
}
{
{ Rev 1.8 2004.02.03 5:44:40 PM czhower
{ Name changes
}
{
{ Rev 1.7 2004.01.22 5:27:24 PM czhower
{ Fixed compile errors.
}
{
{ Rev 1.6 1/22/2004 4:06:56 PM SPerry
{ fixed set problems
}
{
{ Rev 1.5 10/5/2003 11:44:24 PM GGrieve
{ Use IsLeadChar
}
{
Rev 1.4 6/9/2003 9:35:58 PM BGooijen
%00 is valid now too
}
{
{ Rev 1.3 2003.05.09 10:30:16 PM czhower
}
{
{ Rev 1.2 2003.04.11 9:41:34 PM czhower
}
{
{ Rev 1.1 29/11/2002 9:56:10 AM SGrobety Version: 1.1
{ Changed URL encoding
}
{
{ Rev 1.0 21/11/2002 12:42:52 PM SGrobety Version: Indy 10
}
{
{ Rev 1.0 11/13/2002 08:04:10 AM JPMugaas
}
unit IdURI;

{Details of implementation
-------------------------
2002-Apr-14 Peter Mee
- Fixed reset. Now resets FParams as well - wasn't before.
2001-Nov Doychin Bondzhev
- Fixes in URLEncode. There is difference when encoding Path+Doc and Params
2001-Oct-17 Peter Mee
- Minor speed improvement - removed use of NormalizePath in SetURI.
- Fixed bug that was cutting off the first two chars of the host when a
username / password present.
- Fixed bug that prevented username and password being updated.
- Fixed bug that was leaving the bookmark in the document when no ? or =
parameters existed.
2001-Feb-18 Doychin Bondzhev
- Added UserName and Password to support URI's like
http://usernameassword@hostnameort/path/document#bookmark
}

interface

uses
IdException, IdGlobal;

type
TIdURIOptionalFields = (ofAuthInfo, ofBookmark);
TIdURIOptionalFieldsSet = set of TIdURIOptionalFields;

TIdURI = class
protected
FDocument: string;
FProtocol: string;
FURI: String;
FPort: string;
Fpath: string;
FHost: string;
FBookmark: string;
FUserName: string;
FPassword: string;
FParams: string;
FIPVersion: TIdIPVersion;
//
procedure SetURI(const Value: String);
function GetURI: String;
public
constructor Create(const AURI: string = ''); virtual; {Do not Localize}
function GetFullURI(const AOptionalFields: TIdURIOptionalFieldsSet = [ofAuthInfo, ofBookmark]): String;
class procedure NormalizePath(var APath: string);
class function URLDecode(ASrc: string): string;
class function URLEncode(const ASrc: string): string;
class function ParamsEncode(const ASrc: string): string;
class function PathEncode(const ASrc: string): string;
//
property Bookmark : string read FBookmark write FBookMark;
property Document: string read FDocument write FDocument;
property Host: string read FHost write FHost;
property Password: string read FPassword write FPassword;
property Path: string read FPath write FPath;
property Params: string read FParams write FParams;
property Port: string read FPort write FPort;
property Protocol: string read FProtocol write FProtocol;
property URI: string read GetURI write SetURI;
property Username: string read FUserName write FUserName;
property IPVersion : TIdIPVersion read FIPVersion write FIPVersion;
end;

EIdURIException = class(EIdException);

implementation

uses
IdResourceStringsProtocols, IdGlobalProtocols,
SysUtils;

constructor TIdURI.Create(const AURI: string = ''); {Do not Localize}
begin
inherited Create;
if length(AURI) > 0 then begin
URI := AURI;
end;
end;

class procedure TIdURI.NormalizePath(var APath: string);
var
i: Integer;
begin
// Normalize the directory delimiters to follow the UNIX syntax
i := 1;
while i <= Length(APath) do begin
if IsLeadChar(APath) then begin
inc(i, 2)
end else if APath = '/' then begin {Do not Localize}
APath := '/'; {Do not Localize}
inc(i, 1);
end else begin
inc(i, 1);
end;
end;
end;

procedure TIdURI.SetURI(const Value: String);
var
LBuffer: string;
LTokenPos, LPramsPos: Integer;
LURI: string;
begin
FURI := Value;
NormalizePath(FURI);
LURI := FURI;
FHost := ''; {Do not Localize}
FProtocol := ''; {Do not Localize}
FPath := ''; {Do not Localize}
FDocument := ''; {Do not Localize}
FPort := ''; {Do not Localize}
FBookmark := ''; {Do not Localize}
FUsername := ''; {Do not Localize}
FPassword := ''; {Do not Localize}
FParams := ''; {Do not localise} //Peter Mee
FIPVersion := Id_IPv4;

LTokenPos := IndyPos('://', LURI); {Do not Localize}
if LTokenPos > 0 then begin
// absolute URI
// What to do when data don't match configuration ?? {Do not Localize}
// Get the protocol
FProtocol := Copy(LURI, 1, LTokenPos - 1);
Delete(LURI, 1, LTokenPos + 2);
// Get the user name, password, host and the port number
LBuffer := Fetch(LURI, '/', True); {Do not Localize}
// Get username and password
LTokenPos := IndyPos('@', LBuffer); {Do not Localize}
FPassword := Copy(LBuffer, 1, LTokenPos - 1);
if LTokenPos > 0 then
Delete(LBuffer, 1, LTokenPos);
FUserName := Fetch(FPassword, ':', True); {Do not Localize}
// Ignore cases where there is only password (http://assword@host/pat/doc)
if Length(FUserName) = 0 then begin
FPassword := ''; {Do not Localize}
end;
// Get the host and the port number
if (IndyPos('[',LBuffer)>0) and (IndyPos(']',LBuffer) > IndyPos('[',LBuffer)) then
begin
//This is for IPv6 Hosts
FHost := Fetch(LBuffer,']');
Fetch(FHost,'[');
Fetch(LBuffer,':');
FIPVersion := Id_IPv6;
end
else
begin
FHost := Fetch(LBuffer, ':', True); {Do not Localize}
end;
FPort := LBuffer;
// Get the path
LPramsPos := IndyPos('?', LURI); {Do not Localize}
if LPramsPos > 0 then begin // The case when there is parameters after the document name '?' {Do not Localize}
LTokenPos := RPos('/', LURI, LPramsPos); {Do not Localize}
end
else begin
LPramsPos := IndyPos('=', LURI); {Do not Localize}
if LPramsPos > 0 then begin // The case when there is parameters after the document name '=' {Do not Localize}
LTokenPos := RPos('/', LURI, LPramsPos); {Do not Localize}
end
else begin
LTokenPos := RPos('/', LURI, -1); {Do not Localize}
end;
end;

FPath := '/' + Copy(LURI, 1, LTokenPos); {Do not Localize}
// Get the document
if LPramsPos > 0 then begin
FDocument := Copy(LURI, 1, LPramsPos - 1);
Delete(LURI, 1, LPramsPos - 1);
FParams := LURI;
end
else
FDocument := LURI;
Delete(FDocument, 1, LTokenPos);

FBookmark := FDocument;
FDocument := Fetch(FBookmark, '#'); {Do not Localize}
end else begin
// received an absolute path, not an URI
LPramsPos := IndyPos('?', LURI); {Do not Localize}
if LPramsPos > 0 then begin // The case when there is parameters after the document name '?' {Do not Localize}
LTokenPos := RPos('/', LURI, LPramsPos); {Do not Localize}
end else begin
LPramsPos := IndyPos('=', LURI); {Do not Localize}
if LPramsPos > 0 then begin // The case when there is parameters after the document name '=' {Do not Localize}
LTokenPos := RPos('/', LURI, LPramsPos); {Do not Localize}
end else begin
LTokenPos := RPos('/', LURI, -1); {Do not Localize}
end;
end;

FPath := Copy(LURI, 1, LTokenPos);
// Get the document
if LPramsPos > 0 then begin
FDocument := Copy(LURI, 1, LPramsPos - 1);
Delete(LURI, 1, LPramsPos - 1);
FParams := LURI;
end else begin
FDocument := LURI;
end;
Delete(FDocument, 1, LTokenPos);
end;

// Parse the # bookmark from the document
if FBookmark = '' then begin
FBookmark := FParams;
FParams := Fetch(FBookmark, '#'); {Do not Localize}
end;
end;

function TIdURI.GetURI: String;
begin
FURI := GetFullURI;
// Result must contain only the proto://host/path/document
// If you need the full URI then you have to call GetFullURI
result := GetFullURI([]);
end;

class function TIdURI.URLDecode(ASrc: string): string;
var
i: integer;
ESC: string[2];
CharCode: integer;
begin
Result := ''; {Do not Localize}
// S.G. 27/11/2002: Spaces is NOT to be encoded as "+".
// S.G. 27/11/2002: "+" is a field separator in query parameter, space is...
// S.G. 27/11/2002: well, a space
// ASrc := StringReplace(ASrc, '+', ' ', [rfReplaceAll]); {do not localize}
i := 1;
while i <= Length(ASrc) do begin
if ASrc <> '%' then begin {do not localize}
Result := Result + ASrc
end else begin
Inc(i); // skip the % char
ESC := Copy(ASrc, i, 2); // Copy the escape code
Inc(i, 1); // Then skip it.
try
CharCode := StrToInt('$' + ESC); {do not localize}
Result := Result + Char(CharCode);
except end;
end;
Inc(i);
end;
end;

class function TIdURI.ParamsEncode(const ASrc: string): string;
var
i: Integer;
const
UnsafeChars = ['*', '#', '%', '<', '>', ' ','[',']']; {do not localize}
begin
Result := ''; {Do not Localize}
for i := 1 to Length(ASrc) do
begin
// S.G. 27/11/2002: Changed the parameter encoding: Even in parameters, a space
// S.G. 27/11/2002: is much more likely to be meaning "space" than "this is
// S.G. 27/11/2002: a new parameter"
// S.G. 27/11/2002: ref: Message-ID: <3de30169@newsgroups.borland.com> borland.public.delphi.internet.winsock
// S.G. 27/11/2002: Most low-ascii is actually Ok in parameters encoding.
if ((CharIsInSet(ASrc, i, UnsafeChars)) or (not (CharIsInSet(ASrc, i, [#33..#128])))) then
begin {do not localize}
Result := Result + '%' + IntToHex(Ord(ASrc), 2); {do not localize}
end
else
begin
Result := Result + ASrc;
end;
end;
end;

class function TIdURI.PathEncode(const ASrc: string): string;
const
UnsafeChars = ['*', '#', '%', '<', '>', '+', ' ','[',']']; {do not localize}
var
i: Integer;
begin
Result := ''; {Do not Localize}
for i := 1 to Length(ASrc) do begin
if (CharIsInSet(ASrc, i, UnsafeChars)) or (ASrc >= #$80) or (ASrc < #32) then begin
Result := Result + '%' + IntToHex(Ord(ASrc), 2); {do not localize}
end else begin
Result := Result + ASrc;
end;
end;
end;

class function TIdURI.URLEncode(const ASrc: string): string;
begin
with TIdURI.Create(ASrc) do try
Path := PathEncode(Path);
Document := PathEncode(Document);
Params := ParamsEncode(Params);
Result := URI;
finally Free; end;
end;

function TIdURI.GetFullURI(
const AOptionalFields: TIdURIOptionalFieldsSet): String;
Var
LURI: String;
begin
if FProtocol = '' then begin
raise EIdURIException.Create(RSURINoProto);
end;

LURI := FProtocol + '://'; {Do not Localize}
if (FUserName <> '') and (ofAuthInfo in AOptionalFields) then begin
LURI := LURI + FUserName;
if FPassword <> '' then begin
LURI := LURI + ':' + FPassword; {Do not Localize}
end;
LURI := LURI + '@'; {Do not Localize}
end;

if FHost = '' then begin
raise EIdURIException.Create(RSURINoHost);
end;
LURI := LURI + FHost;
if (FPort <> '') and (FPort <> '80') then begin
LURI := LURI + ':' + FPort; {Do not Localize}
end;
LURI := LURI + FPath + FDocument + FParams;
if (FBookmark <> '') and (ofBookmark in AOptionalFields) then begin
LURI := LURI + '#' + FBookmark; {Do not Localize}
end;
Result := LURI;
end;

end.

这是Indy里面的组建，你可以借鉴下。或者，可以直接使用它。