| 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
| ///////////////////////////////////////////////////////////////////////////
// //
// Copyright (c) 2015 by Charta Software B.V. //
// All rights reserved //
// //
// Version: 1.7.0.83525 //
// Web site: https://pascal.chartasoftware.com/ //
// //
// This code and information are provided "as is" without warranty of //
// any kind. Dissemination of this information or reproduction of //
// this material is strictly forbidden unless prior written permission //
// is obtained from Charta Software B.V.. //
// //
///////////////////////////////////////////////////////////////////////////
unit Uri.Producer;
interface
uses
Integer._32,
Text,
Uri;
type
TUriProducer = class(TObject)
protected
FWebSiteRoot: TUri;
FCurrentPath: TArray<TText>;
PathStack: array of TArray<TText>;
public
procedure PushPath(const Path: array of TText);
procedure PopPath();
function RootUri(const SubPath: array of TText; ResourceType: TUriResourceType): TUri; virtual; // URI relative to the root of the web site
function RelativeUri(const SubPath: array of TText; ResourceType: TUriResourceType): TUri; overload; // URI relative to the current module path
function RelativeUri(const SubPath: TUriPath): TUri; overload;
function CloneRootProducer(): TUriProducer;
function CloneRelativeProducer(): TUriProducer;
function GetStackSize(): TInteger32;
procedure Configure(const WebSiteRoot: TUri);
property WebSiteRoot: TUri read FWebSiteRoot;
property CurrentPath: TArray<TText> read FCurrentPath;
end;
implementation
{ TUriProducer }
procedure TUriProducer.PopPath();
begin
FCurrentPath := PathStack[High(PathStack)];
SetLength(PathStack, Length(PathStack) - 1);
end;
procedure TUriProducer.PushPath(const Path: array of TText);
var
Offset: TInteger32;
i: TInteger32;
begin
SetLength(PathStack, Length(PathStack) + 1);
PathStack[High(PathStack)] := FCurrentPath;
Offset := Length(FCurrentPath);
SetLength(FCurrentPath, Offset + Length(Path));
for i := 0 to High(Path) do
begin
FCurrentPath[Offset] := Path[i];
Inc(Offset);
end;
end;
function TUriProducer.RelativeUri(const SubPath: array of TText; ResourceType: TUriResourceType): TUri;
begin
Result := WebSiteRoot;
Result.Path.Add(CurrentPath);
Result.Path.Add(SubPath);
Result.Path.ResourceType := ResourceType;
end;
function TUriProducer.RelativeUri(const SubPath: TUriPath): TUri;
begin
Result := RelativeUri([], SubPath.ResourceType);
Result.Path.Add(SubPath);
end;
function TUriProducer.RootUri(const SubPath: array of TText; ResourceType: TUriResourceType): TUri;
begin
Result := WebSiteRoot;
Result.Path.Add(SubPath);
Result.Path.ResourceType := ResourceType;
end;
function TUriProducer.CloneRelativeProducer(): TUriProducer;
begin
Result := TUriProducer.Create();
Result.FWebSiteRoot := WebSiteRoot;
Result.FCurrentPath := FCurrentPath;
Result.PathStack := PathStack;
end;
function TUriProducer.CloneRootProducer(): TUriProducer;
begin
Result := TUriProducer.Create();
Result.FWebSiteRoot := WebSiteRoot;
end;
procedure TUriProducer.Configure(const WebSiteRoot: TUri);
begin
FWebSiteRoot := WebSiteRoot;
end;
function TUriProducer.GetStackSize(): TInteger32;
begin
Result := Length(PathStack);
end;
end.
|