mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-20 23:41:43 +01:00
+ uriparser unit added. Header/Footer blocks added
This commit is contained in:
michael
parent
4aadabdf80
commit
c8a141e894
@ -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
|
||||
|
||||
@ -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]
|
||||
|
||||
|
||||
@ -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).
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
|
||||
67
packages/base/netdb/testuri.pp
Normal file
67
packages/base/netdb/testuri.pp
Normal file
@ -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
|
||||
|
||||
}
|
||||
245
packages/base/netdb/uriparser.pp
Normal file
245
packages/base/netdb/uriparser.pp
Normal file
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user