← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to packages/base/netdb/uriparser.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
packages/base/netdb/uriparser.pp
 
1
{
 
2
    $Id: uriparser.pp,v 1.4 2003/08/14 14:27:21 michael Exp $
 
3
    This file is part of the Free Pascal run time library.
 
4
    Copyright (c) 2003 by the Free Pascal development team
 
5
    Original author: Sebastian Guenther
 
6
 
 
7
    Unit to parse complete URI in its parts or to reassemble an URI
 
8
    
 
9
    See the file COPYING.FPC, included in this distribution,
 
10
    for details about the copyright.
 
11
 
 
12
    This program is distributed in the hope that it will be useful,
 
13
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
14
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
15
 
 
16
 **********************************************************************}
 
17
{$MODE objfpc}
 
18
{$H+}
 
19
 
 
20
unit URIParser;
 
21
 
 
22
interface
 
23
 
 
24
type
 
25
  TURI = record
 
26
    Protocol: String;
 
27
    Username: String;
 
28
    Password: String;
 
29
    Host: String;
 
30
    Port: Word;
 
31
    Path: String;
 
32
    Document: String;
 
33
    Params: String;
 
34
    Bookmark: String;
 
35
  end;
 
36
 
 
37
function EncodeURI(const URI: TURI): String;
 
38
function ParseURI(const URI: String):  TURI;
 
39
function ParseURI(const URI, DefaultProtocol: String; DefaultPort: Word):  TURI;
 
40
 
 
41
 
 
42
implementation
 
43
 
 
44
uses SysUtils;
 
45
 
 
46
const
 
47
  HexTable: array[0..15] of Char = '0123456789abcdef';
 
48
 
 
49
 
 
50
function EncodeURI(const URI: TURI): String;
 
51
 
 
52
  function Escape(const s: String): String;
 
53
  var
 
54
    i: Integer;
 
55
  begin
 
56
    SetLength(Result, 0);
 
57
    for i := 1 to Length(s) do
 
58
      if not (s[i] in ['0'..'9', 'A'..'Z', 'a'..'z', ',', '-', '.', '_',
 
59
        '/', '\']) then
 
60
        Result := Result + '%' + HexTable[Ord(s[i]) shr 4] +
 
61
          HexTable[Ord(s[i]) and $f]
 
62
      else
 
63
        Result := Result + s[i];
 
64
  end;
 
65
 
 
66
begin
 
67
  SetLength(Result, 0);
 
68
  if Length(URI.Protocol) > 0 then
 
69
    Result := LowerCase(URI.Protocol) + ':';
 
70
  if Length(URI.Host) > 0 then
 
71
  begin
 
72
    Result := Result + '//';
 
73
    if Length(URI.Username) > 0 then
 
74
    begin
 
75
      Result := Result + URI.Username;
 
76
      if Length(URI.Password) > 0 then
 
77
        Result := Result + ':' + URI.Password;
 
78
      Result := Result + '@';
 
79
    end;
 
80
    Result := Result + URI.Host;
 
81
  end;
 
82
  if URI.Port <> 0 then
 
83
    Result := Result + ':' + IntToStr(URI.Port);
 
84
  Result := Result + Escape(URI.Path);
 
85
  if Length(URI.Document) > 0 then
 
86
  begin
 
87
    if (Length(Result) = 0) or (Result[Length(Result)] <> '/') then
 
88
      Result := Result + '/';
 
89
    Result := Result + Escape(URI.Document);
 
90
  end;
 
91
  if Length(URI.Params) > 0 then
 
92
    Result := Result + '?' + URI.Params;
 
93
  if Length(URI.Bookmark) > 0 then
 
94
    Result := Result + '#' + Escape(URI.Bookmark);
 
95
end;
 
96
 
 
97
function ParseURI(const URI: String):  TURI;
 
98
begin
 
99
  Result := ParseURI(URI, '', 0);
 
100
end;
 
101
 
 
102
function ParseURI(const URI, DefaultProtocol: String; DefaultPort: Word):  TURI;
 
103
 
 
104
  function Unescape(const s: String): String;
 
105
 
 
106
    function HexValue(c: Char): Integer;
 
107
    begin
 
108
      if (c >= '0') and (c <= '9') then
 
109
        Result := Ord(c) - Ord('0')
 
110
      else if (c >= 'A') and (c <= 'F') then
 
111
        Result := Ord(c) - Ord('A') + 10
 
112
      else if (c >= 'a') and (c <= 'f') then
 
113
        Result := Ord(c) - Ord('a') + 10
 
114
      else
 
115
        Result := 0;
 
116
    end;
 
117
 
 
118
  var
 
119
    i, RealLength: Integer;
 
120
  begin
 
121
    SetLength(Result, Length(s));
 
122
    i := 1;
 
123
    RealLength := 0;
 
124
    while i <= Length(s) do
 
125
    begin
 
126
      Inc(RealLength);
 
127
      if s[i] = '%' then
 
128
      begin
 
129
        Result[RealLength] := Chr(HexValue(s[i + 1]) shl 4 or HexValue(s[i + 2]));
 
130
        Inc(i, 3);
 
131
      end else
 
132
      begin
 
133
        Result[RealLength] := s[i];
 
134
        Inc(i);
 
135
      end;
 
136
    end;
 
137
    SetLength(Result, RealLength);
 
138
  end;
 
139
 
 
140
var
 
141
  s: String;
 
142
  i, LastValidPos: Integer;
 
143
begin
 
144
  Result.Protocol := LowerCase(DefaultProtocol);
 
145
  Result.Port := DefaultPort;
 
146
 
 
147
  s := URI;
 
148
 
 
149
  // Extract the protocol
 
150
 
 
151
  for i := 1 to Length(s) do
 
152
    if s[i] = ':' then
 
153
    begin
 
154
      Result.Protocol := Copy(s, 1, i - 1);
 
155
      s := Copy(s, i + 1, Length(s));
 
156
      break;
 
157
    end else if not (s[i] in ['0'..'9', 'A'..'Z', 'a'..'z']) then
 
158
      break;
 
159
 
 
160
  // Extract the bookmark name
 
161
 
 
162
  for i := Length(s) downto 1 do
 
163
    if s[i] = '#' then
 
164
    begin
 
165
      Result.Bookmark := Unescape(Copy(s, i + 1, Length(s)));
 
166
      s := Copy(s, 1, i - 1);
 
167
      break;
 
168
    end else if s[i] = '/' then
 
169
      break;
 
170
 
 
171
  // Extract the params
 
172
 
 
173
  for i := Length(s) downto 1 do
 
174
    if s[i] = '?' then
 
175
    begin
 
176
      Result.Params := Copy(s, i + 1, Length(s));
 
177
      s := Copy(s, 1, i - 1);
 
178
      break;
 
179
    end else if s[i] = '/' then
 
180
      break;
 
181
 
 
182
  // Extract the document name
 
183
 
 
184
  for i := Length(s) downto 1 do
 
185
    if s[i] = '/' then
 
186
    begin
 
187
      Result.Document := Unescape(Copy(s, i + 1, Length(s)));
 
188
      s := Copy(s, 1, i - 1);
 
189
      break;
 
190
    end else if s[i] = ':' then
 
191
      break;
 
192
 
 
193
  // Extract the path
 
194
 
 
195
  LastValidPos := 0;
 
196
  for i := Length(s) downto 1 do
 
197
    if (s[i] = '/')
 
198
       and ((I>1) and (S[i-1]<>'/')) 
 
199
       and ((I<Length(S)) and (S[I+1]<>'/')) then
 
200
      LastValidPos := i
 
201
    else if s[i] in [':', '@'] then
 
202
      break;
 
203
 
 
204
  if (LastValidPos > 0) and 
 
205
     (Length(S)>LastValidPos) and 
 
206
     (S[LastValidPos+1]<>'/') then
 
207
  begin
 
208
    Result.Path := Unescape(Copy(s, LastValidPos, Length(s)));
 
209
    s := Copy(s, 1, LastValidPos - 1);
 
210
  end;
 
211
 
 
212
  // Extract the port number
 
213
 
 
214
  for i := Length(s) downto 1 do
 
215
    if s[i] = ':' then
 
216
    begin
 
217
      Result.Port := StrToInt(Copy(s, i + 1, Length(s)));
 
218
      s := Copy(s, 1, i - 1);
 
219
      break;
 
220
    end else if s[i] in ['@', '/'] then
 
221
      break;
 
222
 
 
223
  // Extract the hostname
 
224
 
 
225
  if ((Length(s) > 2) and (s[1] = '/') and (s[2] = '/')) or
 
226
    ((Length(s) > 1) and (s[1] <> '/')) then
 
227
  begin
 
228
    if s[1] <> '/' then
 
229
      s := '//' + s;
 
230
    for i := Length(s) downto 1 do
 
231
      if s[i] in ['@', '/'] then
 
232
      begin
 
233
        Result.Host := Copy(s, i + 1, Length(s));
 
234
        s := Copy(s, 3, i - 3);
 
235
        break;
 
236
      end;
 
237
 
 
238
    // Extract username and password
 
239
    if Length(s) > 0 then
 
240
    begin
 
241
      i := Pos(':', s);
 
242
      if i = 0 then
 
243
        Result.Username := s
 
244
      else
 
245
      begin
 
246
        Result.Username := Copy(s, 1, i - 1);
 
247
        Result.Password := Copy(s, i + 1, Length(s));
 
248
      end;
 
249
    end;
 
250
  end; 
 
251
end;
 
252
 
 
253
end.