source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/IETravelLog.pas@ 541

Last change on this file since 541 was 541, checked in by Kevin Toppenberg, 15 years ago

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 9.8 KB
Line 
1//***********************************************************
2// IETravelLog *
3// *
4// Freeware Component *
5// by *
6// Per Lindsø Larsen *
7// Updated by Eran Bodankin - bsalsa *
8// bsalsa@gmail.com *
9// *
10// Documentation and updated versions: *
11// *
12// http://www.bsalsa.com *
13//***********************************************************
14{*******************************************************************************}
15{LICENSE:
16THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
17EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
18WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
19YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
20AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
21AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
22OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
23OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
24INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
25OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
26AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY
27DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.
28
29You may use, change or modify the component under 4 conditions:
301. In your website, add a link to "http://www.bsalsa.com"
312. In your application, add credits to "Embedded Web Browser"
323. Mail me (bsalsa@gmail.com) any code change in the unit
33 for the benefit of the other users.
344. Please consider donation in our web site!
35{*******************************************************************************}
36//$Id: IETravelLog.pas,v 1.3 2006/12/18 14:13:07 bsalsa Exp $
37
38unit IETravelLog;
39
40interface
41
42{$I EWB.inc}
43
44uses
45 Activex, Windows, Classes, EmbeddedWB, IEConst, EwbAcc;
46
47type
48 TOnEntryEvent = procedure(Title, Url: WideString; var Cancel: Boolean) of object;
49 TOnGetCountEvent = procedure(Flags: Cardinal; out Entries: Cardinal) of object;
50 TOnRemoveEntryEvent = procedure(Name: WideString; var Cancel: Boolean) of object;
51 TOnTravelToEvent = procedure(OffSet: Integer; var Cancel: Boolean) of object;
52
53 TIETravelLog = class(TComponent)
54 private
55 { Private declarations }
56 FAbout: string;
57 FEmbeddedWB: TEmbeddedWB;
58 FEnabled: Boolean;
59 fOnEntry: TOnEntryEvent;
60 FOnGetCount: TOnGetCountEvent;
61 FOnRemoveEntry: TOnRemoveEntryEvent;
62 FOnTravelTo: TOnTravelToEvent;
63 procedure SetAbout(const Value: string);
64 protected
65 { Protected declarations }
66 Entry: ITravelLogEntry;
67 Enum: IEnumTravelLogEntry;
68 Stg: ITravelLogStg;
69 procedure _Enumerate(Flags: Cardinal);
70 public
71 { Public declarations }
72 constructor Create(AOwner: TComponent); override;
73 function Connect: Boolean;
74 function CreateEntry(const OffSet: Integer; const Url, Title: WideString): HRESULT;
75 function GetCount(Flags: DWORD; out Entries: DWORD): HRESULT;
76 function GetRelativeEntry(OffSet: Integer; out Title, Url: WideString): HRESULT;
77 function RemoveEntry(OffSet: Integer): HRESULT;
78 function RemoveEntryByTitle(const Title: WideString): HRESULT;
79 function RemoveEntryByUrl(const Url: WideString): HRESULT;
80 function TravelTo(OffSet: Integer): HRESULT;
81 procedure ClearSession;
82 procedure Enumerate;
83 procedure EnumerateBack;
84 procedure EnumerateForward;
85 published
86 { Published declarations }
87 property About: string read FAbout write SetAbout;
88 property EmbeddedWB: TEmbeddedWB read FEmbeddedWB write FEmbeddedWB;
89 property OnEntry: TOnEntryEvent read fOnEntry write fOnEntry;
90 property OnGetCount: TOnGetCountEvent read FOnGetCount write FOnGetCount;
91 property OnRemoveEntry: TOnRemoveEntryEvent read FOnRemoveEntry write FOnRemoveEntry;
92 property OnTravelTo: TOnTravelToEvent read FOnTravelTo write FOnTravelTo;
93 property Enabled: boolean read FEnabled write FEnabled default True;
94 end;
95
96implementation
97
98{ TIETravelLog }
99
100constructor TIETravelLog.Create(AOwner: TComponent);
101
102begin
103 inherited Create(AOwner);
104 FAbout := 'TIETravelLog. ' + WEB_SITE;
105 FEnabled := True;
106end;
107
108procedure TIETravelLog.SetAbout(const Value: string);
109begin
110 Exit;
111end;
112
113function TIETravelLog.TravelTo(OffSet: Integer): HRESULT;
114var
115 Cancel: Boolean;
116begin
117 Cancel := False;
118 Result := S_False;
119 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) and
120 (Stg.GetRelativeEntry(OffSet, Entry) = S_OK) then
121 begin
122 if Assigned(FOnTravelTo) then
123 FOnTravelTo(OffSet, Cancel);
124 end;
125 if not Cancel then
126 Result := Stg.TravelTo(Entry);
127end;
128
129procedure TIETravelLog._Enumerate(Flags: Cardinal);
130var
131 Cancel: Boolean;
132 Fetched: Cardinal;
133 Url, Title: PWideChar;
134begin
135 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) then
136 begin
137 Cancel := False;
138 Stg.EnumEntries(Flags, Enum);
139 if Enum <> nil then
140 while (Enum.next(1, Entry, Fetched) = S_OK) and not Cancel do
141 begin
142 if Assigned(fOnEntry) and Succeeded(Entry.GetTitle(Title)) and Succeeded(Entry.GetUrl(Url)) then
143 fOnEntry(Title, Url, Cancel);
144 end;
145 end;
146end;
147
148procedure TIETravelLog.EnumerateBack;
149begin
150 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) then
151 _Enumerate(TLEF_RELATIVE_BACK);
152end;
153
154procedure TIETravelLog.EnumerateForward;
155begin
156 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) then
157 _Enumerate(TLEF_RELATIVE_FORE);
158end;
159
160function TIETravelLog.Connect: Boolean;
161var
162 ISP: IServiceProvider;
163begin
164 Result := False;
165 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) then
166 begin
167 if Succeeded(EmbeddedWB.Application.QueryInterface(IServiceprovider, ISP)) and
168 Succeeded(ISP.QueryService(SID_STravelLogCursor, IID_ITravelLogStg, Stg)) then
169 Result := True;
170 end;
171end;
172
173function TIETravelLog.GetRelativeEntry(OffSet: Integer; out Title, Url: WideString): HRESULT;
174var
175 WUrl, WTitle: PWideChar;
176begin
177 Result := S_False;
178 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) then
179 Result := Stg.GetRelativeEntry(OffSet, Entry);
180 if Result = S_OK then
181 begin
182 if Succeeded(Entry.GetTitle(WTitle)) then
183 Title := WTitle;
184 if Succeeded(Entry.GetUrl(WUrl)) then
185 Url := WUrl;
186 end;
187end;
188
189function TIETravelLog.GetCount(Flags: DWORD; out Entries: DWORD): HRESULT;
190begin
191 Result := S_False;
192 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) then
193 begin
194 Result := Stg.GetCount(Flags, Entries);
195 if Assigned(FOnGetCount) then
196 FOnGetCount(Flags, Entries);
197 end;
198end;
199
200function TIETravelLog.CreateEntry(const OffSet: Integer; const Url, Title: WideString): HRESULT;
201var
202 Dummy: ITravelLogEntry;
203begin
204 Result := S_False;
205 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) and
206 (Stg.GetRelativeEntry(OffSet, Entry) = S_OK)
207 then
208 Result := Stg.CreateEntry(StringToOleStr(Url), StringToOleStr(Title), Entry, TRUE, Dummy)
209end;
210
211procedure TIETravelLog.Enumerate;
212begin
213 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) then
214 _Enumerate(TLEF_ABSOLUTE);
215end;
216
217function TIETravelLog.RemoveEntry(OffSet: Integer): HRESULT;
218var
219 Title, Url: WideString;
220 Cancel: Boolean;
221begin
222 Cancel := False;
223 Result := S_False;
224 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) and
225 (GetRelativeEntry(OffSet, Title, Url) = S_OK) then
226 begin
227 if Assigned(FOnRemoveEntry) then
228 FOnRemoveEntry(Title, Cancel);
229 if not Cancel then
230 Result := RemoveEntryByUrl(Url);
231 end;
232end;
233
234function TIETravelLog.RemoveEntryByTitle(const Title: WideString): HRESULT;
235var
236 Fetched: Cardinal;
237 pTitle: PWideChar;
238 Cancel: Boolean;
239begin
240 Cancel := False;
241 Result := S_False;
242 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) and
243 (Stg.EnumEntries(TLEF_ABSOLUTE, Enum) = S_OK) then
244 while (Enum.next(1, Entry, Fetched) = S_OK) do
245 begin
246 if Succeeded(Entry.GetTitle(pTitle)) and (Title = pTitle) then
247 begin
248 if Assigned(FOnRemoveEntry) then
249 FOnRemoveEntry(Title, Cancel);
250 if not Cancel then
251 Result := Stg.RemoveEntry(Entry);
252 end;
253 end;
254end;
255
256function TIETravelLog.RemoveEntryByUrl(const Url: WideString): HRESULT;
257var
258 Fetched: Cardinal;
259 pUrl: PWideChar;
260 Cancel: Boolean;
261begin
262 Cancel := False;
263 Result := S_False;
264 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) and
265 (Stg.EnumEntries(TLEF_ABSOLUTE, Enum) = S_OK)
266 then
267 while (Enum.next(1, Entry, Fetched) = S_OK) do
268 begin
269 if Succeeded(Entry.GetUrl(pUrl)) and (Url = pUrl) then
270 begin
271 if Assigned(FOnRemoveEntry) then
272 FOnRemoveEntry(Url, Cancel);
273 if not Cancel then
274 Result := Stg.RemoveEntry(Entry);
275 end;
276 end;
277end;
278
279procedure TIETravelLog.ClearSession;
280var
281 Fetched: Cardinal;
282begin
283 if FEnabled and Assigned(EmbeddedWB) and Assigned(EmbeddedWB.Document) and
284 (Stg.EnumEntries(TLEF_ABSOLUTE, Enum) = S_OK) then
285 while (Enum.Next(1, Entry, Fetched) = S_OK) do
286 Stg.RemoveEntry(Entry);
287end;
288
289end.
Note: See TracBrowser for help on using the repository browser.