+ uriparser unit added. Header/Footer blocks added

packages/base/netdb/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2003/04/06]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2002/10/05]
 #
 default: all
-MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos macosx emx
+MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx
 override PATH:=$(subst \,/,$(PATH))
 ifeq ($(findstring ;,$(PATH)),)
 inUnix=1
@@ -58,7 +58,7 @@ ifdef inUnix
 PATHSEP=/
 else
 PATHSEP:=$(subst /,\,/)
-ifdef inCygWin
+ifneq ($(findstring sh.exe,$(SHELL)),)
 PATHSEP=/
 endif
 endif
@@ -111,38 +111,47 @@ endif
 override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
 override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
 ifndef FPC_VERSION
-FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
-FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+FPC_VERSION:=$(shell $(FPC) -iV)
 endif
-export FPC FPC_VERSION FPC_COMPILERINFO
+export FPC FPC_VERSION
 unexport CHECKDEPEND ALLDEPENDENCIES
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+COMPILERINFO:=$(shell $(FPC) -iSP -iTP -iSO -iTO)
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 1,$(COMPILERINFO))
+endif
 ifndef CPU_TARGET
-ifdef CPU_TARGET_DEFAULT
-CPU_TARGET=$(CPU_TARGET_DEFAULT)
+CPU_TARGET:=$(word 2,$(COMPILERINFO))
 endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 3,$(COMPILERINFO))
 endif
 ifndef OS_TARGET
-ifdef OS_TARGET_DEFAULT
-OS_TARGET=$(OS_TARGET_DEFAULT)
-endif
-endif
-ifneq ($(words $(FPC_COMPILERINFO)),5)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+OS_TARGET:=$(word 4,$(COMPILERINFO))
 endif
+else
 ifndef CPU_SOURCE
-CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+CPU_SOURCE:=$(shell $(FPC) -iSP)
 endif
 ifndef CPU_TARGET
-CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+CPU_TARGET:=$(shell $(FPC) -iTP)
 endif
 ifndef OS_SOURCE
-OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+OS_SOURCE:=$(shell $(FPC) -iSO)
 endif
 ifndef OS_TARGET
-OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+endif
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
 endif
 FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
 FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
@@ -205,8 +214,32 @@ endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 override PACKAGE_NAME=netdb
 override PACKAGE_VERSION=1.0.8
+override TARGET_UNITS+=uriparser
+ifeq ($(OS_TARGET),linux)
+override TARGET_UNITS+=netdb
+endif
+ifeq ($(OS_TARGET),freebsd)
+override TARGET_UNITS+=netdb
+endif
+ifeq ($(OS_TARGET),netbsd)
 override TARGET_UNITS+=netdb
+endif
+ifeq ($(OS_TARGET),openbsd)
+override TARGET_UNITS+=netdb
+endif
+override TARGET_EXAMPLES+=testuri
+ifeq ($(OS_TARGET),linux)
 override TARGET_EXAMPLES+=testdns testhst testsvc testnet
+endif
+ifeq ($(OS_TARGET),freebsd)
+override TARGET_EXAMPLES+=testdns testhst testsvc testnet
+endif
+ifeq ($(OS_TARGET),netbsd)
+override TARGET_EXAMPLES+=testdns testhst testsvc testnet
+endif
+ifeq ($(OS_TARGET),openbsd)
+override TARGET_EXAMPLES+=testdns testhst testsvc testnet
+endif
 override INSTALL_FPCPACKAGE=y
 ifdef REQUIRE_UNITSDIR
 override UNITSDIR+=$(REQUIRE_UNITSDIR)
@@ -413,97 +446,6 @@ SHAREDLIBEXT=.so
 STATICLIBPREFIX=libp
 RSTEXT=.rst
 FPCMADE=fpcmade
-ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
-ifeq ($(OS_TARGET),go32v1)
-STATICLIBPREFIX=
-FPCMADE=fpcmade.v1
-PACKAGESUFFIX=v1
-endif
-ifeq ($(OS_TARGET),go32v2)
-STATICLIBPREFIX=
-FPCMADE=fpcmade.dos
-ZIPSUFFIX=go32
-endif
-ifeq ($(OS_TARGET),linux)
-EXEEXT=
-HASSHAREDLIB=1
-FPCMADE=fpcmade.lnx
-ZIPSUFFIX=linux
-endif
-ifeq ($(OS_TARGET),freebsd)
-EXEEXT=
-HASSHAREDLIB=1
-FPCMADE=fpcmade.freebsd
-ZIPSUFFIX=freebsd
-endif
-ifeq ($(OS_TARGET),netbsd)
-EXEEXT=
-HASSHAREDLIB=1
-FPCMADE=fpcmade.netbsd
-ZIPSUFFIX=netbsd
-endif
-ifeq ($(OS_TARGET),openbsd)
-EXEEXT=
-HASSHAREDLIB=1
-FPCMADE=fpcmade.openbsd
-ZIPSUFFIX=openbsd
-endif
-ifeq ($(OS_TARGET),win32)
-SHAREDLIBEXT=.dll
-FPCMADE=fpcmade.w32
-ZIPSUFFIX=w32
-endif
-ifeq ($(OS_TARGET),os2)
-AOUTEXT=.out
-STATICLIBPREFIX=
-SHAREDLIBEXT=.dll
-FPCMADE=fpcmade.os2
-ZIPSUFFIX=os2
-ECHO=echo
-endif
-ifeq ($(OS_TARGET),emx)
-AOUTEXT=.out
-STATICLIBPREFIX=
-SHAREDLIBEXT=.dll
-FPCMADE=fpcmade.emx
-ZIPSUFFIX=emx
-ECHO=echo
-endif
-ifeq ($(OS_TARGET),amiga)
-EXEEXT=
-SHAREDLIBEXT=.library
-FPCMADE=fpcmade.amg
-endif
-ifeq ($(OS_TARGET),atari)
-EXEEXT=.ttp
-FPCMADE=fpcmade.ata
-endif
-ifeq ($(OS_TARGET),beos)
-EXEEXT=
-FPCMADE=fpcmade.be
-ZIPSUFFIX=be
-endif
-ifeq ($(OS_TARGET),sunos)
-EXEEXT=
-FPCMADE=fpcmade.sun
-ZIPSUFFIX=sun
-endif
-ifeq ($(OS_TARGET),qnx)
-EXEEXT=
-FPCMADE=fpcmade.qnx
-ZIPSUFFIX=qnx
-endif
-ifeq ($(OS_TARGET),netware)
-EXEEXT=.nlm
-STATICLIBPREFIX=
-FPCMADE=fpcmade.nw
-ZIPSUFFIX=nw
-endif
-ifeq ($(OS_TARGET),macos)
-EXEEXT=
-FPCMADE=fpcmade.mcc
-endif
-else
 ifeq ($(OS_TARGET),go32v1)
 PPUEXT=.pp1
 OEXT=.o1
@@ -618,8 +560,8 @@ ZIPSUFFIX=qnx
 endif
 ifeq ($(OS_TARGET),netware)
 STATICLIBPREFIX=
-PPUEXT=.ppu
-OEXT=.o
+PPUEXT=.ppn
+OEXT=.on
 ASMEXT=.s
 SMARTEXT=.sl
 STATICLIBEXT=.a
@@ -628,16 +570,6 @@ FPCMADE=fpcmade.nw
 ZIPSUFFIX=nw
 EXEEXT=.nlm
 endif
-ifeq ($(OS_TARGET),macos)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-FPCMADE=fpcmade.mcc
-endif
-endif
 ifndef ECHO
 ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(ECHO),)
@@ -902,18 +834,6 @@ endif
 ifeq ($(OS_TARGET),wdosx)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(OS_TARGET),palmos)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),macos)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),macosx)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),emx)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifdef REQUIRE_PACKAGES_RTL
 PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_RTL),)
@@ -1030,11 +950,6 @@ override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
 override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
 endif
 endif
-ifeq ($(OS_TARGET),linux)
-ifeq ($(FPC_VERSION),1.0.6)
-override FPCOPTDEF+=HASUNIX
-endif
-endif
 ifdef OPT
 override FPCOPT+=$(OPT)
 endif
@@ -1080,9 +995,6 @@ override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
 ifeq ($(OS_TARGET),os2)
 override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
 endif
-ifeq ($(OS_TARGET),emx)
-override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
-endif
 endif
 ifdef TARGET_EXAMPLEDIRS
 HASEXAMPLES=1

packages/base/netdb/Makefile.fpc

@@ -7,8 +7,16 @@ name=netdb
 version=1.0.8
 
 [target]
-units=netdb
-examples=testdns testhst testsvc testnet
+units=uriparser
+units_linux=netdb
+units_freebsd=netdb
+units_openbsd=netdb
+units_netbsd=netdb
+examples_linux=testdns testhst testsvc testnet
+examples_freebsd=testdns testhst testsvc testnet
+examples_openbsd=testdns testhst testsvc testnet
+examples_netbsd=testdns testhst testsvc testnet
+examples=testuri
 
 [require]
 

packages/base/netdb/README

@@ -2,6 +2,10 @@ This directory contains a pure-pascal netdb implementation:
 It is written mainly to be able to implement network applications that
 do hostname lookups independent of the C library.
 
+The uriparser unit contains a parser for URI strings: It decomposes the URI
+in its various elements. The opposite can also be done: from various
+elements create a complete URI
+
 This provides the equivalent of the Inet unit, but the implementation is
 written completely in pascal. It parses the hosts,services and networks
 files just as the C library does (it should, anyway). 

packages/base/netdb/netdb.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Implement networking routines.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}
 {$h+}
 
@@ -932,3 +947,11 @@ end;
 begin
   InitResolver;
 end.
+
+
+{
+  $Log$
+  Revision 1.3  2003-05-17 20:54:03  michael
+  + uriparser unit added. Header/Footer blocks added
+
+}

packages/base/netdb/testdns.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    test netdb unit, host part
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}
 {$h+}
 
@@ -65,4 +80,11 @@ begin
   testname('malpertuus.wisa.be');
   Writeln('ResolveHostByAddr:');  
   testaddr('212.224.143.202');
-end.
+end.
+
+{
+  $Log$
+  Revision 1.2  2003-05-17 20:54:03  michael
+  + uriparser unit added. Header/Footer blocks added
+
+}

packages/base/netdb/testhst.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    test netdb unit, hosts part.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 program testhst;
 
 uses netdb;
@@ -45,3 +60,11 @@ begin
   testname('www.freepascal.org');
   testname('obelix.wisa.be');
 end.
+
+
+{
+  $Log$
+  Revision 1.2  2003-05-17 20:54:03  michael
+  + uriparser unit added. Header/Footer blocks added
+
+}

packages/base/netdb/testnet.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    test netdb unit, network part
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 program testhst;
 
 uses netdb;
@@ -42,3 +57,10 @@ begin
   testaddr('127.0.0.0');
   testname('loopback');
 end.
+
+{
+  $Log$
+  Revision 1.2  2003-05-17 20:54:03  michael
+  + uriparser unit added. Header/Footer blocks added
+
+}

packages/base/netdb/testsvc.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    test netdb unit, services part
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 program testsvc;
 
 uses netdb;
@@ -47,3 +62,11 @@ begin
   testname('ftp','');
   testname('domain','udp');
 end.
+
+
+{
+  $Log$
+  Revision 1.2  2003-05-17 20:54:03  michael
+  + uriparser unit added. Header/Footer blocks added
+
+}

packages/base/netdb/testuri.pp

@@ -0,0 +1,67 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Test uriparser unit
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$MODE objfpc}
+{$H+}
+
+program Testuri;
+
+uses URIParser;
+
+var
+  URI: TURI;
+  s: String;
+begin
+  with URI do
+  begin
+    Protocol := 'http';
+    Username := 'user';
+    Password := 'pass';
+    Host := 'localhost';
+    Port := 8080;
+    Path := '/test/dir';
+    Document := 'some index.html';
+    Params := 'param1=value1&param2=value2';
+    Bookmark := 'bookmark';
+  end;
+
+  s := EncodeURI(URI);
+  WriteLn(s);
+
+  FillChar(URI, SizeOf(URI), #0);
+
+  URI := ParseURI(s, 'defaultprotocol', 1234);
+
+  with URI do
+  begin
+    WriteLn('Protocol: ', Protocol);
+    WriteLn('Username: ', Username);
+    WriteLn('Password: ', Password);
+    WriteLn('Host: ', Host);
+    WriteLn('Port: ', Port);
+    WriteLn('Path: ', Path);
+    WriteLn('Document: ', Document);
+    WriteLn('Params: ', Params);
+    WriteLn('Bookmark: ', Bookmark);
+  end;
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2003-05-17 20:54:03  michael
+  + uriparser unit added. Header/Footer blocks added
+
+}

packages/base/netdb/uriparser.pp

@@ -0,0 +1,245 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Unit to parse complete URI in its parts.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$MODE objfpc}
+{$H+}
+
+unit URIParser;
+
+interface
+
+type
+  TURI = record
+    Protocol: String;
+    Username: String;
+    Password: String;
+    Host: String;
+    Port: Word;
+    Path: String;
+    Document: String;
+    Params: String;
+    Bookmark: String;
+  end;
+
+function EncodeURI(const URI: TURI): String;
+function ParseURI(const URI: String):  TURI;
+function ParseURI(const URI, DefaultProtocol: String; DefaultPort: Word):  TURI;
+
+
+implementation
+
+uses SysUtils;
+
+const
+  HexTable: array[0..15] of Char = '0123456789abcdef';
+
+
+function EncodeURI(const URI: TURI): String;
+
+  function Escape(const s: String): String;
+  var
+    i: Integer;
+  begin
+    SetLength(Result, 0);
+    for i := 1 to Length(s) do
+      if not (s[i] in ['0'..'9', 'A'..'Z', 'a'..'z', ',', '-', '.', '_',
+        '/', '\']) then
+        Result := Result + '%' + HexTable[Ord(s[i]) shr 4] +
+	  HexTable[Ord(s[i]) and $f]
+      else
+        Result := Result + s[i];
+  end;
+
+begin
+  SetLength(Result, 0);
+  if Length(URI.Protocol) > 0 then
+    Result := LowerCase(URI.Protocol) + ':';
+  if Length(URI.Host) > 0 then
+  begin
+    Result := Result + '//';
+    if Length(URI.Username) > 0 then
+    begin
+      Result := Result + URI.Username;
+      if Length(URI.Password) > 0 then
+        Result := Result + ':' + URI.Password;
+      Result := Result + '@';
+    end;
+    Result := Result + URI.Host;
+  end;
+  if URI.Port <> 0 then
+    Result := Result + ':' + IntToStr(URI.Port);
+  Result := Result + Escape(URI.Path);
+  if Length(URI.Document) > 0 then
+  begin
+    if (Length(Result) = 0) or (Result[Length(Result)] <> '/') then
+      Result := Result + '/';
+    Result := Result + Escape(URI.Document);
+  end;
+  if Length(URI.Params) > 0 then
+    Result := Result + '?' + URI.Params;
+  if Length(URI.Bookmark) > 0 then
+    Result := Result + '#' + Escape(URI.Bookmark);
+end;
+
+function ParseURI(const URI: String):  TURI;
+begin
+  Result := ParseURI(URI, '', 0);
+end;
+
+function ParseURI(const URI, DefaultProtocol: String; DefaultPort: Word):  TURI;
+
+  function Unescape(const s: String): String;
+
+    function HexValue(c: Char): Integer;
+    begin
+      if (c >= '0') and (c <= '9') then
+        Result := Ord(c) - Ord('0')
+      else if (c >= 'A') and (c <= 'F') then
+        Result := Ord(c) - Ord('A') + 10
+      else if (c >= 'a') and (c <= 'f') then
+        Result := Ord(c) - Ord('a') + 10
+      else
+        Result := 0;
+    end;
+
+  var
+    i, RealLength: Integer;
+  begin
+    SetLength(Result, Length(s));
+    i := 1;
+    RealLength := 0;
+    while i <= Length(s) do
+    begin
+      Inc(RealLength);
+      if s[i] = '%' then
+      begin
+        Result[RealLength] := Chr(HexValue(s[i + 1]) shl 4 or HexValue(s[i + 2]));
+	Inc(i, 3);
+      end else
+      begin
+        Result[RealLength] := s[i];
+	Inc(i);
+      end;
+    end;
+    SetLength(Result, RealLength);
+  end;
+
+var
+  s: String;
+  i, LastValidPos: Integer;
+begin
+  Result.Protocol := LowerCase(DefaultProtocol);
+  Result.Port := DefaultPort;
+
+  s := URI;
+
+  // Extract the protocol
+
+  for i := 1 to Length(s) do
+    if s[i] = ':' then
+    begin
+      Result.Protocol := Copy(s, 1, i - 1);
+      s := Copy(s, i + 1, Length(s));
+      break;
+    end else if not (s[i] in ['0'..'9', 'A'..'Z', 'a'..'z']) then
+      break;
+
+  // Extract the bookmark name
+
+  for i := Length(s) downto 1 do
+    if s[i] = '#' then
+    begin
+      Result.Bookmark := Unescape(Copy(s, i + 1, Length(s)));
+      s := Copy(s, 1, i - 1);
+      break;
+    end else if s[i] = '/' then
+      break;
+
+  // Extract the params
+
+  for i := Length(s) downto 1 do
+    if s[i] = '?' then
+    begin
+      Result.Params := Copy(s, i + 1, Length(s));
+      s := Copy(s, 1, i - 1);
+      break;
+    end else if s[i] = '/' then
+      break;
+
+  // Extract the document name
+
+  for i := Length(s) downto 1 do
+    if s[i] = '/' then
+    begin
+      Result.Document := Unescape(Copy(s, i + 1, Length(s)));
+      s := Copy(s, 1, i - 1);
+      break;
+    end else if s[i] = ':' then
+      break;
+
+  // Extract the path
+
+  LastValidPos := 0;
+  for i := Length(s) downto 1 do
+    if s[i] = '/' then
+      LastValidPos := i
+    else if s[i] in [':', '@'] then
+      break;
+
+  if LastValidPos > 0 then
+  begin
+    Result.Path := Unescape(Copy(s, LastValidPos, Length(s)));
+    s := Copy(s, 1, LastValidPos - 1);
+  end;
+
+  // Extract the port number
+
+  for i := Length(s) downto 1 do
+    if s[i] = ':' then
+    begin
+      Result.Port := StrToInt(Copy(s, i + 1, Length(s)));
+      s := Copy(s, 1, i - 1);
+      break;
+    end else if s[i] in ['@', '/'] then
+      break;
+
+  // Extract the hostname
+
+  if (Length(s) > 2) and (s[1] = '/') and (s[2] = '/') then
+  begin
+    for i := Length(s) downto 1 do
+      if s[i] in ['@', '/'] then
+      begin
+        Result.Host := Copy(s, i + 1, Length(s));
+        s := Copy(s, 3, i - 3);
+        break;
+      end;
+
+    // Extract username and password
+    if Length(s) > 0 then
+    begin
+      i := Pos(':', s);
+      if i = 0 then
+        Result.Username := s
+      else
+      begin
+        Result.Username := Copy(s, 1, i - 1);
+	Result.Password := Copy(s, i + 1, Length(s));
+      end;
+    end;
+  end;
+end;
+
+end.