File arlan.pas added (mode: 100755) (index 0000000..0978a58) |
|
1 |
|
// ArLan: Simple Gopher client for AROS |
|
2 |
|
// I am <ger-alex@seznam.cz> |
|
3 |
|
// |
|
4 |
|
// Can't believe I dived into it |
|
5 |
|
// Never (well, almost) programmed anything |
|
6 |
|
// nether in Pascal, nor for AROS. |
|
7 |
|
// |
|
8 |
|
// |
|
9 |
|
// |
|
10 |
|
// LICENSE: So, this mess can be used under |
|
11 |
|
// conditions of any of these licences: |
|
12 |
|
// MIT, BSD, WTF |
|
13 |
|
// |
|
14 |
|
program arlan; |
|
15 |
|
{$mode objfpc}{$H+} |
|
16 |
|
|
|
17 |
|
|
|
18 |
|
uses |
|
19 |
|
SysUtils, |
|
20 |
|
StrUtils, |
|
21 |
|
Classes, |
|
22 |
|
//Types, |
|
23 |
|
URIParser, |
|
24 |
|
|
|
25 |
|
misc, doublelinked, |
|
26 |
|
|
|
27 |
|
mui, |
|
28 |
|
MUIClass.Base, |
|
29 |
|
MUIClass.Window, |
|
30 |
|
MUIClass.Gadget, |
|
31 |
|
MUIClass.Group, |
|
32 |
|
MUIClass.Area, |
|
33 |
|
|
|
34 |
|
Exec, |
|
35 |
|
//Amigados, mui, muihelper, utility, intuition, AGraphics, |
|
36 |
|
MUIClass.Menu, |
|
37 |
|
MUIClass.List, |
|
38 |
|
//MUIClass.Numeric, MUIClass.PopString, MUIClass.DrawPanel, MUIClass.Image, |
|
39 |
|
MUIClass.Dialog; |
|
40 |
|
|
|
41 |
|
|
|
42 |
|
type |
|
43 |
|
{ // defined in doublelinked |
|
44 |
|
TItem = record |
|
45 |
|
ItemType: char; |
|
46 |
|
DisplayString: string; |
|
47 |
|
Selector: string; |
|
48 |
|
HostName: string; |
|
49 |
|
Port: UInt16; |
|
50 |
|
end; } |
|
51 |
|
TItems = array of TItem; |
|
52 |
|
|
|
53 |
|
|
|
54 |
|
TMyWindow = class(TMUIWindow) |
|
55 |
|
public |
|
56 |
|
Items: TItems; |
|
57 |
|
FixedFont: boolean; |
|
58 |
|
MUIView: TMUIListView; |
|
59 |
|
//PageSource: string; |
|
60 |
|
Bookmarks: TStringList; |
|
61 |
|
GopherMap: TStringList; |
|
62 |
|
History: TDLinkedList; |
|
63 |
|
Txt: TMUIText; |
|
64 |
|
MIPageSource: TMUIMenuItem; |
|
65 |
|
Edit: TMUIString; |
|
66 |
|
SearchEdit: TMUIString; |
|
67 |
|
MUIList: TMUIList; |
|
68 |
|
|
|
69 |
|
SearchWindow: TMUIWindow; |
|
70 |
|
SearchItem: TItem; |
|
71 |
|
MUISearch: TMUIString; |
|
72 |
|
//MyListView: TMUIListView; |
|
73 |
|
|
|
74 |
|
// Events |
|
75 |
|
procedure BookmarksClick(Sender: TObject); |
|
76 |
|
procedure BookmarkItemTrigger(Sender: TObject); |
|
77 |
|
procedure BtnClick(Sender: TObject); |
|
78 |
|
procedure ShowPageSource(Sender: TObject); |
|
79 |
|
//procedure ConfigStart(Sender: TObject); |
|
80 |
|
procedure QuitMe(Sender: TObject); |
|
81 |
|
procedure EditAck(Sender: TObject); |
|
82 |
|
procedure SearchAck(Sender: TObject); |
|
83 |
|
procedure VeronicaSearchAck(Sender: TObject); |
|
84 |
|
procedure About(Sender: TObject); |
|
85 |
|
procedure AboutMUI(Sender: TObject); |
|
86 |
|
|
|
87 |
|
procedure LoadPage(server: string; port: UInt16; selector: string); |
|
88 |
|
procedure ShowText(InputText: string; WTitle: string); |
|
89 |
|
procedure RequireSearch(Item: TItem); |
|
90 |
|
procedure LoadURL(URL: string); |
|
91 |
|
procedure LoadItem(activeItem: TItem); |
|
92 |
|
function ParseMap(InputText: string): TItems; |
|
93 |
|
procedure RenderPage(SourceText: string); |
|
94 |
|
|
|
95 |
|
procedure BackClick(Sender: TObject); |
|
96 |
|
procedure ForwardClick(Sender: TObject); |
|
97 |
|
procedure ToggleFont(Sender: TObject); |
|
98 |
|
|
|
99 |
|
function ConstructEvent(Sender: TObject; Pool: Pointer; Str: PChar): PChar; |
|
100 |
|
procedure DestructEvent(Sender: TObject; Pool: Pointer; Entry: PChar); |
|
101 |
|
procedure ListClickEvent(Sender: TObject); |
|
102 |
|
procedure ListDoubleClickEvent(Sender: TObject); |
|
103 |
|
//procedure FinishedReading(Sender: TObject); |
|
104 |
|
|
|
105 |
|
constructor Create; override; |
|
106 |
|
destructor Destroy; override; |
|
107 |
|
|
|
108 |
|
end; |
|
109 |
|
|
|
110 |
|
|
|
111 |
|
|
|
112 |
|
|
|
113 |
|
function ParseLine(InputLine: string): TItem; |
|
114 |
|
var |
|
115 |
|
strs: array of string; |
|
116 |
|
_code: Word; |
|
117 |
|
begin |
|
118 |
|
|
|
119 |
|
with Result do |
|
120 |
|
begin |
|
121 |
|
ItemType := 'q'; |
|
122 |
|
DisplayString := ''; |
|
123 |
|
Selector := ''; |
|
124 |
|
HostName := ''; |
|
125 |
|
//cz na ten port nasrat |
|
126 |
|
end; |
|
127 |
|
if not InputLine.IsEmpty then |
|
128 |
|
begin |
|
129 |
|
Result.ItemType := InputLine[1]; |
|
130 |
|
strs := SplitString(InputLine.Remove(0,1), #9); |
|
131 |
|
if Length(strs) >= 1 then |
|
132 |
|
begin |
|
133 |
|
Result.DisplayString := strs[0]; |
|
134 |
|
end; |
|
135 |
|
if Length(strs) >= 4 then |
|
136 |
|
begin |
|
137 |
|
Result.Selector := strs[1]; |
|
138 |
|
Result.HostName := strs[2]; |
|
139 |
|
Val(strs[3], Result.Port, _code); |
|
140 |
|
end; |
|
141 |
|
end; |
|
142 |
|
end; |
|
143 |
|
|
|
144 |
|
{ |
|
145 |
|
function ParseMap(InputText: string): TItems; |
|
146 |
|
var |
|
147 |
|
str: string; |
|
148 |
|
i: word; |
|
149 |
|
strList: TStringList; |
|
150 |
|
//Items: TItems; |
|
151 |
|
begin |
|
152 |
|
strList := TStringList.Create; |
|
153 |
|
StrList.Text := InputText; |
|
154 |
|
SetLength(Result, StrList.Count); |
|
155 |
|
i := 0; |
|
156 |
|
while i < StrList.Count do |
|
157 |
|
begin |
|
158 |
|
str := StrList.Strings[i]; |
|
159 |
|
Result[i] := ParseLine(str); |
|
160 |
|
inc(i); |
|
161 |
|
end; |
|
162 |
|
StrList.Free; |
|
163 |
|
//Result := Items; |
|
164 |
|
end; |
|
165 |
|
} |
|
166 |
|
|
|
167 |
|
|
|
168 |
|
|
|
169 |
|
|
|
170 |
|
|
|
171 |
|
constructor TMyWindow.Create; |
|
172 |
|
var |
|
173 |
|
// not neeeded later |
|
174 |
|
Men: TMUIMenu; |
|
175 |
|
WoMen: TMUIMenu; |
|
176 |
|
Pnl: TMUIGroup; |
|
177 |
|
MM: TMUIMenuStrip; |
|
178 |
|
MML: TMUIMenuStrip; |
|
179 |
|
//i: Integer; |
|
180 |
|
FirstItem: TItem; |
|
181 |
|
begin |
|
182 |
|
inherited; |
|
183 |
|
Bookmarks := TStringList.Create; |
|
184 |
|
try |
|
185 |
|
Bookmarks.LoadFromFile('Bookmarks'); |
|
186 |
|
except |
|
187 |
|
end; |
|
188 |
|
|
|
189 |
|
|
|
190 |
|
GopherMap := TStringList.Create; |
|
191 |
|
|
|
192 |
|
//cz hned na zacatku vytvorime History |
|
193 |
|
//cz a je po ptakach |
|
194 |
|
with FirstItem do |
|
195 |
|
begin |
|
196 |
|
ItemType := '1'; |
|
197 |
|
DisplayString := 'Floodgap'; |
|
198 |
|
Selector := ''; |
|
199 |
|
HostName := 'gopher.floodgap.com'; |
|
200 |
|
Port := 70; |
|
201 |
|
end; |
|
202 |
|
History := TDLinkedList.Create(FirstItem); |
|
203 |
|
//SizeGadget := False; // Disable SizeGadget |
|
204 |
|
|
|
205 |
|
Title := ''; |
|
206 |
|
ScreenTitle := 'ArLan: simple Gopher client'; |
|
207 |
|
Height := 600; |
|
208 |
|
Width := 500; |
|
209 |
|
|
|
210 |
|
//Horizontal := False; |
|
211 |
|
|
|
212 |
|
Pnl := TMUIGroup.Create; |
|
213 |
|
Pnl.Horiz := True; |
|
214 |
|
Pnl.Parent := Self; |
|
215 |
|
|
|
216 |
|
with TMUIButton.Create('<-') do |
|
217 |
|
begin |
|
218 |
|
OnClick := @BackClick; |
|
219 |
|
FixWidth := 20; |
|
220 |
|
//ShortHelp := 'This is a Button. ;-)'; |
|
221 |
|
Parent := Pnl; |
|
222 |
|
end; |
|
223 |
|
|
|
224 |
|
with TMUIButton.Create('->') do |
|
225 |
|
begin |
|
226 |
|
OnClick := @ForwardClick; |
|
227 |
|
FixWidth := 20; |
|
228 |
|
//ShortHelp := 'This is a Button. ;-)'; |
|
229 |
|
Parent := Pnl; |
|
230 |
|
end; |
|
231 |
|
|
|
232 |
|
with TMUIButton.Create('Bookmarks') do |
|
233 |
|
begin |
|
234 |
|
OnClick := @BookmarksClick; |
|
235 |
|
FixWidth := 28; |
|
236 |
|
//ShortHelp := 'This is a Button. ;-)'; |
|
237 |
|
Parent := Pnl; |
|
238 |
|
end; |
|
239 |
|
|
|
240 |
|
Edit := TMUIString.Create; |
|
241 |
|
with Edit do |
|
242 |
|
begin |
|
243 |
|
//Secret := True; |
|
244 |
|
OnAcknowledge := @EditAck; |
|
245 |
|
Format := MUIV_String_Format_Center; |
|
246 |
|
Contents := 'gopher://gopher.floodgap.com'; |
|
247 |
|
Parent := Pnl; |
|
248 |
|
end; |
|
249 |
|
//cz nefrci, crash |
|
250 |
|
//DefaultObject := Edit; |
|
251 |
|
|
|
252 |
|
{ |
|
253 |
|
with TMUIBalance.Create do |
|
254 |
|
begin |
|
255 |
|
FixWidth := 8; |
|
256 |
|
Parent := Pnl; |
|
257 |
|
end; |
|
258 |
|
} |
|
259 |
|
|
|
260 |
|
{ |
|
261 |
|
with TMUIButton.Create('Go') do |
|
262 |
|
begin |
|
263 |
|
OnClick := @BtnClick; |
|
264 |
|
FixWidth := 28; |
|
265 |
|
//ShortHelp := 'This is a Button. ;-)'; |
|
266 |
|
Parent := Pnl; |
|
267 |
|
end; |
|
268 |
|
} |
|
269 |
|
|
|
270 |
|
With TMUIText.Create do |
|
271 |
|
begin |
|
272 |
|
Contents := 'Veronica-2 search:'; |
|
273 |
|
FixWidth := 28; |
|
274 |
|
Parent := Pnl; |
|
275 |
|
end; |
|
276 |
|
|
|
277 |
|
SearchEdit := TMUIString.Create; |
|
278 |
|
with SearchEdit do |
|
279 |
|
begin |
|
280 |
|
OnAcknowledge := @VeronicaSearchAck; |
|
281 |
|
//Format := MUIV_String_Format_Center; |
|
282 |
|
//Contents := ''; |
|
283 |
|
FixWidth := 58; |
|
284 |
|
Parent := Pnl; |
|
285 |
|
end; |
|
286 |
|
|
|
287 |
|
//TMUIHBar.Create(11).Parent := Self; |
|
288 |
|
|
|
289 |
|
|
|
290 |
|
|
|
291 |
|
|
|
292 |
|
|
|
293 |
|
|
|
294 |
|
|
|
295 |
|
MM := TMUIMenuStrip.Create; |
|
296 |
|
|
|
297 |
|
MUIApp.MenuStrip := MM; // alternative on the application, activate only one! |
|
298 |
|
//Menustrip := MM; |
|
299 |
|
|
|
300 |
|
Men := TMUIMenu.Create; |
|
301 |
|
Men.Title := 'Menu'; |
|
302 |
|
Men.Parent := MM; |
|
303 |
|
|
|
304 |
|
{ |
|
305 |
|
With TMUIMenuItem.Create do |
|
306 |
|
begin |
|
307 |
|
Title := 'Page source'; |
|
308 |
|
Parent := Men; |
|
309 |
|
OnTrigger := @ShowPageSource; |
|
310 |
|
end; |
|
311 |
|
} |
|
312 |
|
{ |
|
313 |
|
With TMUIMenuItem.Create do |
|
314 |
|
begin |
|
315 |
|
Title := 'Font setup...'; |
|
316 |
|
Parent := Men; |
|
317 |
|
//OnTrigger := @FontSetup; |
|
318 |
|
end; |
|
319 |
|
} |
|
320 |
|
|
|
321 |
|
With TMUIMenuItem.Create do |
|
322 |
|
begin |
|
323 |
|
Title := 'Toggle fixed font'; |
|
324 |
|
Parent := Men; |
|
325 |
|
OnTrigger := @ToggleFont; |
|
326 |
|
end; |
|
327 |
|
|
|
328 |
|
With TMUIMenuItem.Create do |
|
329 |
|
begin |
|
330 |
|
Title := 'About...'; |
|
331 |
|
Parent := Men; |
|
332 |
|
OnTrigger := @About; |
|
333 |
|
end; |
|
334 |
|
|
|
335 |
|
With TMUIMenuItem.Create do |
|
336 |
|
begin |
|
337 |
|
Title := 'About MUI...'; |
|
338 |
|
Parent := Men; |
|
339 |
|
OnTrigger := @AboutMUI; |
|
340 |
|
end; |
|
341 |
|
|
|
342 |
|
with TMUIMenuItem.Create do |
|
343 |
|
begin |
|
344 |
|
Title := 'Quit'; |
|
345 |
|
Parent := Men; |
|
346 |
|
OnTrigger := @QuitMe; |
|
347 |
|
end; |
|
348 |
|
|
|
349 |
|
|
|
350 |
|
{ |
|
351 |
|
Pop := TMUIPopList.Create; |
|
352 |
|
with Pop do |
|
353 |
|
begin |
|
354 |
|
LArray := ['hello', 'Hello2', 'Hello3']; |
|
355 |
|
StringObj := TMUIString.Create; |
|
356 |
|
Button := TMUIPopButton.Create; |
|
357 |
|
//Button.FixWidth := 20; |
|
358 |
|
Parent := self; |
|
359 |
|
end; |
|
360 |
|
} |
|
361 |
|
|
|
362 |
|
|
|
363 |
|
FixedFont := True; |
|
364 |
|
MUIList := TMUIList.Create; |
|
365 |
|
with MUIList do |
|
366 |
|
begin |
|
367 |
|
//SourceStrings := ['one', 'two', 'three', 'four', 'five', 'six', 'seven']; |
|
368 |
|
//MinLineHeight := 100; |
|
369 |
|
Font := MUIV_Font_Fixed; |
|
370 |
|
OnConstruct := @ConstructEvent; |
|
371 |
|
OnDestruct := @DestructEvent; |
|
372 |
|
//OnDisplay := @DisplayEvent; |
|
373 |
|
//OnCompare := @CompareEvent; |
|
374 |
|
//OnMultiTest := @MultiTestEvent; |
|
375 |
|
//OnChange := @ListClickEvent; |
|
376 |
|
//OnActiveChange := @ListClickEvent; |
|
377 |
|
end; |
|
378 |
|
|
|
379 |
|
MML := TMUIMenuStrip.Create; |
|
380 |
|
MUIList.ContextMenu := MML; |
|
381 |
|
|
|
382 |
|
WoMen := TMUIMenu.Create; |
|
383 |
|
WoMen.Title := 'Menu'; |
|
384 |
|
WoMen.Parent := MML; |
|
385 |
|
{ |
|
386 |
|
With TMUIMenuItem.Create do |
|
387 |
|
begin |
|
388 |
|
Title := 'Toggle fixed font'; |
|
389 |
|
Parent := WoMen; |
|
390 |
|
OnTrigger := @ToggleFont; |
|
391 |
|
end; |
|
392 |
|
} |
|
393 |
|
|
|
394 |
|
|
|
395 |
|
With TMUIMenuItem.Create do |
|
396 |
|
begin |
|
397 |
|
Title := 'Page source...'; |
|
398 |
|
Parent := WoMen; |
|
399 |
|
OnTrigger := @ShowPageSource; |
|
400 |
|
end; |
|
401 |
|
|
|
402 |
|
With TMUIMenuItem.Create do |
|
403 |
|
begin |
|
404 |
|
Title := 'Bookmark item'; |
|
405 |
|
Parent := WoMen; |
|
406 |
|
OnTrigger := @BookmarkItemTrigger; |
|
407 |
|
end; |
|
408 |
|
{ |
|
409 |
|
With TMUIMenuItem.Create do |
|
410 |
|
begin |
|
411 |
|
Title := 'Save to file...'; |
|
412 |
|
Parent := WoMen; |
|
413 |
|
//OnTrigger := @SavePage; |
|
414 |
|
end; |
|
415 |
|
} |
|
416 |
|
|
|
417 |
|
MUIView := TMUIListView.Create; |
|
418 |
|
with MUIView do |
|
419 |
|
begin |
|
420 |
|
List := MUIList; |
|
421 |
|
Parent := Self; |
|
422 |
|
|
|
423 |
|
MultiSelect := MUIV_Listview_MultiSelect_Default; |
|
424 |
|
OnClick := @ListClickEvent; |
|
425 |
|
OnDoubleClick := @ListDoubleClickEvent; |
|
426 |
|
end; |
|
427 |
|
|
|
428 |
|
|
|
429 |
|
|
|
430 |
|
Txt := TMUIText.Create; |
|
431 |
|
With Txt do |
|
432 |
|
begin |
|
433 |
|
Contents := ''; |
|
434 |
|
//HiChar := 'C'; |
|
435 |
|
SetVMax := True; |
|
436 |
|
//Font := MUIV_Font_Fixed; |
|
437 |
|
Parent := Self; |
|
438 |
|
end; |
|
439 |
|
|
|
440 |
|
|
|
441 |
|
SearchWindow := TMUIWindow.Create; |
|
442 |
|
SearchWindow.Title := 'Gopher search'; |
|
443 |
|
SearchWIndow.Close; |
|
444 |
|
|
|
445 |
|
|
|
446 |
|
With TMUIText.Create do |
|
447 |
|
begin |
|
448 |
|
Contents := 'Enter search line';//Item.DisplayString; |
|
449 |
|
//Font := MUIV_Font_Fixed; |
|
450 |
|
Parent := SearchWindow; |
|
451 |
|
end; |
|
452 |
|
|
|
453 |
|
|
|
454 |
|
MUISearch := TMUIString.Create; |
|
455 |
|
with MUISearch do |
|
456 |
|
begin |
|
457 |
|
//Secret := True; |
|
458 |
|
OnAcknowledge := @SearchAck; |
|
459 |
|
//Format := MUIV_String_Format_Center; |
|
460 |
|
//Contents := 'Edit me and press enter'; |
|
461 |
|
Parent := SearchWindow; |
|
462 |
|
end; |
|
463 |
|
|
|
464 |
|
|
|
465 |
|
//RenderPage(Bookmarks.Text); |
|
466 |
|
end; |
|
467 |
|
|
|
468 |
|
|
|
469 |
|
destructor TMyWindow.Destroy; |
|
470 |
|
begin |
|
471 |
|
//GopherMap.Free; |
|
472 |
|
FreeAndNil(Bookmarks); |
|
473 |
|
FreeAndNil(GopherMap); |
|
474 |
|
FreeAndNil(History); |
|
475 |
|
//SearchWindow.Destroy; |
|
476 |
|
inherited; |
|
477 |
|
end; |
|
478 |
|
|
|
479 |
|
function TMyWindow.ParseMap(InputText: string): TItems; |
|
480 |
|
var |
|
481 |
|
str: string; |
|
482 |
|
i: word; |
|
483 |
|
//strList: TStringList; |
|
484 |
|
//Items: TItems; |
|
485 |
|
begin |
|
486 |
|
//strList := TStringList.Create; |
|
487 |
|
GopherMap.Text := InputText; |
|
488 |
|
SetLength(Result, GopherMap.Count); |
|
489 |
|
i := 0; |
|
490 |
|
while i < GopherMap.Count do |
|
491 |
|
begin |
|
492 |
|
str := GopherMap.Strings[i]; |
|
493 |
|
Result[i] := ParseLine(str); |
|
494 |
|
inc(i); |
|
495 |
|
end; |
|
496 |
|
//StrList.Free; |
|
497 |
|
//Result := Items; |
|
498 |
|
end; |
|
499 |
|
|
|
500 |
|
|
|
501 |
|
procedure TMyWindow.BtnClick(Sender: TObject); |
|
502 |
|
begin |
|
503 |
|
//writeln('button clicked'); |
|
504 |
|
LoadURL(Edit.Contents); |
|
505 |
|
end; |
|
506 |
|
|
|
507 |
|
procedure TMyWindow.BookmarksClick(Sender: TObject); |
|
508 |
|
begin |
|
509 |
|
RenderPage(Bookmarks.Text); |
|
510 |
|
end; |
|
511 |
|
|
|
512 |
|
procedure TMyWindow.LoadPage(server: string; port: UInt16; selector: string); |
|
513 |
|
begin |
|
514 |
|
RenderPage(Fetch(server, port, selector)); |
|
515 |
|
end; |
|
516 |
|
|
|
517 |
|
|
|
518 |
|
procedure TMyWindow.RenderPage(SourceText: string); |
|
519 |
|
var |
|
520 |
|
dstr: string; |
|
521 |
|
i: word; |
|
522 |
|
nullstr: PChar; |
|
523 |
|
begin |
|
524 |
|
//PageSource := Fetch(server, port, selector); |
|
525 |
|
Items := ParseMap(SourceText); |
|
526 |
|
//writeln('We have got the Items!'); |
|
527 |
|
MUIList.Quiet := True; |
|
528 |
|
MUIList.Clear; |
|
529 |
|
i := 0; |
|
530 |
|
|
|
531 |
|
//writeln(Items[0].DisplayString); |
|
532 |
|
//writeln('start cyklus'); |
|
533 |
|
while i < Length(Items) do |
|
534 |
|
begin |
|
535 |
|
//writeln('we are inside'); |
|
536 |
|
//writeln(i); |
|
537 |
|
dstr := Items[i].DisplayString; |
|
538 |
|
// esc 2 - black |
|
539 |
|
// esc 3 - white |
|
540 |
|
// esc 4 - black |
|
541 |
|
// esc 5 - light blue |
|
542 |
|
// esc 6 - black |
|
543 |
|
// esc 7 - gray |
|
544 |
|
// esc 8 - white |
|
545 |
|
// esc 9 - black |
|
546 |
|
case Items[i].ItemType of |
|
547 |
|
'i': ; // just text |
|
548 |
|
'0': dstr := #27'u' + dstr + #27'n '; // link to text file: black underlined |
|
549 |
|
'1': dstr := #27'5' + #27'u' + dstr + #27'n ';//gopher link: blue underlined |
|
550 |
|
'7': dstr := #27'5' + #27'b' + dstr + #27'n ';//gopher search: blue bolded |
|
551 |
|
'h': dstr := #27'7' + #27'u' + dstr + #27'n ';//http(s): greyed underlined |
|
552 |
|
'2', '3', '8', '+', 'T': dstr := #27'i' + dstr + #27'n ';//telnet etc.. italic |
|
553 |
|
else dstr := #27'b' + dstr + #27'n ';// everythink else (typically some files) - black bolded |
|
554 |
|
end; |
|
555 |
|
nullstr := stralloc(Length(dstr)); |
|
556 |
|
MUIList.InsertSingle(strpcopy(nullstr, dstr), MUIV_List_Insert_Bottom); |
|
557 |
|
inc(i); |
|
558 |
|
end; |
|
559 |
|
MUIList.Quiet := False; |
|
560 |
|
//MUIList.Redraw(MUIV_List_Redraw_All); |
|
561 |
|
end; |
|
562 |
|
|
|
563 |
|
|
|
564 |
|
procedure TMyWindow.ShowText(InputText: string; WTitle: string); |
|
565 |
|
var |
|
566 |
|
w2: TMUIWindow; |
|
567 |
|
begin |
|
568 |
|
W2 := TMUIWindow.Create; |
|
569 |
|
W2.Title := WTitle; |
|
570 |
|
W2.Height := 500; |
|
571 |
|
W2.Width := 400; |
|
572 |
|
|
|
573 |
|
with TMUIFloatText.Create do |
|
574 |
|
begin |
|
575 |
|
//cz zlobi |
|
576 |
|
//SkipChars := #1#13; |
|
577 |
|
Text := InputText.Replace(#13#10, #10); |
|
578 |
|
if FixedFont then |
|
579 |
|
Font := MUIV_Font_Fixed |
|
580 |
|
else |
|
581 |
|
Font := MUIV_Font_Normal; |
|
582 |
|
Parent := W2; |
|
583 |
|
end; |
|
584 |
|
W2.Show; |
|
585 |
|
end; |
|
586 |
|
|
|
587 |
|
procedure TMyWindow.RequireSearch(Item: TItem); |
|
588 |
|
begin |
|
589 |
|
SearchItem := Item; |
|
590 |
|
SearchWindow.Show; |
|
591 |
|
end; |
|
592 |
|
|
|
593 |
|
procedure TMyWindow.LoadURL(URL: string); |
|
594 |
|
var |
|
595 |
|
URI : TURI; |
|
596 |
|
selector: string; |
|
597 |
|
NewItem : TItem; |
|
598 |
|
begin |
|
599 |
|
Title := URL; |
|
600 |
|
|
|
601 |
|
URI := ParseURI(URL, 'gopher', 70, True); |
|
602 |
|
selector := URI.Path + URI.Document; |
|
603 |
|
if not URI.Params.IsEmpty then |
|
604 |
|
begin |
|
605 |
|
selector := selector + '?' + URI.Params; |
|
606 |
|
end; |
|
607 |
|
|
|
608 |
|
with NewItem do |
|
609 |
|
begin |
|
610 |
|
ItemType := '1'; |
|
611 |
|
DisplayString := URL; |
|
612 |
|
Selector := selector; |
|
613 |
|
HostName := URI.Host; |
|
614 |
|
Port := URI.Port; |
|
615 |
|
end; |
|
616 |
|
History.Insert(NewItem); |
|
617 |
|
|
|
618 |
|
LoadPage(URI.Host, URI.Port, selector); |
|
619 |
|
end; |
|
620 |
|
|
|
621 |
|
|
|
622 |
|
|
|
623 |
|
procedure TMyWindow.ToggleFont(Sender: TObject); |
|
624 |
|
begin |
|
625 |
|
MUIView.InitChange; |
|
626 |
|
if FixedFont then |
|
627 |
|
begin |
|
628 |
|
MUIView.Font := MUIV_Font_Normal; |
|
629 |
|
MUIList.Font := MUIV_Font_Normal; |
|
630 |
|
FixedFont := False; |
|
631 |
|
end |
|
632 |
|
else |
|
633 |
|
begin |
|
634 |
|
MUIView.Font := MUIV_Font_Fixed; |
|
635 |
|
MUIList.Font := MUIV_Font_Fixed; |
|
636 |
|
FixedFont := True; |
|
637 |
|
end; |
|
638 |
|
|
|
639 |
|
MUIView.ExitChange; |
|
640 |
|
MUIList.Redraw(MUIV_List_Redraw_All); |
|
641 |
|
end; |
|
642 |
|
|
|
643 |
|
|
|
644 |
|
|
|
645 |
|
procedure TMyWindow.About(Sender: TObject); |
|
646 |
|
var |
|
647 |
|
Ret: integer; |
|
648 |
|
begin |
|
649 |
|
Ret := MessageBox('ArLan', 'Simple Gopher client for AROS'+ #10 + |
|
650 |
|
'gopher://smol.pub/iam/arlan' + #10 + |
|
651 |
|
'e-mail: ger-alex@seznam.cz', ['Homepage', 'OK, Thanks']); |
|
652 |
|
if Ret = 1 then |
|
653 |
|
begin |
|
654 |
|
Title := 'ArLan homepage'; |
|
655 |
|
Edit.Contents := 'gopher://smol.pub/iam/arlan'; |
|
656 |
|
LoadPage('smol.pub', 70, '/iam/arlan'); |
|
657 |
|
end; |
|
658 |
|
|
|
659 |
|
end; |
|
660 |
|
|
|
661 |
|
procedure TMyWindow.AboutMUI(Sender: TObject); |
|
662 |
|
begin |
|
663 |
|
MUIApp.AboutMUI(Self); |
|
664 |
|
//MUIApp.OpenConfigWindow; |
|
665 |
|
end; |
|
666 |
|
|
|
667 |
|
|
|
668 |
|
|
|
669 |
|
procedure TMyWindow.QuitMe(Sender: TObject); |
|
670 |
|
begin |
|
671 |
|
MUIApp.Terminate; |
|
672 |
|
end; |
|
673 |
|
|
|
674 |
|
|
|
675 |
|
procedure TMyWindow.ShowPageSource(Sender: TObject); |
|
676 |
|
begin |
|
677 |
|
ShowText(GopherMap.Text, Edit.Contents); |
|
678 |
|
end; |
|
679 |
|
|
|
680 |
|
|
|
681 |
|
|
|
682 |
|
|
|
683 |
|
procedure TMyWindow.EditAck(Sender: TObject); |
|
684 |
|
begin |
|
685 |
|
//Txt.Contents := 'Enter pressed in Edit: "' + Edit.Contents + '"'; |
|
686 |
|
LoadURL(Edit.Contents); |
|
687 |
|
end; |
|
688 |
|
|
|
689 |
|
procedure TMyWindow.SearchAck(Sender: TObject); |
|
690 |
|
begin |
|
691 |
|
Title := MUISearch.Contents; |
|
692 |
|
//Edit.Contents := EncodeURI(URL); |
|
693 |
|
LoadPage(SearchItem.HostName, SearchItem.Port, SearchItem.Selector + #9 + MUISearch.Contents ); |
|
694 |
|
end; |
|
695 |
|
|
|
696 |
|
procedure TMyWindow.VeronicaSearchAck(Sender: TObject); |
|
697 |
|
begin |
|
698 |
|
Title := SearchEdit.Contents; |
|
699 |
|
//Edit.Contents := EncodeURI(URL); |
|
700 |
|
LoadPage('gopher.floodgap.com', 70, '/v2/vs' + #9 + SearchEdit.Contents ); |
|
701 |
|
end; |
|
702 |
|
|
|
703 |
|
function TMyWindow.ConstructEvent(Sender: TObject; Pool: Pointer; Str: PChar): PChar; |
|
704 |
|
begin |
|
705 |
|
|
|
706 |
|
Result := AllocPooled(Pool, StrLen(Str) + 1); |
|
707 |
|
if Assigned(Result) then |
|
708 |
|
StrCopy(Result, Str); |
|
709 |
|
end; |
|
710 |
|
|
|
711 |
|
procedure TMyWindow.DestructEvent(Sender: TObject; Pool: Pointer; Entry: PChar); |
|
712 |
|
begin |
|
713 |
|
FreePooled(Pool, Entry, StrLen(Entry) + 1); |
|
714 |
|
end; |
|
715 |
|
|
|
716 |
|
|
|
717 |
|
procedure TMyWindow.ListClickEvent(Sender: TObject); |
|
718 |
|
var |
|
719 |
|
i: word; |
|
720 |
|
begin |
|
721 |
|
if MUIList.Active <> MUIV_List_Active_Off then |
|
722 |
|
begin |
|
723 |
|
i := MUIList.Active; |
|
724 |
|
Txt.Contents := GopherMap.Strings[i]; |
|
725 |
|
end; |
|
726 |
|
end; |
|
727 |
|
|
|
728 |
|
procedure TMyWindow.BackClick(Sender: TObject); |
|
729 |
|
begin |
|
730 |
|
LoadItem(History.MoveBack); |
|
731 |
|
end; |
|
732 |
|
|
|
733 |
|
procedure TMyWindow.ListDoubleClickEvent(Sender: TObject); |
|
734 |
|
var |
|
735 |
|
i: word; |
|
736 |
|
activeItem: TItem; |
|
737 |
|
begin |
|
738 |
|
i := MUIList.Active; |
|
739 |
|
activeItem := Items[i]; |
|
740 |
|
if activeItem.ItemType = '1' then |
|
741 |
|
History.Insert(activeItem); |
|
742 |
|
LoadItem(activeItem); |
|
743 |
|
end; |
|
744 |
|
|
|
745 |
|
procedure TMyWindow.BookmarkItemTrigger(Sender: TObject); |
|
746 |
|
var |
|
747 |
|
i: word; |
|
748 |
|
begin |
|
749 |
|
i := MUIList.Active; |
|
750 |
|
Bookmarks.add(GopherMap.Strings[i]); |
|
751 |
|
try |
|
752 |
|
// And write the contents back to disk, replacing the original contents |
|
753 |
|
Bookmarks.SaveToFile('Bookmarks'); |
|
754 |
|
|
|
755 |
|
except |
|
756 |
|
// If there was an error the reason can be found here |
|
757 |
|
on E: EInOutError do |
|
758 |
|
ShowMessage('File handling error occurred. Reason: ' + E.Message); |
|
759 |
|
end; |
|
760 |
|
|
|
761 |
|
end; |
|
762 |
|
|
|
763 |
|
procedure TMyWindow.ForwardClick(Sender: TObject); |
|
764 |
|
begin |
|
765 |
|
LoadItem(History.MoveForward); |
|
766 |
|
end; |
|
767 |
|
|
|
768 |
|
|
|
769 |
|
procedure TMyWindow.LoadItem(activeItem: TItem); |
|
770 |
|
var |
|
771 |
|
URL: TURI; |
|
772 |
|
it: char; |
|
773 |
|
text: string; |
|
774 |
|
FD: TFileDialog; |
|
775 |
|
|
|
776 |
|
begin |
|
777 |
|
it := activeItem.ItemType; |
|
778 |
|
if (it = '1') or (it = '0') then |
|
779 |
|
begin |
|
780 |
|
with URL do |
|
781 |
|
begin |
|
782 |
|
Protocol := 'gopher'; |
|
783 |
|
Username := ''; |
|
784 |
|
Password := ''; |
|
785 |
|
Host := activeItem.HostName; |
|
786 |
|
Port := activeItem.Port; |
|
787 |
|
Path := activeItem.Selector; |
|
788 |
|
//cz zbytek nechcu resit |
|
789 |
|
Document := ''; |
|
790 |
|
Params := ''; |
|
791 |
|
Bookmark := ''; |
|
792 |
|
HasAuthority := True; |
|
793 |
|
end; |
|
794 |
|
|
|
795 |
|
end; |
|
796 |
|
case it of |
|
797 |
|
'1': |
|
798 |
|
begin |
|
799 |
|
Title := activeItem.DisplayString; |
|
800 |
|
Edit.Contents := EncodeURI(URL); |
|
801 |
|
LoadPage(activeItem.HostName, activeItem.Port, activeItem.Selector); |
|
802 |
|
end; |
|
803 |
|
'0': |
|
804 |
|
begin |
|
805 |
|
text := Fetch(activeItem.HostName, activeItem.Port, activeItem.Selector); |
|
806 |
|
ShowText(text, activeItem.DisplayString + ' (' + EncodeURI(URL) + ')'); |
|
807 |
|
end; |
|
808 |
|
'7': RequireSearch(activeItem); |
|
809 |
|
'i', '2', '3', '8', '+', 'T', 'h': ;//cz nic, to nepodporujeme |
|
810 |
|
else //cz zbytek hodime do souboru |
|
811 |
|
begin |
|
812 |
|
text := Fetch(activeItem.HostName, activeItem.Port, activeItem.Selector); |
|
813 |
|
FD := TFileDialog.Create; |
|
814 |
|
try |
|
815 |
|
FD.TitleText := activeItem.DisplayString; |
|
816 |
|
//FileDialog.Pattern := '#?.dat'; |
|
817 |
|
//FileDialog.Directory := 'DH1:Data'; |
|
818 |
|
if FD.Execute then |
|
819 |
|
SaveStringToFile(text, FD.Filename); |
|
820 |
|
finally |
|
821 |
|
FD.Free; |
|
822 |
|
end;// end try |
|
823 |
|
end;//end this case |
|
824 |
|
end;//end case block |
|
825 |
|
|
|
826 |
|
end; |
|
827 |
|
|
|
828 |
|
|
|
829 |
|
|
|
830 |
|
|
|
831 |
|
|
|
832 |
|
procedure Startup; |
|
833 |
|
begin |
|
834 |
|
MUIApp.Base := 'ARLAN'; |
|
835 |
|
MUIApp.Title := 'ArLan'; |
|
836 |
|
MUIApp.Version := '$VER: ArLan 0.1 (31.07.2021)'; |
|
837 |
|
MUIApp.Author := 'Aleksei "I am" Gerasimov'; |
|
838 |
|
MUIApp.Copyright := 'Alex'; |
|
839 |
|
MUIApp.Description := 'Simple Gopher client for AROS'; |
|
840 |
|
|
|
841 |
|
TMyWindow.Create; |
|
842 |
|
|
|
843 |
|
|
|
844 |
|
MUIApp.Run; |
|
845 |
|
end; |
|
846 |
|
|
|
847 |
|
|
|
848 |
|
|
|
849 |
|
begin |
|
850 |
|
Startup; |
|
851 |
|
end. |
|
852 |
|
|
|
853 |
|
|
|
854 |
|
|
|
855 |
|
|
|
856 |
|
|
|
857 |
|
|
|
858 |
|
|
|
859 |
|
|
|
860 |
|
|
|
861 |
|
|
File misc.pas added (mode: 100755) (index 0000000..9f5f667) |
|
1 |
|
// here are placed functions taken from somewhere |
|
2 |
|
// They have their own licenses! |
|
3 |
|
|
|
4 |
|
unit misc; |
|
5 |
|
{$mode objfpc}{$H+} |
|
6 |
|
interface |
|
7 |
|
uses |
|
8 |
|
Classes, sysutils, MUIClass.Dialog, // for SaveStringToFile |
|
9 |
|
ssockets; // for Fetch function |
|
10 |
|
|
|
11 |
|
function SaveStringToFile(theString, filePath: AnsiString): boolean; |
|
12 |
|
function Fetch(Addr: string; Port: Integer; What: string): string; |
|
13 |
|
|
|
14 |
|
implementation |
|
15 |
|
|
|
16 |
|
// Source: FreePascal wiki |
|
17 |
|
// https://wiki.freepascal.org/File_Handling_In_Pascal |
|
18 |
|
// What is license for it? |
|
19 |
|
// |
|
20 |
|
// SaveStringToFile: function to store a string of text into a diskfile. |
|
21 |
|
// If the function result equals true, the string was written ok. |
|
22 |
|
// If not then there was some kind of error. |
|
23 |
|
function SaveStringToFile(theString, filePath: AnsiString): boolean; |
|
24 |
|
var |
|
25 |
|
fsOut: TFileStream; |
|
26 |
|
begin |
|
27 |
|
// By default assume the writing will fail. |
|
28 |
|
result := false; |
|
29 |
|
|
|
30 |
|
// Write the given string to a file, catching potential errors in the process. |
|
31 |
|
try |
|
32 |
|
fsOut := TFileStream.Create(filePath, fmCreate); |
|
33 |
|
fsOut.Write(theString[1], length(theString)); |
|
34 |
|
fsOut.Free; |
|
35 |
|
|
|
36 |
|
// At his point it is known that the writing went ok. |
|
37 |
|
result := true |
|
38 |
|
|
|
39 |
|
except |
|
40 |
|
on E:Exception do |
|
41 |
|
ShowMessage('String could not be written. Details: '+ E.ClassName + ': '+ E.Message); |
|
42 |
|
end |
|
43 |
|
end; |
|
44 |
|
|
|
45 |
|
|
|
46 |
|
// Fetch function is taken from "Little Gopher Client"'s code. |
|
47 |
|
// http://runtimeterror.com/tools/gopher/ |
|
48 |
|
// Its license: |
|
49 |
|
{ |
|
50 |
|
Little Gopher Client |
|
51 |
|
Copyright (C) 2016 Kostas Michalopoulos |
|
52 |
|
|
|
53 |
|
This software is provided 'as-is', without any express or implied |
|
54 |
|
warranty. In no event will the authors be held liable for any damages |
|
55 |
|
arising from the use of this software. |
|
56 |
|
|
|
57 |
|
Permission is granted to anyone to use this software for any purpose, |
|
58 |
|
including commercial applications, and to alter it and redistribute it |
|
59 |
|
freely, subject to the following restrictions: |
|
60 |
|
|
|
61 |
|
1. The origin of this software must not be misrepresented; you must not |
|
62 |
|
claim that you wrote the original software. If you use this software |
|
63 |
|
in a product, an acknowledgment in the product documentation would be |
|
64 |
|
appreciated but is not required. |
|
65 |
|
2. Altered source versions must be plainly marked as such, and must not be |
|
66 |
|
misrepresented as being the original software. |
|
67 |
|
3. This notice may not be removed or altered from any source distribution. |
|
68 |
|
|
|
69 |
|
Kostas Michalopoulos <badsector@runtimeterror.com> |
|
70 |
|
} |
|
71 |
|
function Fetch(Addr: string; Port: Integer; What: string): string; |
|
72 |
|
var |
|
73 |
|
Conn: TInetSocket = nil; |
|
74 |
|
Buff: array [0..65535] of AnsiChar; |
|
75 |
|
Total: array of AnsiChar; |
|
76 |
|
Got, AllGot: LongInt; |
|
77 |
|
I: Integer; |
|
78 |
|
begin |
|
79 |
|
try |
|
80 |
|
Conn:=TInetSocket.Create(Addr, Port); |
|
81 |
|
What := What + #13#10; |
|
82 |
|
Conn.Write((@What[1])^, Length(What)); |
|
83 |
|
AllGot:=0; |
|
84 |
|
while True do begin |
|
85 |
|
Got:=Conn.Read(Buff, SizeOf(Buff)); |
|
86 |
|
if Got < 1 then Break; |
|
87 |
|
SetLength(Total, Length(Total) + Got); |
|
88 |
|
Move((@Buff[0])^, (@Total[AllGot])^, Got); |
|
89 |
|
Inc(AllGot, Got); |
|
90 |
|
end; |
|
91 |
|
SetLength(Result, AllGot); |
|
92 |
|
for I:=1 to AllGot do Result[I]:=Total[I - 1]; |
|
93 |
|
except |
|
94 |
|
ShowMessage('Failed to get data: ' + Exception(ExceptObject).Message, 'Fetch error'); |
|
95 |
|
Result:=''; |
|
96 |
|
end; |
|
97 |
|
FreeAndNil(Conn); |
|
98 |
|
end; |
|
99 |
|
|
|
100 |
|
end. |