diff --git a/packages/base/netdb/Makefile b/packages/base/netdb/Makefile index af008b501c..a68c92c874 100644 --- a/packages/base/netdb/Makefile +++ b/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,11 +111,38 @@ 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 +CPU_TARGET:=$(word 2,$(COMPILERINFO)) +endif +ifndef OS_SOURCE +OS_SOURCE:=$(word 3,$(COMPILERINFO)) +endif +ifndef OS_TARGET +OS_TARGET:=$(word 4,$(COMPILERINFO)) +endif +else +ifndef CPU_SOURCE +CPU_SOURCE:=$(shell $(FPC) -iSP) +endif +ifndef CPU_TARGET +CPU_TARGET:=$(shell $(FPC) -iTP) +endif +ifndef OS_SOURCE +OS_SOURCE:=$(shell $(FPC) -iSO) +endif +ifndef OS_TARGET +OS_TARGET:=$(shell $(FPC) -iTO) +endif +endif ifndef CPU_TARGET ifdef CPU_TARGET_DEFAULT CPU_TARGET=$(CPU_TARGET_DEFAULT) @@ -126,24 +153,6 @@ 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) -endif -ifndef CPU_SOURCE -CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO)) -endif -ifndef CPU_TARGET -CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO)) -endif -ifndef OS_SOURCE -OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO)) -endif -ifndef OS_TARGET -OS_TARGET:=$(word 5,$(FPC_COMPILERINFO)) -endif FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) ifneq ($(FULL_TARGET),$(FULL_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 diff --git a/packages/base/netdb/Makefile.fpc b/packages/base/netdb/Makefile.fpc index 59045ddb37..e91cd9f648 100644 --- a/packages/base/netdb/Makefile.fpc +++ b/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] diff --git a/packages/base/netdb/README b/packages/base/netdb/README index e8283d8497..c0995d9dbc 100644 --- a/packages/base/netdb/README +++ b/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). diff --git a/packages/base/netdb/netdb.pp b/packages/base/netdb/netdb.pp index 52711cd6f5..6d204cefeb 100644 --- a/packages/base/netdb/netdb.pp +++ b/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 + +} diff --git a/packages/base/netdb/testdns.pp b/packages/base/netdb/testdns.pp index 19e1bf5de5..e160b768d7 100644 --- a/packages/base/netdb/testdns.pp +++ b/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. \ No newline at end of file +end. + +{ + $Log$ + Revision 1.2 2003-05-17 20:54:03 michael + + uriparser unit added. Header/Footer blocks added + +} diff --git a/packages/base/netdb/testhst.pp b/packages/base/netdb/testhst.pp index 001f836d27..6c40851ec2 100644 --- a/packages/base/netdb/testhst.pp +++ b/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 + +} diff --git a/packages/base/netdb/testnet.pp b/packages/base/netdb/testnet.pp index 028ac23ca0..80f09f56ca 100644 --- a/packages/base/netdb/testnet.pp +++ b/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 + +} diff --git a/packages/base/netdb/testsvc.pp b/packages/base/netdb/testsvc.pp index 42bf7da975..4251bd8db3 100644 --- a/packages/base/netdb/testsvc.pp +++ b/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 + +} diff --git a/packages/base/netdb/testuri.pp b/packages/base/netdb/testuri.pp new file mode 100644 index 0000000000..beac01c03a --- /dev/null +++ b/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¶m2=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 + +} diff --git a/packages/base/netdb/uriparser.pp b/packages/base/netdb/uriparser.pp new file mode 100644 index 0000000000..b8c90c4612 --- /dev/null +++ b/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.