├── .gitignore
├── README.md
├── SECURITY.md
├── WindowsXP.manifest
├── alias.txt
├── classesLib.pas
├── copyright.txt
├── data.rc
├── default.tpl
├── defs.inc
├── deprecated.txt
├── diffDlg.dfm
├── diffDlg.pas
├── dmBrowser.tpl
├── filelist.tpl
├── filepropDlg.dfm
├── filepropDlg.pas
├── folderKindDlg.dfm
├── folderKindDlg.pas
├── fontello.json
├── hfs.bdsproj
├── hfs.cfg
├── hfs.dfm
├── hfs.dpr
├── hfs.dproj
├── hfs.dproj.local
├── hfs.drc
├── hfs.lng
├── hfs.otares
├── hfs.pas
├── hfs.res
├── hfs_Icon.ico
├── hfs_Icon1.ico
├── hfs_Icon2.ico
├── hslib.pas
├── ipsEverDlg.dfm
├── ipsEverDlg.pas
├── ipservices.txt
├── jquery.min.js
├── listSelectDlg.dfm
├── listSelectDlg.pas
├── longinputDlg.dfm
├── longinputDlg.pas
├── main.dfm
├── main.pas
├── monoLib.pas
├── newuserpassDlg.dfm
├── newuserpassDlg.pas
├── optionsDlg.dfm
├── optionsDlg.pas
├── parserLib.pas
├── progFrmLib.pas
├── purgeDlg.dfm
├── purgeDlg.pas
├── recompile data.bat
├── runscriptDlg.dfm
├── runscriptDlg.pas
├── scriptLib.pas
├── shellExtDlg.dfm
├── shellExtDlg.pas
├── todo.txt
├── traylib.pas
├── utillib.pas
└── whatsnew.txt
/.gitignore:
--------------------------------------------------------------------------------
1 | tmp/
2 | __history/
3 | __recovery/
4 | win32/
5 | .vscode/
6 | .idea/
7 | *.vfs
8 | *.dcu
9 | *.exe
10 | *.map
11 | *.tmp
12 | *.dll
13 | *.bak
14 | *.*-
15 | *.corrupted
16 | hfs.ini
17 | hfs.identcache
18 | hfs.tpl
19 | hfs_project.tvsconfig
20 | data.res
21 | macros-log.html
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Obsolete
2 | This is the repository of the old HFS.
3 |
4 | I'm working on HFS 3 on another repository. Check it out!
5 | https://github.com/rejetto/hfs
6 |
7 | ## Introduction
8 | You can use HFS (HTTP File Server) to send and receive files.
9 | It's different from classic file sharing because it uses web technology.
10 | It also differs from classic web servers because it's very easy to use and runs "right out-of-the box".
11 |
12 | The virtual file system will allow you to easily share even one single file.
13 |
14 | ## Dev notes
15 | Initially developed in 2002 with Delphi 6, now with Delphi 10.3.3 (Community Edition).
16 | Icons are generated at http://fontello.com/ . Use fontello.json for further modifications.
17 |
18 | For the default template we are targeting compatibility with Chrome 49 as it's the latest version running on Windows XP.
19 |
20 | Warning: Delphi Community Edition 10.4 removed support for command-line compilation, and is thus unable to compile JEDI Code Library, and is thus unable to compile HFS2, ref [Community Edition no longer includes the command-line compilers](https://blogs.embarcadero.com/delphi-cbuilder-community-editions-now-available-in-version-10-4-2/#comment-1339) - meaning the last version of Community Edition cabale of compiling HFS2 is Delphi 10.3.x
21 |
22 | ## Libs used
23 | - [ICS v8.64](http://www.overbyte.be) by François PIETTE
24 | - [TRegExpr v0.952b](https://github.com/andgineer/TRegExpr/releases) by Andrey V. Sorokin
25 | - [JEDI Code Library v2.7](https://github.com/project-jedi/jcl)
26 | - [Kryvich's Delphi Localizer v4.1](http://sites.google.com/site/kryvich)
27 |
--------------------------------------------------------------------------------
/SECURITY.md:
--------------------------------------------------------------------------------
1 | # Security Policy
2 |
3 | ## Supported Versions
4 |
5 |
6 | | Version | Supported |
7 | | ------- | ------------------ |
8 | | 2.4.x | :white_check_mark: |
9 | | 2.3.x | :white_check_mark: |
10 | | < 2.3 | :x: |
11 |
12 | ## Reporting a Vulnerability
13 |
14 | Please report directly via email to a@rejetto.com for Responsible disclosure.
15 | I should normally reply within 2 days, so we can agree on timings.
16 |
--------------------------------------------------------------------------------
/WindowsXP.manifest:
--------------------------------------------------------------------------------
1 |
2 |
3 |
8 | Windows Shell
9 |
10 |
11 |
19 |
20 |
21 |
22 |
--------------------------------------------------------------------------------
/alias.txt:
--------------------------------------------------------------------------------
1 | var length=length|var=$1
2 | cache=trim|{.set|#cache.tmp|{.from table|$1|$2.}.} {.if not|{.^#cache.tmp.}|{:{.set|#cache.tmp|{.dequote|$3.}.}{.set table|$1|$2={.^#cache.tmp.}.}:}.} {.^#cache.tmp.} {.set|#cache.tmp.}
3 | is substring=pos|$1|$2
4 | set append=set|$1|$2|mode=append
5 | 123 if 2=if|$2|$1$2$3
6 | between=if|{.$1 < $3.}|{:{.and|{.$1 <= $2.}|{.$2 <= $3.}:}|{:{.and|{.$3 <= $2.}|{.$2 <= $1.}:}
7 | between!=if|{.$1 < $3.}|{:{.and|{.$1 < $2.}|{.$2 < $3.}:}|{:{.and|{.$3 < $2.}|{.$2 < $1.}:}
8 | file changed=if| {.{.filetime|$1.} > {.^#file changed.$1.}.}|{: {.set|#file changed.$1|{.filetime|$1.}.} {.if|$2|{:{.load|$1|var=$2.}:}.} 1:}
9 | play system event=play
10 | redirect=add header|Location: $1
11 | chop={.cut|{.calc|{.pos|$2|var=$1.}+{.length|$2.}.}||var=$1|remainder=#chop.tmp.}{.^#chop.tmp.}
--------------------------------------------------------------------------------
/classesLib.pas:
--------------------------------------------------------------------------------
1 | {
2 | Copyright (C) 2002-2020 Massimo Melina (www.rejetto.com)
3 |
4 | This file is part of HFS ~ HTTP File Server.
5 |
6 | HFS is free software; you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation; either version 2 of the License, or
9 | (at your option) any later version.
10 |
11 | HFS is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with HFS; if not, write to the Free Software
18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 | }
20 | {$INCLUDE defs.inc }
21 | unit classesLib;
22 |
23 | interface
24 |
25 | uses
26 | iniFiles, types, hslib, strUtils, sysUtils, classes, math, system.Generics.Collections,
27 | OverbyteIcsWSocket, OverbyteIcshttpProt;
28 |
29 | type
30 | TantiDos = class
31 | protected
32 | accepted: boolean;
33 | Paddress: string;
34 | public
35 | constructor create;
36 | destructor Destroy; override;
37 | function accept(conn:ThttpConn; address:string=''):boolean;
38 | end;
39 |
40 | TfastStringAppend = class
41 | protected
42 | buff: string;
43 | n: integer;
44 | public
45 | function length():integer;
46 | function reset():string;
47 | function get():string;
48 | function append(s:string):integer;
49 | end;
50 |
51 | PcachedIcon = ^TcachedIcon;
52 | TcachedIcon = record
53 | data: string;
54 | idx: integer;
55 | time: Tdatetime;
56 | end;
57 |
58 | TiconsCache = class
59 | n: integer;
60 | icons: array of TcachedIcon;
61 | function get(data:string):PcachedIcon;
62 | procedure put(data:string; idx:integer; time:Tdatetime);
63 | procedure clear();
64 | procedure purge(olderThan:Tdatetime);
65 | function idxOf(data:string):integer;
66 | end;
67 |
68 | TusersInVFS = class
69 | protected
70 | users: TstringDynArray;
71 | pwds: array of TstringDynArray;
72 | public
73 | procedure reset();
74 | procedure track(usr, pwd:string); overload;
75 | procedure drop(usr, pwd:string); overload;
76 | function match(usr, pwd:string):boolean; overload;
77 | function empty():boolean;
78 | end;
79 |
80 | TarchiveStream = class(Tstream)
81 | protected
82 | pos, cachedTotal: int64;
83 | cur: integer;
84 |
85 | procedure invalidate();
86 | procedure calculate(); virtual; abstract;
87 | function getTotal():int64;
88 | public
89 | flist: array of record
90 | src, // full path of the file on the disk
91 | dst: string; // full path of the file in the archive
92 | firstByte, // offset of the file inside the archive
93 | mtime,
94 | size: int64;
95 | data: Tobject; // extra data
96 | end;
97 | onDestroy: TNotifyEvent;
98 |
99 | constructor create;
100 | destructor Destroy; override;
101 | function addFile(src:string; dst:string=''; data:Tobject=NIL):boolean; virtual;
102 | function contains(src:string):boolean;
103 | function count():integer;
104 | procedure reset(); virtual;
105 | property totalSize:int64 read getTotal;
106 | property current:integer read cur;
107 | end; // TarchiveStream
108 |
109 | TtarStreamWhere = (TW_HEADER, TW_FILE, TW_PAD);
110 |
111 | TtarStream = class(TarchiveStream)
112 | protected
113 | fs: TFileStream;
114 | block: TStringStream;
115 | lastSeekFake: int64;
116 | where: TtarStreamWhere;
117 | function fsInit():boolean;
118 | procedure headerInit(); // fill block with header
119 | procedure padInit(full:boolean=FALSE); // fill block with pad
120 | function headerLengthForFilename(ufn:string):integer;
121 | procedure calculate(); override;
122 | public
123 | fileNamesOEM: boolean;
124 | constructor create;
125 | destructor Destroy; override;
126 | function Read(var Buffer; Count: Longint): Longint; override;
127 | function Write(const Buffer; Count: Longint): Longint; override;
128 | function Seek(const Offset: Int64; Origin: TSeekOrigin=soBeginning): Int64; override;
129 |
130 | procedure reset(); override;
131 | end; // TtarStream
132 |
133 | Thasher = class(TstringList)
134 | procedure loadFrom(path:string);
135 | function getHashFor(fn:string):string;
136 | end;
137 |
138 | Tint2int = Tdictionary;
139 | Tstr2str = Tdictionary;
140 | Tstr2pointer = Tdictionary;
141 |
142 | TstringToIntHash = class(ThashedStringList)
143 | constructor create;
144 | function getInt(s:string):integer;
145 | function getIntByIdx(idx:integer):integer;
146 | function incInt(s:string):integer;
147 | procedure setInt(s:string; int:integer);
148 | end;
149 |
150 | PtplSection = ^TtplSection;
151 | TtplSection = record
152 | name, txt: string;
153 | nolog, public, noList, cache: boolean;
154 | ts: Tdatetime;
155 | end;
156 |
157 | Ttpl = class
158 | protected
159 | src: string;
160 | lastExt, // cache for getTxtByExt()
161 | last: record section:string; idx:integer; end; // cache for getIdx()
162 | strTable: THashedStringList;
163 | fOver: Ttpl;
164 | sections: Tstr2pointer;
165 | function getTxt(section:string):string;
166 | function newSection(section:string):PtplSection;
167 | procedure fromString(txt:string);
168 | procedure setOver(v:Ttpl);
169 | public
170 | onChange: TNotifyEvent;
171 | constructor create(txt:string=''; over:Ttpl=NIL);
172 | destructor Destroy; override;
173 | property txt[section:string]:string read getTxt; default;
174 | property fullText:string read src write fromString;
175 | property over:Ttpl read fOver write setOver;
176 | function sectionExist(section:string):boolean;
177 | function getTxtByExt(fileExt:string):string;
178 | function getSection(section:string; inherit:boolean=TRUE):PtplSection;
179 | function getSections():TStringDynArray;
180 | procedure appendString(txt:string);
181 | function getStrByID(id:string):string;
182 | function me():Ttpl;
183 | end; // Ttpl
184 |
185 | TcachedTplObj = class
186 | ts: Tdatetime;
187 | tpl: Ttpl;
188 | end;
189 |
190 | TcachedTpls = class(THashedStringList)
191 | public
192 | function getTplFor(fn:string):Ttpl;
193 | destructor Destroy; override;
194 | end; // TcachedTpls
195 |
196 | TperIp = class // for every different address, we have an object of this class. These objects are never freed until hfs is closed.
197 | public
198 | limiter: TspeedLimiter;
199 | customizedLimiter: boolean;
200 | constructor create();
201 | destructor Destroy; override;
202 | end;
203 |
204 | ThttpClient = class(TSslHttpCli)
205 | constructor Create(AOwner: TComponent); override;
206 | destructor Destroy; override;
207 | class function createURL(url:string):ThttpClient;
208 | end;
209 |
210 | Ttlv = class
211 | protected
212 | cur, bound: integer;
213 | whole, lastRaw: ansistring;
214 | stack: array of integer;
215 | stackTop: integer;
216 | public
217 | procedure parse(data:ansistring);
218 | function pop(var value:string; var raw:ansiString):integer;
219 | function down():boolean;
220 | function up():boolean;
221 | function getTotal():integer;
222 | function getCursor():integer;
223 | function getPerc():real;
224 | function isOver():boolean;
225 | function getTheRest():ansistring;
226 | end;
227 |
228 | const TLV_UTF8_FLAG = $1000000;
229 |
230 | implementation
231 |
232 | uses
233 | utilLib, main, windows, dateUtils, forms;
234 |
235 | const folderConcurrents: integer = 0;
236 | const MAX_CONCURRENTS = 3;
237 | const ip2availability: Tdictionary = NIL;
238 |
239 | constructor TantiDos.create();
240 | begin
241 | accepted:=FALSE;
242 | end;
243 |
244 | function TantiDos.accept(conn:ThttpConn; address:string=''):boolean;
245 |
246 | procedure reject();
247 | resourcestring
248 | MSG_ANTIDOS_REPLY = 'Please wait, server busy';
249 | begin
250 | conn.reply.mode:=HRM_OVERLOAD;
251 | conn.addHeader(ansistring('Refresh: '+intToStr(1+random(2)))); // random for less collisions
252 | conn.reply.body:=UTF8Encode(MSG_ANTIDOS_REPLY);
253 | end;
254 |
255 | begin
256 | if address= '' then
257 | address:=conn.address;
258 | if ip2availability = NIL then
259 | ip2availability:=Tdictionary.create();
260 | try
261 | if ip2availability[address] > now() then // this specific address has to wait?
262 | begin
263 | reject();
264 | exit(FALSE);
265 | end;
266 | except
267 | end;
268 | if folderConcurrents >= MAX_CONCURRENTS then // max number of concurrent folder loading, others are postponed
269 | begin
270 | reject();
271 | exit(FALSE);
272 | end;
273 | inc(folderConcurrents);
274 | Paddress:=address;
275 | ip2availability.AddOrSetValue(address, now()+1/HOURS);
276 | accepted:=TRUE;
277 | Result:=TRUE;
278 | end;
279 |
280 | destructor TantiDos.Destroy;
281 | var
282 | pair: Tpair;
283 | t: Tdatetime;
284 | begin
285 | if not accepted then
286 | exit;
287 | t:=now();
288 | if folderConcurrents = MAX_CONCURRENTS then // serving multiple addresses at max capacity, let's give a grace period for others
289 | ip2availability[Paddress]:=t + 1/SECONDS
290 | else
291 | ip2availability.Remove(Paddress);
292 | dec(folderConcurrents);
293 | // purge leftovers
294 | for pair in ip2availability do
295 | if pair.Value < t then
296 | ip2availability.Remove(pair.Key);
297 | end;
298 |
299 | class function ThttpClient.createURL(url:string):ThttpClient;
300 | begin
301 | if startsText('https://', url)
302 | and not httpsCanWork() then
303 | exit(NIL);
304 | result:=ThttpClient.Create(NIL);
305 | result.URL:=url;
306 | end;
307 |
308 | constructor ThttpClient.create(AOwner: TComponent);
309 | begin
310 | inherited;
311 | followRelocation:=TRUE;
312 | agent:=HFS_HTTP_AGENT;
313 | SslContext := TSslContext.Create(NIL);
314 | end; // create
315 |
316 | destructor ThttpClient.Destroy;
317 | begin
318 | SslContext.free;
319 | SslContext:=NIl;
320 | inherited destroy;
321 | end;
322 |
323 | constructor TperIp.create();
324 | begin
325 | limiter:=TspeedLimiter.create();
326 | srv.limiters.add(limiter);
327 | end;
328 |
329 | destructor TperIp.Destroy;
330 | begin
331 | srv.limiters.remove(limiter);
332 | limiter.free;
333 | end;
334 |
335 | //////////// TcachedTpls
336 |
337 | destructor TcachedTpls.Destroy;
338 | var
339 | i: integer;
340 | begin
341 | for i:=0 to count-1 do
342 | objects[i].free;
343 | end;
344 |
345 | function TcachedTpls.getTplFor(fn:string):Ttpl;
346 | var
347 | i: integer;
348 | o: TcachedTplObj;
349 | s: string;
350 | begin
351 | fn:=trim(lowercase(fn));
352 | i:=indexOf(fn);
353 | if i >= 0 then
354 | o:=objects[i] as TcachedTplObj
355 | else
356 | begin
357 | o:=TcachedTplObj.create();
358 | if addObject(fn, o) > 100 then
359 | delete(0);
360 | end;
361 | result:=o.tpl;
362 | if getMtime(fn) = o.ts then exit;
363 | o.ts:=getMtime(fn);
364 | s:=loadTextFile(fn);
365 | if o.tpl = NIL then
366 | begin
367 | result:=Ttpl.create();
368 | o.tpl:=result;
369 | end;
370 | o.tpl.fromString(s);
371 | end; // getTplFor
372 |
373 | //////////// TusersInVFS
374 |
375 | function TusersInVFS.empty():boolean;
376 | begin result:= users = NIL end;
377 |
378 | procedure TusersInVFS.reset();
379 | begin
380 | users:=NIL;
381 | pwds:=NIL;
382 | end; // reset
383 |
384 | procedure TusersInVFS.track(usr, pwd: string);
385 | var
386 | i: integer;
387 | begin
388 | if usr = '' then exit;
389 | i:=idxOf(usr, users);
390 | if i < 0 then i:=addString(usr, users);
391 | if i >= length(pwds) then setLength(pwds, i+1);
392 | addString(pwd, pwds[i]);
393 | end; // track
394 |
395 | procedure TusersInVFS.drop(usr, pwd: string);
396 | var
397 | i, j: integer;
398 | begin
399 | i:=idxOf(usr, users);
400 | if i < 0 then exit;
401 | j:=AnsiIndexStr(pwd, pwds[i]);
402 | if j < 0 then exit;
403 | removeString(pwds[i], j);
404 | if assigned(pwds[i]) then exit;
405 | // this username does not exist with any password
406 | removeString(users, i);
407 | while i+1 < length(pwds) do
408 | begin
409 | pwds[i]:=pwds[i+1];
410 | inc(i);
411 | end;
412 | setLength(pwds, i);
413 | end; // drop
414 |
415 | function TusersInVFS.match(usr, pwd:string):boolean;
416 | var
417 | i: integer;
418 | begin
419 | result:=FALSE;
420 | i:=idxOf(usr, users);
421 | if i < 0 then exit;
422 | result:= 0 <= AnsiIndexStr(pwd, pwds[i]);
423 | end; // match
424 |
425 | //////////// TiconsCache
426 |
427 | function TiconsCache.idxOf(data:string):integer;
428 | var
429 | b, e, c: integer;
430 | begin
431 | result:=0;
432 | if n = 0 then exit;
433 | // binary search
434 | b:=0;
435 | e:=n-1;
436 | repeat
437 | result:=(b+e) div 2;
438 | c:=compareStr(data, icons[result].data);
439 | if c = 0 then exit;
440 | if c < 0 then e:=result-1;
441 | if c > 0 then b:=result+1;
442 | until b > e;
443 | result:=b;
444 | end; // idxOf
445 |
446 | function TiconsCache.get(data:string):PcachedIcon;
447 | var
448 | i: integer;
449 | begin
450 | result:=NIL;
451 | i:=idxOf(data);
452 | if (i >= 0) and (i < n) and (icons[i].data = data) then
453 | result:=@icons[i];
454 | end; // get
455 |
456 | procedure TiconsCache.put(data:string; idx:integer; time:Tdatetime);
457 | var
458 | i, w: integer;
459 | begin
460 | if length(icons) <= n then setlength(icons, n+50);
461 | w:=idxOf(data);
462 | for i:=n downto w+1 do icons[i]:=icons[i-1]; // shift
463 | icons[w].data:=data;
464 | icons[w].idx:=idx;
465 | icons[w].time:=time;
466 | inc(n);
467 | end; // put
468 |
469 | procedure TiconsCache.clear();
470 | begin
471 | icons:=NIL;
472 | n:=0;
473 | end; // clear
474 |
475 | procedure TiconsCache.purge(olderThan:Tdatetime);
476 | var
477 | i, m: integer;
478 | begin
479 | exit;
480 | m:=0;
481 | for i:=0 to n-1 do
482 | if icons[i].time < olderThan then dec(n) // this does not shorten the loop
483 | else
484 | begin
485 | if m < i then icons[m]:=icons[i];
486 | inc(m);
487 | end;
488 | end; // purge
489 |
490 | //////////// TfastStringAppend
491 |
492 | function TfastStringAppend.length():integer;
493 | begin result:=n end;
494 |
495 | function TfastStringAppend.get():string;
496 | begin
497 | setlength(buff, n);
498 | result:=buff;
499 | end; // get
500 |
501 | function TfastStringAppend.reset():string;
502 | begin
503 | result:=get();
504 | buff:='';
505 | n:=0;
506 | end; // reset
507 |
508 | function TfastStringAppend.append(s:string):integer;
509 | var
510 | ls, lb: integer;
511 | begin
512 | ls:=system.length(s);
513 | lb:=system.length(buff);
514 | if n+ls > lb then setlength(buff, lb+ls+20000);
515 | moveChars(s[1], buff[n+1], ls);
516 | inc(n, ls);
517 | result:=n;
518 | end; // append
519 |
520 | //////////// TarchiveStream
521 |
522 | function TarchiveStream.getTotal():int64;
523 | begin
524 | if cachedTotal < 0 then calculate();
525 | result:=cachedTotal;
526 | end; // getTotal
527 |
528 | function TarchiveStream.contains(src:string):boolean;
529 | var
530 | i: integer;
531 | begin
532 | for i:=0 to Length(flist)-1 do
533 | if flist[i].src = src then
534 | exit(TRUE);
535 | result:=FALSE;
536 | end;
537 |
538 | function TarchiveStream.addFile(src:string; dst:string=''; data:Tobject=NIL):boolean;
539 |
540 | function getMtime(fh:Thandle):int64;
541 | var
542 | ctime, atime, mtime: Tfiletime;
543 | st: TSystemTime;
544 | begin
545 | getFileTime(fh, @ctime, @atime, @mtime);
546 | fileTimeToSystemTime(mtime, st);
547 | result:=dateTimeToUnix(SystemTimeToDateTime(st));
548 | end; // getMtime
549 |
550 | var
551 | i, fh: integer;
552 | begin
553 | result:=FALSE;
554 | fh:=fileopen(src, fmOpenRead+fmShareDenyNone);
555 | if fh = -1 then exit;
556 | result:=TRUE;
557 | if dst = '' then
558 | dst:=extractFileName(src);
559 | i:=length(flist);
560 | setLength(flist, i+1);
561 | flist[i].src:=src;
562 | flist[i].dst:=dst;
563 | flist[i].data:=data;
564 | flist[i].size:=sizeOfFile(fh);
565 | flist[i].mtime:=getMtime(fh);
566 | flist[i].firstByte:=-1;
567 | fileClose(fh);
568 | invalidate();
569 | end; // addFile
570 |
571 | procedure TarchiveStream.invalidate();
572 | begin cachedTotal:=-1 end;
573 |
574 | constructor TarchiveStream.create;
575 | begin
576 | inherited;
577 | reset();
578 | end; // create
579 |
580 | destructor TarchiveStream.destroy;
581 | begin
582 | if assigned(onDestroy) then onDestroy(self);
583 | inherited;
584 | end; // destroy
585 |
586 | procedure TarchiveStream.reset();
587 | begin
588 | flist:=NIL;
589 | cur:=0;
590 | pos:=0;
591 | invalidate();
592 | end; // reset
593 |
594 | function TarchiveStream.count():integer;
595 | begin result:=length(flist) end;
596 |
597 | //////////// TtarStream
598 |
599 | constructor TtarStream.create;
600 | begin
601 | block:=TStringStream.create('');
602 | lastSeekFake:=-1;
603 | where:=TW_HEADER;
604 | fileNamesOEM:=FALSE;
605 | inherited;
606 | end; // create
607 |
608 | destructor TtarStream.destroy;
609 | begin
610 | freeAndNIL(fs);
611 | inherited;
612 | end; // destroy
613 |
614 | procedure TtarStream.reset();
615 | begin
616 | inherited;
617 | block.size:=0;
618 | end; // reset
619 |
620 | function TtarStream.fsInit():boolean;
621 | begin
622 | if assigned(fs) and (fs.FileName = flist[cur].src) then
623 | exit(TRUE);
624 | result:=FALSE;
625 | try
626 | freeAndNIL(fs);
627 | fs:=TfileStream.Create(flist[cur].src, fmOpenRead+fmShareDenyWrite);
628 | result:=TRUE;
629 | except
630 | fs:=NIL;
631 | end;
632 | end; // fsInit
633 |
634 | procedure TtarStream.headerInit();
635 |
636 | function num(i:int64; fieldLength:integer):ansistring;
637 | const
638 | CHARS : array [0..7] of ansichar = '01234567';
639 | var
640 | d: integer;
641 | begin
642 | d:=fieldLength-1;
643 | result:=ansistring(dupeString('0', d))+#0;
644 | while d > 0 do
645 | begin
646 | result[d]:=CHARS[i and 7];
647 | dec(d);
648 | i:=i shr 3;
649 | if i = 0 then break;
650 | end;
651 | end; // num
652 |
653 | function str(s:ansistring; fieldLength:integer; fill:ansistring=#0):ansistring;
654 | begin
655 | setLength(s, min(length(s), fieldLength-1));
656 | result:=s+ansistring( dupeString(fill, fieldLength-length(s)) );
657 | end; // str
658 |
659 | function sum(s:ansistring):integer;
660 | var
661 | i: integer;
662 | begin
663 | result:=0;
664 | for i:=1 to length(s) do
665 | inc(result, ord(s[i]));
666 | end; // sum
667 |
668 | procedure applyChecksum(var s:ansistring);
669 | var
670 | chk: ansistring;
671 | begin
672 | chk:=num(sum(s), 7)+' ';
673 | chk[7]:=#0;
674 | move(chk[1], s[100+24+12+12+1], length(chk));
675 | end; // applyChecksum
676 |
677 | const
678 | FAKE_CHECKSUM = ' ';
679 | USTAR = 'ustar'#0'00';
680 | PERM = '0100777'#0'0000000'#0'0000000'#0; // file mode, uid, gid
681 | var
682 | fn, s, pre: ansistring;
683 | ufn: string;
684 | begin
685 | ufn:=replaceStr(flist[cur].dst,'\','/');
686 | if fileNamesOEM then
687 | fn:=strToOem(ufn)
688 | else
689 | fn:=UTF8encode(ufn);
690 | pre:='';
691 | if length(fn) >= 100 then
692 | begin
693 | pre:=str('././@LongLink', 100)+PERM
694 | +num(length(fn)+1, 12)+num(flist[cur].mtime, 12)
695 | +FAKE_CHECKSUM+'L';
696 | pre:=str(pre, 256)+str(#0+USTAR,256);
697 | applyChecksum(pre);
698 | pre:=pre+str(fn, 512);
699 | end;
700 | s:=str(fn, 100)+PERM
701 | +num(flist[cur].size, 12) // file size
702 | +num(flist[cur].mtime, 12) // mtime
703 | +FAKE_CHECKSUM
704 | +'0'+str('', 100) // link properties
705 | +USTAR;
706 | applyChecksum(s);
707 | s:=str(s, 512); // pad
708 | block.Size:=0;
709 | block.WriteString(pre+s);
710 | block.seek(0, soBeginning);
711 | end; // headerInit
712 |
713 | function TtarStream.write(const Buffer; Count: Longint): Longint;
714 | begin raise EWriteError.Create('write unsupproted') end;
715 |
716 | function gap512(i:int64):word; inline;
717 | begin
718 | result:=i and 511;
719 | if result > 0 then
720 | result:=512-result;
721 | end; // gap512
722 |
723 | procedure TtarStream.padInit(full:boolean=FALSE);
724 | begin
725 | block.Size:=0;
726 | block.WriteString(dupeString(#0, if_(full,512,gap512(pos)) ));
727 | block.Seek(0, soBeginning);
728 | end; // padInit
729 |
730 | function TtarStream.headerLengthForFilename(ufn:string):integer;
731 | var
732 | fn: ansistring;
733 | begin
734 | if fileNamesOEM then
735 | fn:=strToOem(ufn)
736 | else
737 | fn:=UTF8encode(ufn);
738 | result:=length(fn);
739 | result:=512*if_(result<100, 1, 3+result div 512);
740 | end; // headerLengthForFilename
741 |
742 | procedure TtarStream.calculate();
743 | var
744 | pos: int64;
745 | i: integer;
746 | begin
747 | pos:=0;
748 | for i:=0 to length(flist)-1 do
749 | with flist[i] do
750 | begin
751 | firstByte:=pos;
752 | inc(pos, size+headerLengthForFilename(dst));
753 | inc(pos, gap512(pos));
754 | end;
755 | inc(pos, 512); // last empty block
756 | cachedTotal:=pos;
757 | end; // calculate
758 |
759 | function TtarStream.seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
760 |
761 | function left():int64;
762 | begin result:=offset-pos end;
763 |
764 | procedure fineSeek(s:Tstream);
765 | begin inc(pos, s.seek(left(), soBeginning)) end;
766 |
767 | function skipMoreThan(size:int64):boolean;
768 | begin
769 | result:=left() > size;
770 | if result then inc(pos, size);
771 | end;
772 |
773 | var
774 | bak: int64;
775 | prevCur: integer;
776 | begin
777 | { The lastSeekFake trick is a way to fastly manage a sequence of
778 | seek(0,soCurrent); seek(0,soEnd); seek(0,soBeginning);
779 | such sequence called very often, while it is used to just read
780 | the size of the stream, no real seeking requirement.
781 | }
782 | bak:=lastSeekFake;
783 | lastSeekFake:=-1;
784 | if (origin = soCurrent) and (offset <> 0) then
785 | seek(pos+offset, soBeginning);
786 | if origin = soEnd then
787 | if offset < 0 then
788 | seek(totalSize+offset, soBeginning)
789 | else
790 | begin
791 | lastSeekFake:=pos;
792 | pos:=totalsize;
793 | end;
794 | result:=pos;
795 | if origin <> soBeginning then exit;
796 | if bak >= 0 then
797 | begin
798 | pos:=bak;
799 | exit;
800 | end;
801 |
802 | // here starts the normal seeking algo
803 |
804 | prevCur:=cur;
805 | cur:=0; // flist index
806 | pos:=0; // current position in the file
807 | block.size:=0;
808 | while (left() > 0) and (cur < length(flist)) do
809 | begin
810 | // are we seeking inside this header?
811 | if not skipMoreThan(headerLengthForFilename(flist[cur].dst)) then
812 | begin
813 | if (prevCur <> cur) or (where <> TW_HEADER) or eos(block) then
814 | headerInit();
815 | fineSeek(block);
816 | where:=TW_HEADER;
817 | break;
818 | end;
819 | // are we seeking inside this file?
820 | if not skipMoreThan(flist[cur].size) then
821 | begin
822 | if not fsInit() then
823 | raise Exception.Create('TtarStream.seek: cannot open '+flist[cur].src);
824 | fineSeek(fs);
825 | where:=TW_FILE;
826 | break;
827 | end;
828 | // are we seeking inside this pad?
829 | if not skipMoreThan(gap512(pos)) then
830 | begin
831 | padInit();
832 | fineSeek(block);
833 | where:=TW_PAD;
834 | break;
835 | end;
836 | inc(cur);
837 | end;//while
838 | if left() > 0 then
839 | begin
840 | padInit(TRUE);
841 | fineSeek(block);
842 | end;
843 | result:=pos;
844 | end; // seek
845 |
846 | function TtarStream.read(var Buffer; Count: Longint): Longint;
847 | var
848 | p: Pbyte;
849 |
850 | procedure goForth(d: int64);
851 | begin
852 | dec(count, d);
853 | inc(pos, d);
854 | inc(p, d);
855 | end; // goForth
856 |
857 | procedure goRead(s:Tstream);
858 | begin goForth( s.read(p^, count) ) end;
859 |
860 | var
861 | i, posBak: int64;
862 | n: integer;
863 | begin
864 | posBak:=pos;
865 | p:=@buffer;
866 | n:=length(flist);
867 | while (count > 0) and (cur < n) do
868 | case where of
869 | TW_HEADER:
870 | begin
871 | if block.size = 0 then
872 | headerInit();
873 | goRead(block);
874 | if not eos(block) then continue;
875 | where:=TW_FILE;
876 | freeAndNIL(fs); // in case the same files appear twice in a row, we must be sure to reinitialize the reader stream
877 | block.size:=0;
878 | end;
879 | TW_FILE:
880 | begin
881 | fsInit();
882 | if assigned(fs) then
883 | goRead(fs);
884 | { We reserved a fixed space for this file in the archive, but the file
885 | may not exist anymore, or its size may be shorter than expected,
886 | so we can't rely on eos(fs) to know if we are done in this section.
887 | Lets calculate how far we are from the theoretical end of the file,
888 | and decide after it.
889 | }
890 | i:=headerLengthForFilename(flist[cur].dst);
891 | i:=flist[cur].firstByte+i+flist[cur].size-pos;
892 | if count >= i then
893 | where:=TW_PAD;
894 | // In case the file is shorter, we pad the rest with NUL bytes
895 | i:=min(count, max(0,i));
896 | fillChar(p^,i,0);
897 | goForth(i);
898 | end;
899 | TW_PAD:
900 | begin
901 | if block.size = 0 then padInit();
902 | goRead(block);
903 | if not eos(block) then continue;
904 | where:=TW_HEADER;
905 | block.size:=0;
906 | inc(cur);
907 | end;
908 | end;//case
909 |
910 | // last empty block
911 | if count > 0 then
912 | begin
913 | padInit(TRUE);
914 | goRead(block);
915 | end;
916 | result:=pos-posBak;
917 | end; // read
918 |
919 | //////////// Thasher
920 |
921 | procedure Thasher.loadFrom(path:string);
922 | var
923 | sr: TsearchRec;
924 | s, l, h: string;
925 | begin
926 | if path='' then exit;
927 | path:=includeTrailingPathDelimiter(lowercase(path));
928 | if findFirst(path+'*.md5', faAnyFile-faDirectory, sr) <> 0 then exit;
929 | repeat
930 | s:=loadTextfile(path+sr.name);
931 | while s > '' do
932 | begin
933 | l:=chopline(s);
934 | h:=trim(chop('*',l));
935 | if h = '' then break;
936 | if l = '' then
937 | // assume it is referring to the filename without the extention
938 | l:=copy(sr.name, 1, length(sr.name)-4);
939 | add(path+lowercase(l)+'='+h);
940 | end;
941 | until findnext(sr) <> 0;
942 | sysutils.findClose(sr);
943 | end; // loadFrom
944 |
945 | function Thasher.getHashFor(fn:string):string;
946 | begin
947 | try result:=values[lowercase(fn)]
948 | except result:='' end
949 | end;
950 |
951 | //////////// TstringToIntHash
952 |
953 | constructor TstringToIntHash.create;
954 | begin
955 | inherited create;
956 | sorted:=TRUE;
957 | duplicates:=dupIgnore;
958 | end; // create
959 |
960 | function TstringToIntHash.getIntByIdx(idx:integer):integer;
961 | begin if idx < 0 then result:=0 else result:=integer(objects[idx]) end;
962 |
963 | function TstringToIntHash.getInt(s:string):integer;
964 | begin result:=getIntByIdx(indexOf(s)) end;
965 |
966 | procedure TstringToIntHash.setInt(s:string; int:integer);
967 | begin
968 | beginUpdate();
969 | objects[add(s)]:=Tobject(int);
970 | endUpdate();
971 | end; // setInt
972 |
973 | function TstringToIntHash.incInt(s:string):integer;
974 | var
975 | i: integer;
976 | begin
977 | beginUpdate();
978 | i:=add(s);
979 | result:=integer(objects[i]);
980 | inc(result);
981 | objects[i]:=Tobject(result);
982 | endUpdate();
983 | end; // autoupdatedFiles_getCounter
984 |
985 | //////////// Ttpl
986 |
987 | constructor Ttpl.create(txt:string=''; over:Ttpl=NIL);
988 | begin
989 | sections:=Tstr2pointer.Create();
990 | fullText:=txt;
991 | self.over:=over;
992 | end;
993 |
994 | destructor Ttpl.destroy;
995 | begin
996 | fullText:=''; // this will cause the disposing
997 | inherited;
998 | end; // destroy
999 |
1000 | function Ttpl.getStrByID(id:string):string;
1001 | begin
1002 | if strTable = NIL then
1003 | begin
1004 | strTable:=THashedStringList.create;
1005 | strTable.text:=txt['special:strings'];
1006 | end;
1007 | result:=strTable.values[id];
1008 | if (result = '') and assigned(over) then
1009 | result:=over.getStrByID(id)
1010 | end; // getStrByID
1011 |
1012 | function Ttpl.newSection(section:string):PtplSection;
1013 | begin
1014 | new(result);
1015 | sections.Add(section, result);
1016 | end; // newSection
1017 |
1018 | function Ttpl.sectionExist(section:string):boolean;
1019 | begin
1020 | result:=assigned(getSection(section));
1021 | if not result and assigned(over) then
1022 | result:=over.sectionExist(section);
1023 | end;
1024 |
1025 | function Ttpl.getSection(section:string; inherit:boolean=TRUE):PtplSection;
1026 | begin
1027 | if sections.containsKey(section) then
1028 | result:=sections[section]
1029 | else
1030 | result:=NIL;
1031 | if inherit and assigned(over) and (result = NIL) then
1032 | result:=over.getSection(section);
1033 | end; // getSection
1034 |
1035 | function Ttpl.getTxt(section:string):string;
1036 | var p: PtplSection;
1037 | begin
1038 | p:=getSection(section);
1039 | if p = NIL then
1040 | result:=''
1041 | else
1042 | result:=p.txt
1043 | end; // getTxt
1044 |
1045 | function Ttpl.getTxtByExt(fileExt:string):string;
1046 | begin result:=getTxt('file'+fileExt) end;
1047 |
1048 | procedure Ttpl.fromString(txt:string);
1049 | var
1050 | p: PtplSection;
1051 | begin
1052 | src:='';
1053 | for p in sections.values do
1054 | dispose(p);
1055 | sections.clear();
1056 | freeAndNIL(strTable); // mod by mars
1057 |
1058 | appendString(txt);
1059 | end; // fromString
1060 |
1061 | procedure Ttpl.appendString(txt:string);
1062 | var
1063 | ptxt, bos: Pchar;
1064 | cur_section, next_section: string;
1065 |
1066 | function pred(p:pchar):pchar; inline;
1067 | begin
1068 | result:=p;
1069 | if p <> NIL then
1070 | dec(result);
1071 | end;
1072 |
1073 | function succ(p:pchar):pchar; inline;
1074 | begin
1075 | result:=p;
1076 | if p <> NIL then
1077 | inc(result);
1078 | end;
1079 |
1080 | procedure findNextSection();
1081 | begin
1082 | // find start
1083 | bos:=ptxt;
1084 | repeat
1085 | if bos^ <> '[' then bos:=ansiStrPos(bos, #10'[');
1086 | if bos = NIL then exit;
1087 | if bos^ = #10 then inc(bos);
1088 | if getSectionAt(bos, next_section) then
1089 | exit;
1090 | inc(bos);
1091 | until false;
1092 | end; // findNextSection
1093 |
1094 | procedure saveInSection();
1095 | var
1096 | base: TtplSection;
1097 |
1098 | function parseFlagsAndAcceptSection(flags:TStringDynArray):boolean;
1099 | var
1100 | f, k, v, s: string;
1101 | i: integer;
1102 | begin
1103 | for f in flags do
1104 | begin
1105 | i:=pos('=',f);
1106 | if i = 0 then
1107 | begin
1108 | if f='no log' then
1109 | base.nolog:=TRUE
1110 | else if f='public' then
1111 | base.public:=TRUE
1112 | else if f='no list' then
1113 | base.noList:=TRUE
1114 | else if f='cache' then
1115 | base.cache:=TRUE;
1116 | Continue;
1117 | end;
1118 | k:=copy(f,1,i-1);
1119 | v:=copy(f,i+1,MAXINT);
1120 | if k = 'build' then
1121 | begin
1122 | s:=chop('-',v);
1123 | if (v > '') and (VERSION_BUILD > v) // max
1124 | or (s > '') and (VERSION_BUILD < s) then // min
1125 | exit(FALSE);
1126 | end
1127 | else if k = 'ver' then
1128 | if fileMatch(v, VERSION) then continue
1129 | else exit(FALSE)
1130 | else if k = 'template' then
1131 | if fileMatch(v, getTill(#13,getTxt('template id'))) then continue
1132 | else exit(FALSE)
1133 | end;
1134 | result:=TRUE;
1135 | end;
1136 |
1137 | var
1138 | ss: TStringDynArray;
1139 | s, si: string;
1140 | till: pchar;
1141 | append, prepend, add: boolean;
1142 | sect, from: PtplSection;
1143 | begin
1144 | till:=pred(bos);
1145 | if till = NIL then till:=pred(strEnd(ptxt));
1146 | if till^ = #10 then dec(till);
1147 | if till^ = #13 then dec(till);
1148 |
1149 | base:=default(TtplSection);
1150 | base.txt:=getStr(ptxt, till);
1151 | base.ts:=now();
1152 | ss:=split('|',cur_section);
1153 | cur_section:=popString(ss);
1154 | if not parseFlagsAndAcceptSection(ss) then
1155 | exit;
1156 |
1157 | prepend:=startsStr('^', cur_section);
1158 | append:=startsStr('+', cur_section);
1159 | add:=prepend or append;
1160 | if add then
1161 | delete(cur_section,1,1);
1162 |
1163 | // there may be several section names separated by =
1164 | ss:=split('=', cur_section);
1165 | // handle the main section specific case
1166 | if ss = NIL then
1167 | addString('', ss);
1168 | // assign to every name the same txt
1169 | for si in ss do
1170 | begin
1171 | s:=trim(si);
1172 | sect:=getSection(s, FALSE);
1173 | from:=NIL;
1174 | if sect = NIL then // not found
1175 | begin
1176 | if add then
1177 | from:=getSection(s);
1178 | sect:=newSection(s);
1179 | end
1180 | else
1181 | if add then
1182 | from:=sect;
1183 | if from<>NIL then
1184 | begin // inherit from it
1185 | if append then
1186 | sect.txt:=from.txt+base.txt
1187 | else
1188 | sect.txt:=base.txt+CRLF+from.txt;
1189 | sect.nolog:=from.nolog or base.nolog;
1190 | sect.public:=from.public or base.public;
1191 | sect.noList:=from.noList or base.noList;
1192 | continue;
1193 | end;
1194 | sect^:=base;
1195 | sect.name:=s; // restore this lost attribute
1196 | end;
1197 | end; // saveInSection
1198 |
1199 | const
1200 | UTF8_BOM = #$EF#$BB#$BF;
1201 | var
1202 | first: boolean;
1203 | begin
1204 | if ansiStartsStr(UTF8_BOM, txt) then
1205 | delete(txt, 1, length(UTF8_BOM));
1206 |
1207 | if txt = '' then exit;
1208 | src:=src+txt;
1209 | cur_section:='';
1210 | ptxt:=@txt[1];
1211 | first:=TRUE;
1212 | repeat
1213 | findNextSection();
1214 | if not first or (trim(getStr(ptxt, pred(bos))) > '') then
1215 | saveInSection();
1216 | if bos = NIL then break;
1217 | cur_section:=next_section;
1218 | inc(bos, length(cur_section)); // get faster to the end of line
1219 | ptxt:=succ(ansiStrPos(bos, #10)); // get to the end of line (and then beyond)
1220 | first:=FALSE;
1221 | until ptxt = NIL;
1222 | if assigned(onChange) then
1223 | onChange(self);
1224 | end; // appendString
1225 |
1226 | procedure Ttpl.setOver(v:Ttpl);
1227 | begin
1228 | fOver:=v;
1229 | end; // setOver
1230 |
1231 | function Ttpl.getSections():TStringDynArray;
1232 | begin result:=sections.Keys.ToArray() end;
1233 |
1234 | function Ttpl.me():Ttpl;
1235 | begin result:=self end;
1236 |
1237 |
1238 |
1239 | procedure Ttlv.parse(data:ansistring);
1240 | begin
1241 | whole:=data;
1242 | cur:=1;
1243 | bound:=length(data);
1244 | stackTop:=0;
1245 | end; // parse
1246 |
1247 | function Ttlv.pop(var value:string; var raw:ansistring):integer;
1248 | var
1249 | n: integer;
1250 | begin
1251 | if isOver() then
1252 | exit(-1); // finished
1253 | result:=integer((@whole[cur])^);
1254 | n:=Pinteger(@whole[cur+4])^;
1255 | raw:=copy(whole, cur+8, n);
1256 | lastRaw:=raw;
1257 | if result and TLV_UTF8_FLAG = 0 then
1258 | value:=string(raw)
1259 | else
1260 | begin
1261 | dec(result, TLV_UTF8_FLAG);
1262 | value:=UTF8toString(raw);
1263 | end;
1264 | inc(cur, 8+n);
1265 | end; // pop
1266 |
1267 | function Ttlv.down():boolean;
1268 | begin
1269 | // do we have anything to recur on?
1270 | if (cur = 1) then
1271 | exit(FALSE);
1272 | // push into the stack
1273 | if (stackTop = length(stack)) then // space over
1274 | setLength(stack, stackTop+10); // make space
1275 | stack[stackTop]:=cur;
1276 | inc(stackTop);
1277 | stack[stackTop]:=bound;
1278 | inc(stackTop);
1279 |
1280 | bound:=cur;
1281 | dec(cur, length(lastRaw));
1282 | result:=true;
1283 | end; // down
1284 |
1285 | function Ttlv.up():boolean;
1286 | begin
1287 | if stackTop = 0 then
1288 | exit(FALSE);
1289 | dec(stackTop);
1290 | bound:=stack[stackTop];
1291 | dec(stackTop);
1292 | cur:=stack[stackTop];
1293 | result:=true;
1294 | end; // up
1295 |
1296 | function Ttlv.getTotal():integer;
1297 | begin result:=length(whole) end;
1298 |
1299 | function Ttlv.getCursor():integer;
1300 | begin result:=cur end;
1301 |
1302 | function Ttlv.getPerc():real;
1303 | begin
1304 | if length(whole) = 0 then result:=0
1305 | else result:=cur/length(whole)
1306 | end; // getPerc
1307 |
1308 | function Ttlv.isOver():boolean;
1309 | begin result:=(cur+8 > bound) end;
1310 |
1311 | function Ttlv.getTheRest():ansistring;
1312 | begin result:=copy(whole, cur, bound-cur+1) end;
1313 |
1314 | end.
1315 |
--------------------------------------------------------------------------------
/data.rc:
--------------------------------------------------------------------------------
1 | 1 24 "WindowsXP.manifest"
2 | defaultTpl TEXT default.tpl
3 | dmBrowserTpl TEXT dmBrowser.tpl
4 | filelistTpl TEXT filelist.tpl
5 | alias TEXT alias.txt
6 | IPservices TEXT ipservices.txt
7 | jquery TEXT jquery.min.js
8 |
--------------------------------------------------------------------------------
/defs.inc:
--------------------------------------------------------------------------------
1 | {$A+,B-,C+,E-,F-,G+,H+,I-,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,X+,Y+,Z1}
2 |
3 | {$DEFINE NOT STABLE }
4 | {$IFDEF STABLE }
5 | {$ASSERTIONS OFF}
6 | {$ELSE}
7 | {$ASSERTIONS ON}
8 | {!$DEFINE EX_DEBUG}
9 | {$ENDIF}
10 | {$WARN SYMBOL_PLATFORM off }
11 | {$WARN UNIT_PLATFORM off }
12 | {$I-}
13 | {$INLINE AUTO}
14 |
--------------------------------------------------------------------------------
/deprecated.txt:
--------------------------------------------------------------------------------
1 | In the template system, the following %symbols% and [sections] are currently deprecated, because they have been surpassed by {.macros.}.
2 | They are still available for backward compatibilty in 2.x versions, but they are likely not be there since version 3.
3 |
4 | %sym-ANY%
5 | equivalent: {.$sym-ANY.}
6 | note: you are not forced anymore to start the section name by "sym-"
7 |
8 | %up%
9 | equivalent: {.if| {.%folder% = / .} | {.$up.} .}
10 | note: you are not forced anymore in keeping the code inside section [up]
11 |
12 | %item-added% and %item-modified%
13 | equivalent: {.time||when=%item-added-dt%.}
14 |
15 | %new%
16 | equivalent: {.if| {.get|is new.} | {.$newfile.} .}
17 | note: you are not forced anymore in keeping the code inside section [newfile]
18 |
19 |
--------------------------------------------------------------------------------
/diffDlg.dfm:
--------------------------------------------------------------------------------
1 | object diffFrm: TdiffFrm
2 | Left = 261
3 | Top = 149
4 | Caption = 'Customized options'
5 | ClientHeight = 334
6 | ClientWidth = 432
7 | Color = clBtnFace
8 | Font.Charset = DEFAULT_CHARSET
9 | Font.Color = clWindowText
10 | Font.Height = -11
11 | Font.Name = 'MS Sans Serif'
12 | Font.Style = []
13 | OldCreateOrder = False
14 | Position = poMainFormCenter
15 | PixelsPerInch = 96
16 | TextHeight = 13
17 | object memoBox: TMemo
18 | Left = 0
19 | Top = 0
20 | Width = 432
21 | Height = 334
22 | Align = alClient
23 | ReadOnly = True
24 | ScrollBars = ssBoth
25 | TabOrder = 0
26 | end
27 | end
28 |
--------------------------------------------------------------------------------
/diffDlg.pas:
--------------------------------------------------------------------------------
1 | unit diffDlg;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls;
8 |
9 | type
10 | TdiffFrm = class(TForm)
11 | memoBox: TMemo;
12 | private
13 | { Private declarations }
14 | public
15 | { Public declarations }
16 | end;
17 |
18 | var
19 | diffFrm: TdiffFrm;
20 |
21 | implementation
22 |
23 | {$R *.dfm}
24 |
25 | end.
26 |
--------------------------------------------------------------------------------
/dmBrowser.tpl:
--------------------------------------------------------------------------------
1 |
2 |
3 | HFS %folder%
4 |
5 | %up%
6 | %files%
7 |
8 |
9 |
10 | [up]
11 | UP
12 |
13 | [nofiles]
14 | No files
15 |
16 | [files]
17 | %list%
18 |
19 | [file]
20 | %item-name%
21 |
22 | [folder]
23 | %item-name%
24 |
25 | [comment]
26 |
27 |
28 | [error-page]
29 |
30 | %content%
31 |
32 |
33 |
34 | [not found]
35 | 404 - Not found
36 | go to root
37 |
38 | [overload]
39 | Server busy
40 | Please, retry later.
41 |
--------------------------------------------------------------------------------
/filelist.tpl:
--------------------------------------------------------------------------------
1 | %files%
2 |
3 | [files]
4 | %list%
5 |
6 | [file]
7 | %item-full-url%
8 |
9 | [folder]
10 | %item-full-url%
11 |
12 |
--------------------------------------------------------------------------------
/filepropDlg.dfm:
--------------------------------------------------------------------------------
1 | object filepropFrm: TfilepropFrm
2 | Left = 0
3 | Top = 0
4 | Caption = 'filepropFrm'
5 | ClientHeight = 401
6 | ClientWidth = 393
7 | Color = clBtnFace
8 | Font.Charset = DEFAULT_CHARSET
9 | Font.Color = clWindowText
10 | Font.Height = -11
11 | Font.Name = 'Tahoma'
12 | Font.Style = []
13 | KeyPreview = True
14 | OldCreateOrder = False
15 | Position = poMainFormCenter
16 | ShowHint = True
17 | OnClose = FormClose
18 | OnKeyPress = FormKeyPress
19 | OnShow = FormShow
20 | PixelsPerInch = 96
21 | TextHeight = 13
22 | object pages: TPageControl
23 | Left = 0
24 | Top = 0
25 | Width = 393
26 | Height = 366
27 | ActivePage = flagsTab
28 | Align = alClient
29 | ParentShowHint = False
30 | RaggedRight = True
31 | ShowHint = True
32 | TabOrder = 0
33 | object permTab: TTabSheet
34 | Caption = 'Permissions'
35 | ImageIndex = 1
36 | ExplicitLeft = 0
37 | ExplicitTop = 0
38 | ExplicitWidth = 0
39 | ExplicitHeight = 0
40 | object actionTabs: TTabControl
41 | Left = 0
42 | Top = 0
43 | Width = 385
44 | Height = 338
45 | Align = alClient
46 | MultiLine = True
47 | TabOrder = 0
48 | OnChange = actionTabsChange
49 | DesignSize = (
50 | 385
51 | 338)
52 | object newaccBtn: TButton
53 | Left = 278
54 | Top = 56
55 | Width = 92
56 | Height = 25
57 | Anchors = [akTop, akRight]
58 | Caption = 'New account'
59 | TabOrder = 0
60 | OnClick = newaccBtnClick
61 | end
62 | object anyAccChk: TCheckBox
63 | Left = 278
64 | Top = 151
65 | Width = 97
66 | Height = 17
67 | Anchors = [akTop, akRight]
68 | Caption = 'Any account'
69 | TabOrder = 1
70 | OnClick = anonChkClick
71 | end
72 | object anonChk: TCheckBox
73 | Left = 278
74 | Top = 183
75 | Width = 97
76 | Height = 17
77 | Anchors = [akTop, akRight]
78 | Caption = 'Anonymous'
79 | TabOrder = 2
80 | OnClick = anonChkClick
81 | end
82 | object allBtn: TButton
83 | Left = 278
84 | Top = 95
85 | Width = 92
86 | Height = 25
87 | Anchors = [akTop, akRight]
88 | Caption = 'All / None'
89 | TabOrder = 3
90 | OnClick = allBtnClick
91 | end
92 | object accountsBox: TListView
93 | Left = 16
94 | Top = 40
95 | Width = 247
96 | Height = 285
97 | Anchors = [akLeft, akTop, akRight, akBottom]
98 | Checkboxes = True
99 | Columns = <>
100 | TabOrder = 4
101 | ViewStyle = vsList
102 | OnChange = accountsBoxChange
103 | OnGetImageIndex = accountsBoxGetImageIndex
104 | end
105 | object anyoneChk: TCheckBox
106 | Left = 278
107 | Top = 216
108 | Width = 97
109 | Height = 17
110 | Anchors = [akTop, akRight]
111 | Caption = 'Anyone'
112 | TabOrder = 5
113 | OnClick = anonChkClick
114 | end
115 | object goToAccountsBtn: TButton
116 | Left = 278
117 | Top = 288
118 | Width = 92
119 | Height = 33
120 | Anchors = [akTop, akRight]
121 | Caption = 'Manage accounts'
122 | TabOrder = 6
123 | WordWrap = True
124 | OnClick = goToAccountsBtnClick
125 | end
126 | end
127 | end
128 | object flagsTab: TTabSheet
129 | Caption = 'Flags'
130 | ImageIndex = 2
131 | ExplicitLeft = 0
132 | ExplicitTop = 0
133 | ExplicitWidth = 0
134 | ExplicitHeight = 0
135 | object hiddenChk: TCheckBox
136 | Left = 32
137 | Top = 24
138 | Width = 180
139 | Height = 17
140 | Hint = 'Test'
141 | Caption = 'Hidden'
142 | Enabled = False
143 | TabOrder = 0
144 | end
145 | object hidetreeChk: TCheckBox
146 | Left = 32
147 | Top = 56
148 | Width = 180
149 | Height = 17
150 | Caption = 'Recursively hidden'
151 | Enabled = False
152 | TabOrder = 1
153 | end
154 | object archivableChk: TCheckBox
155 | Left = 32
156 | Top = 121
157 | Width = 273
158 | Height = 17
159 | Caption = 'Archivable'
160 | Enabled = False
161 | TabOrder = 2
162 | end
163 | object browsableChk: TCheckBox
164 | Left = 32
165 | Top = 88
166 | Width = 97
167 | Height = 17
168 | Caption = 'Browsable'
169 | Enabled = False
170 | TabOrder = 3
171 | end
172 | object dontlogChk: TCheckBox
173 | Left = 32
174 | Top = 184
175 | Width = 97
176 | Height = 17
177 | Caption = 'Don'#39't log'
178 | Enabled = False
179 | TabOrder = 4
180 | end
181 | object nodlChk: TCheckBox
182 | Left = 32
183 | Top = 152
184 | Width = 97
185 | Height = 17
186 | Caption = 'No download'
187 | Enabled = False
188 | TabOrder = 5
189 | end
190 | object dontconsiderChk: TCheckBox
191 | Left = 32
192 | Top = 216
193 | Width = 273
194 | Height = 17
195 | Caption = 'Don'#39't consider as download'
196 | Enabled = False
197 | TabOrder = 6
198 | end
199 | object hideemptyChk: TCheckBox
200 | Left = 32
201 | Top = 249
202 | Width = 313
203 | Height = 17
204 | Caption = 'Auto-hide empty folders'
205 | Enabled = False
206 | TabOrder = 7
207 | end
208 | object hideextChk: TCheckBox
209 | Left = 32
210 | Top = 280
211 | Width = 201
212 | Height = 17
213 | Caption = 'Hide file extension in listing'
214 | Enabled = False
215 | TabOrder = 8
216 | end
217 | end
218 | object diffTab: TTabSheet
219 | Caption = 'Diff template'
220 | ImageIndex = 3
221 | ExplicitLeft = 0
222 | ExplicitTop = 0
223 | ExplicitWidth = 0
224 | ExplicitHeight = 0
225 | object difftplBox: TMemo
226 | Left = 0
227 | Top = 0
228 | Width = 385
229 | Height = 338
230 | Hint =
231 | 'Here you can put a partial template that will overlap the main o' +
232 | 'ne.'
233 | Align = alClient
234 | ScrollBars = ssVertical
235 | TabOrder = 0
236 | OnEnter = textinputEnter
237 | end
238 | end
239 | object commentTab: TTabSheet
240 | Caption = 'Comment'
241 | ImageIndex = 4
242 | ExplicitLeft = 0
243 | ExplicitTop = 0
244 | ExplicitWidth = 0
245 | ExplicitHeight = 0
246 | object commentBox: TMemo
247 | Left = 0
248 | Top = 0
249 | Width = 385
250 | Height = 338
251 | Align = alClient
252 | ScrollBars = ssVertical
253 | TabOrder = 0
254 | OnEnter = textinputEnter
255 | end
256 | end
257 | object maskTab: TTabSheet
258 | Caption = 'File masks'
259 | ImageIndex = 5
260 | ExplicitLeft = 0
261 | ExplicitTop = 0
262 | ExplicitWidth = 0
263 | ExplicitHeight = 0
264 | DesignSize = (
265 | 385
266 | 338)
267 | object filesfilterBox: TLabeledEdit
268 | Left = 10
269 | Top = 32
270 | Width = 365
271 | Height = 21
272 | Anchors = [akLeft, akTop, akRight]
273 | EditLabel.Width = 46
274 | EditLabel.Height = 13
275 | EditLabel.Caption = 'Files filter'
276 | Enabled = False
277 | TabOrder = 0
278 | OnEnter = textinputEnter
279 | end
280 | object foldersfilterBox: TLabeledEdit
281 | Left = 10
282 | Top = 78
283 | Width = 365
284 | Height = 21
285 | Anchors = [akLeft, akTop, akRight]
286 | EditLabel.Width = 60
287 | EditLabel.Height = 13
288 | EditLabel.Caption = 'Folders filter'
289 | Enabled = False
290 | TabOrder = 1
291 | OnEnter = textinputEnter
292 | end
293 | object deffileBox: TLabeledEdit
294 | Left = 10
295 | Top = 125
296 | Width = 365
297 | Height = 21
298 | Hint =
299 | 'When a folder is browsed, the default file mask is used to find ' +
300 | 'a file to serve in place of the folder page. If no file is found' +
301 | ', the folder page is served.'
302 | Anchors = [akLeft, akTop, akRight]
303 | EditLabel.Width = 79
304 | EditLabel.Height = 13
305 | EditLabel.Caption = 'Default file mask'
306 | Enabled = False
307 | TabOrder = 2
308 | OnEnter = textinputEnter
309 | end
310 | object uploadfilterBox: TLabeledEdit
311 | Left = 10
312 | Top = 171
313 | Width = 365
314 | Height = 21
315 | Hint = 'Uploaded files are allowed only complying with this file mask'
316 | Anchors = [akLeft, akTop, akRight]
317 | EditLabel.Width = 85
318 | EditLabel.Height = 13
319 | EditLabel.Caption = 'Upload filter mask'
320 | Enabled = False
321 | TabOrder = 3
322 | OnEnter = textinputEnter
323 | end
324 | object dontconsiderBox: TLabeledEdit
325 | Left = 10
326 | Top = 218
327 | Width = 365
328 | Height = 21
329 | Hint =
330 | 'Files matching this filemask are not considered for global downl' +
331 | 'oads counter. Moreover they never get tray icon.'
332 | Anchors = [akLeft, akTop, akRight]
333 | EditLabel.Width = 166
334 | EditLabel.Height = 13
335 | EditLabel.Caption = 'Don'#39't consider as download (mask)'
336 | Enabled = False
337 | TabOrder = 4
338 | OnEnter = textinputEnter
339 | end
340 | end
341 | object otherTab: TTabSheet
342 | Caption = 'Other'
343 | ImageIndex = 5
344 | ExplicitLeft = 0
345 | ExplicitTop = 0
346 | ExplicitWidth = 0
347 | ExplicitHeight = 0
348 | DesignSize = (
349 | 385
350 | 338)
351 | object Label1: TLabel
352 | Left = 10
353 | Top = 72
354 | Width = 21
355 | Height = 13
356 | Caption = 'Icon'
357 | FocusControl = iconBox
358 | end
359 | object realmBox: TLabeledEdit
360 | Left = 10
361 | Top = 32
362 | Width = 365
363 | Height = 21
364 | Hint =
365 | 'The realm string is shown on the user/pass dialog of the browser' +
366 | '. This realm will be used for selected files and their descendan' +
367 | 'ts.'
368 | Anchors = [akLeft, akTop, akRight]
369 | EditLabel.Width = 29
370 | EditLabel.Height = 13
371 | EditLabel.Caption = 'Realm'
372 | Enabled = False
373 | TabOrder = 0
374 | OnEnter = textinputEnter
375 | end
376 | object iconBox: TComboBoxEx
377 | Left = 10
378 | Top = 91
379 | Width = 127
380 | Height = 22
381 | ItemsEx = <>
382 | Style = csExDropDownList
383 | TabOrder = 1
384 | Images = mainFrm.images
385 | end
386 | object addiconBtn: TButton
387 | Left = 152
388 | Top = 91
389 | Width = 75
390 | Height = 22
391 | Caption = 'Add new...'
392 | TabOrder = 2
393 | OnClick = addiconBtnClick
394 | end
395 | end
396 | end
397 | object Panel1: TPanel
398 | Left = 0
399 | Top = 366
400 | Width = 393
401 | Height = 35
402 | Align = alBottom
403 | BevelOuter = bvNone
404 | TabOrder = 1
405 | DesignSize = (
406 | 393
407 | 35)
408 | object okBtn: TButton
409 | Left = 152
410 | Top = 6
411 | Width = 75
412 | Height = 25
413 | Anchors = [akTop, akRight]
414 | Caption = '&OK'
415 | Default = True
416 | ModalResult = 1
417 | TabOrder = 0
418 | end
419 | object cancelBtn: TButton
420 | Left = 313
421 | Top = 6
422 | Width = 75
423 | Height = 25
424 | Anchors = [akTop, akRight]
425 | Caption = 'Cancel'
426 | ModalResult = 2
427 | TabOrder = 1
428 | end
429 | object applyBtn: TButton
430 | Left = 232
431 | Top = 6
432 | Width = 75
433 | Height = 25
434 | Anchors = [akTop, akRight]
435 | Caption = '&Apply'
436 | TabOrder = 2
437 | OnClick = applyBtnClick
438 | end
439 | end
440 | end
441 |
--------------------------------------------------------------------------------
/filepropDlg.pas:
--------------------------------------------------------------------------------
1 | unit filepropDlg;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, ComCtrls, StdCtrls, ExtCtrls, CheckLst, utilLib, main, types, Grids,
8 | ValEdit, strutils, hslib, math;
9 |
10 | type
11 | TfilepropFrm = class(TForm)
12 | pages: TPageControl;
13 | permTab: TTabSheet;
14 | flagsTab: TTabSheet;
15 | diffTab: TTabSheet;
16 | commentTab: TTabSheet;
17 | maskTab: TTabSheet;
18 | hiddenChk: TCheckBox;
19 | hidetreeChk: TCheckBox;
20 | archivableChk: TCheckBox;
21 | browsableChk: TCheckBox;
22 | dontlogChk: TCheckBox;
23 | nodlChk: TCheckBox;
24 | dontconsiderChk: TCheckBox;
25 | hideemptyChk: TCheckBox;
26 | hideextChk: TCheckBox;
27 | Panel1: TPanel;
28 | okBtn: TButton;
29 | cancelBtn: TButton;
30 | difftplBox: TMemo;
31 | commentBox: TMemo;
32 | actionTabs: TTabControl;
33 | newaccBtn: TButton;
34 | anyAccChk: TCheckBox;
35 | anonChk: TCheckBox;
36 | allBtn: TButton;
37 | accountsBox: TListView;
38 | filesfilterBox: TLabeledEdit;
39 | foldersfilterBox: TLabeledEdit;
40 | deffileBox: TLabeledEdit;
41 | uploadfilterBox: TLabeledEdit;
42 | dontconsiderBox: TLabeledEdit;
43 | otherTab: TTabSheet;
44 | realmBox: TLabeledEdit;
45 | anyoneChk: TCheckBox;
46 | iconBox: TComboBoxEx;
47 | Label1: TLabel;
48 | addiconBtn: TButton;
49 | goToAccountsBtn: TButton;
50 | applyBtn: TButton;
51 | procedure accountsBoxGetImageIndex(Sender: TObject; Item: TListItem);
52 | procedure actionTabsChange(Sender: TObject);
53 | procedure newaccBtnClick(Sender: TObject);
54 | procedure allBtnClick(Sender: TObject);
55 | procedure accountsBoxChange(Sender: TObject; Item: TListItem; Change: TItemChange);
56 | procedure anonChkClick(Sender: TObject);
57 | procedure FormShow(Sender: TObject);
58 | procedure textinputEnter(Sender: TObject);
59 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
60 | procedure FormKeyPress(Sender: TObject; var Key: Char);
61 | procedure addiconBtnClick(Sender: TObject);
62 | procedure goToAccountsBtnClick(Sender: TObject);
63 | procedure applyBtnClick(Sender: TObject);
64 | private
65 | iconOfs: integer;
66 | public
67 | firstActionChange: boolean;
68 | users: array [TfileAction] of TStringDynArray;
69 | savePerm: array [TfileAction] of boolean; // should we apply/save permissions for this TfileAction ?
70 | currAction, prevAction: TfileAction;
71 | procedure updateAccountsBox;
72 | end;
73 |
74 | var
75 | filepropFrm: TfilepropFrm;
76 |
77 | implementation
78 |
79 | uses optionsDlg;
80 |
81 | {$R *.dfm}
82 |
83 | procedure TfilepropFrm.accountsBoxChange(Sender: TObject; Item: TListItem; Change: TItemChange);
84 | begin
85 | if (change = ctState)
86 | and (item.caption > '')
87 | and (stringExists(item.caption, users[currAction]) <> item.checked) then
88 | begin
89 | savePerm[currAction]:=TRUE;
90 | toggleString(item.caption, users[currAction])
91 | end;
92 | end;
93 |
94 | procedure TfilepropFrm.accountsBoxGetImageIndex(Sender: TObject; Item: TListItem);
95 | begin item.ImageIndex:=accountIcon(item.data) end;
96 |
97 | function str2fileaction(s:string):TfileAction;
98 | begin
99 | for result:=low(result) to high(result) do
100 | if FILEACTION2STR[result] = s then
101 | exit;
102 | result:=TfileAction(-1);
103 | end; // str2fileaction
104 |
105 | procedure TfilepropFrm.actionTabsChange(Sender: TObject);
106 | var
107 | l: TstringList;
108 | i: integer;
109 | ar: TstringDynArray;
110 | begin
111 | currAction:=str2fileaction(actionTabs.tabs[actionTabs.tabIndex]);
112 | if not firstActionChange then
113 | begin
114 | // we must save current selection before updating the checkmarks
115 | ar:=users[prevAction];
116 | // now 'ar' is actually an alias, no duplication
117 | setLength(ar, 0);
118 | if anonChk.checked then addString(USER_ANONYMOUS, ar);
119 | if anyAccChk.checked then addString(USER_ANY_ACCOUNT, ar);
120 | if anyoneChk.checked then addString(USER_ANYONE, ar);
121 | for i:=0 to accountsBox.Items.Count-1 do
122 | with accountsBox.Items[i] do
123 | if checked then
124 | addString(caption, ar);
125 |
126 | prevAction:=currAction;
127 | end;
128 | firstActionChange:=FALSE;
129 |
130 | l:=arrayToList(users[currAction]);
131 | try
132 | for i:=0 to accountsBox.Items.Count-1 do
133 | with accountsBox.Items[i] do
134 | checked:=l.IndexOf(caption) >= 0;
135 | anonChk.checked:=l.IndexOf(USER_ANONYMOUS) >= 0;
136 | anyAccChk.checked:=l.indexOf(USER_ANY_ACCOUNT) >= 0;
137 | anyoneChk.checked:=l.indexOf(USER_ANYONE) >= 0;
138 | finally l.free end;
139 |
140 | end;
141 |
142 | procedure TfilepropFrm.addiconBtnClick(Sender: TObject);
143 | var
144 | fn: string;
145 | i: integer;
146 | begin
147 | if not promptForFileName(fn) then exit;
148 | i:=getImageIndexForFile(fn);
149 | if i < 0 then exit;
150 | iconBox.itemsEx.addItem(idx_label(i), i, i, -1, 0, NIL);
151 | iconBox.itemIndex:=iconOfs+i;
152 | end;
153 |
154 | procedure TfilepropFrm.FormClose(Sender: TObject; var Action: TCloseAction);
155 | begin
156 | if (action = caHide) and (modalResult = mrOk) then
157 | applyBtnClick(applyBtn);
158 | end;
159 |
160 | procedure TfilepropFrm.FormKeyPress(Sender: TObject; var Key: Char);
161 | begin
162 | if pages.focused then
163 | if charInSet(key, ['1'..'9']) then
164 | try pages.TabIndex:=ord(key)-ord('0')-1
165 | except end;
166 | end;
167 |
168 | procedure TfilepropFrm.FormShow(Sender: TObject);
169 | var
170 | i: integer;
171 | f: Tfile;
172 |
173 | procedure setFlag(flag:TfileAttribute; cb:TCheckBox);
174 | var
175 | should: TCheckBoxState;
176 | begin
177 | cb.enabled:=TRUE;
178 | if flag in f.flags then
179 | should:=cbChecked
180 | else
181 | should:=cbUnchecked;
182 | if i = 0 then
183 | cb.state:=should
184 | else
185 | if (cb.state <> cbGrayed) and (cb.state <> should) then
186 | cb.state:=cbGrayed;
187 | end; // setFlag
188 |
189 | procedure setText(var v:string; box:TCustomEdit);
190 | const
191 | COLOR = clInfoBk;
192 | var
193 | n: integer;
194 | begin
195 | n:=countSubstr(#0, box.hint);
196 | box.enabled:=TRUE;
197 | if n = 0 then
198 | begin // init this edit box
199 | box.text:=v;
200 | box.hint:=box.hint+#0;
201 | exit;
202 | end;
203 | if (pos(#0+v+#0, box.hint) > 0)
204 | or (box.hint = #0) and (v = box.text) then
205 | exit; // the value is already there
206 | if n > 1 then
207 | begin // add the value to the list of values
208 | box.hint:=box.hint+v+#0;
209 | exit;
210 | end;
211 | box.hint:=box.hint+box.text+#0+v+#0; // init the list of values
212 | box.text:='(more values)'; // message to be shown
213 | // these properties are unhappily kept unaccessible through TcustomEdit interface
214 | try (box as Tlabelededit).color:=COLOR except end;
215 | try (box as Tmemo).color:=COLOR except end;
216 | end; // setText
217 |
218 | procedure setCaption();
219 | const
220 | MAX = 2;
221 | var
222 | a: TStringDynArray;
223 | i: integer;
224 | begin
225 | a:=NIL;
226 | for i:=0 to min(mainFrm.filesBox.SelectionCount, MAX)-1 do
227 | addString(mainFrm.filesBox.Selections[i].Text, a);
228 | if mainFrm.filesBox.SelectionCount > MAX then
229 | addString('...', a);
230 | caption:='Properties for '+join(', ', a);
231 | end; // setCaption
232 |
233 | var
234 | act: TfileAction;
235 | actions: set of TfileAction;
236 | begin
237 | firstActionChange:=TRUE;
238 |
239 | accountsBox.smallImages:=mainfrm.images;
240 | updateAccountsBox();
241 |
242 | maskTab.tabVisible:=FALSE;
243 | diffTab.tabVisible:=FALSE;
244 |
245 | iconBox.clear();
246 | iconBox.Enabled:=FALSE;
247 | addiconBtn.Enabled:=FALSE;
248 | i:=if_(mainfrm.filesBox.SelectionCount > 1, -1, selectedFile.getIconForTreeview());
249 | iconBox.itemsEx.addItem('Default', i, i, -1, 0, NIL);
250 | iconOfs:=iconBox.ItemsEx.count;
251 | for i:=0 to mainfrm.images.Count-1 do
252 | iconBox.itemsEx.addItem(idx_label(i), i, i, -1, 0, NIL);
253 |
254 | actions:=[FA_ACCESS];
255 | for i:=0 to mainFrm.filesBox.SelectionCount-1 do
256 | begin
257 | f:=mainFrm.filesBox.Selections[i].data;
258 |
259 | setText(f.comment, commentBox);
260 | setText(f.realm, realmBox);
261 |
262 | if f.isRealFolder() then
263 | begin
264 | include(actions, FA_UPLOAD);
265 | setText(f.uploadFilterMask, uploadfilterBox);
266 | end;
267 |
268 | if f.isFileOrFolder() then
269 | setFlag(FA_DONT_LOG, dontlogChk);
270 |
271 | if f.isFile() or f.isRealFolder() then
272 | setFlag(FA_DL_FORBIDDEN, nodlChk);
273 |
274 | if not f.isRoot() then
275 | begin
276 | setFlag(FA_HIDDEN, hiddenChk);
277 | if not iconBox.enabled then
278 | begin
279 | iconBox.enabled:=TRUE;
280 | iconBox.itemIndex:=f.icon+iconOfs;
281 | addiconBtn.Enabled:=TRUE;
282 | end
283 | else
284 | if iconBox.itemIndex <> f.icon+iconOfs then
285 | iconBox.itemIndex:=-1;
286 | end;
287 |
288 | if f.isFile() then
289 | setFlag(FA_DONT_COUNT_AS_DL, dontconsiderChk);
290 |
291 | if f.isFolder() then
292 | begin
293 | include(actions, FA_DELETE);
294 |
295 | diffTab.tabVisible:=TRUE;
296 | maskTab.tabVisible:=TRUE;
297 | setText(f.filesFilter, filesfilterBox);
298 | setText(f.foldersFilter, foldersfilterBox);
299 | setText(f.defaultFileMask, deffileBox);
300 | setText(f.dontCountAsDownloadMask, dontconsiderBox);
301 | setText(f.diffTpl, difftplBox);
302 |
303 | setFlag(FA_HIDDENTREE, hidetreeChk);
304 | setFlag(FA_HIDE_EXT, hideextChk);
305 | setFlag(FA_BROWSABLE, browsableChk);
306 | setFlag(FA_ARCHIVABLE, archivableChk);
307 | setFlag(FA_HIDE_EMPTY_FOLDERS, hideemptyChk);
308 |
309 | end;
310 |
311 | // collect usernames
312 | for act:=low(act) to high(act) do
313 | addUniqueArray(users[act], f.accounts[act]);
314 | end;
315 |
316 | for act:=low(act) to high(act) do
317 | begin
318 | savePerm[act]:=FALSE;
319 | if act in actions then
320 | actionTabs.tabs.add(FILEACTION2STR[act]);
321 | end;
322 |
323 | if easyMode then
324 | onlyForExperts([browsableChk, commentTab, realmBox, dontconsiderChk, maskTab, dontlogChk, hideextChk]);
325 |
326 | actionTabs.tabIndex:=0;
327 | actionTabsChange(NIL);
328 | setCaption();
329 | pages.TabIndex:=0;
330 | end;
331 |
332 | procedure TfilepropFrm.goToAccountsBtnClick(Sender: TObject);
333 | begin
334 | showOptions(optionsFrm.accountsPage);
335 | updateAccountsBox();
336 | actionTabsChange(NIL);
337 | end;
338 |
339 | procedure TfilepropFrm.allBtnClick(Sender: TObject);
340 | var
341 | i: integer;
342 | b: boolean;
343 | begin
344 | if accountsBox.items.Count = 0 then exit;
345 | with accountsBox.Items[0] do
346 | begin
347 | b:=not checked;
348 | checked:=b;
349 | end;
350 | for i:=1 to accountsBox.items.count-1 do
351 | accountsBox.Items[i].checked:=b;
352 | end;
353 |
354 | procedure TfilepropFrm.anonChkClick(Sender: TObject);
355 | var
356 | s: string;
357 | begin
358 | savePerm[currAction]:=TRUE;
359 | if sender = anonChk then s:=USER_ANONYMOUS
360 | else if sender = anyAccChk then
361 | begin
362 | s:=USER_ANY_ACCOUNT;
363 | accountsBox.enabled:=not anyAccChk.Checked;
364 | end
365 | else if sender = anyoneChk then
366 | begin
367 | s:=USER_ANYONE;
368 | accountsBox.enabled:=not anyoneChk.Checked;
369 | anonChk.enabled:=accountsBox.enabled;
370 | anyAccChk.enabled:=accountsBox.enabled;
371 | newaccBtn.Enabled:=accountsBox.enabled;
372 | end;
373 | allBtn.Enabled:=accountsBox.enabled;
374 | with sender as Tcheckbox do
375 | if checked then addUniqueString(s, users[currAction])
376 | else removeString(s, users[currAction]);
377 | end;
378 |
379 | procedure TfilepropFrm.applyBtnClick(Sender: TObject);
380 | var
381 | i: integer;
382 | f: Tfile;
383 | act: TfileAction;
384 |
385 | procedure applyFlag(flag:TfileAttribute; cb:TCheckBox);
386 | begin
387 | if (cb.State = cbGrayed)
388 | or not cb.Enabled
389 | or not cb.Visible then exit;
390 |
391 | if cb.Checked then include(f.flags, flag)
392 | else exclude(f.flags, flag);
393 | end; // applyFlag
394 |
395 | procedure applyText(var v:string; box:TCustomEdit);
396 | begin
397 | if box.modified then
398 | v:=box.Text;
399 | end; // applyText
400 |
401 | begin
402 | for act:=low(act) to high(act) do
403 | sortArray(users[act]);
404 |
405 | for i:=0 to mainFrm.filesBox.SelectionCount-1 do
406 | begin
407 | f:=mainFrm.filesBox.Selections[i].data;
408 |
409 | for act:=low(act) to high(act) do
410 | if savePerm[act]
411 | and ((act <> FA_UPLOAD) or f.isRealFolder())
412 | and ((act <> FA_DELETE) or f.isFolder()) then
413 | begin
414 |
415 | // The following is because we monitor every upload path
416 | if (act = FA_UPLOAD)
417 | and ((f.accounts[act] = NIL) <> (users[act] = NIL)) then // something has changed
418 | // WARNING: toggleString() can't be used here, it's not equivalent
419 | if users[act] <> NIL then addString(f.resource, uploadPaths)
420 | else removeString(f.resource, uploadPaths);
421 |
422 | f.accounts[act]:=users[act];
423 | end;
424 |
425 | applyText(f.comment, commentBox);
426 | applyText(f.realm, realmBox);
427 |
428 | if f.isFile() then
429 | applyFlag(FA_DONT_COUNT_AS_DL, dontconsiderChk);
430 |
431 | if f.isFolder() then
432 | begin
433 | applyText(f.diffTpl, difftplBox);
434 | applyText(f.filesFilter, filesfilterBox);
435 | applyText(f.foldersFilter, foldersfilterBox);
436 | applyText(f.defaultFileMask, deffileBox);
437 | applyText(f.dontCountAsDownloadMask, dontconsiderBox);
438 |
439 | applyFlag(FA_HIDDENTREE, hidetreeChk);
440 | applyFlag(FA_HIDE_EXT, hideextChk);
441 | applyFlag(FA_HIDE_EMPTY_FOLDERS, hideemptyChk);
442 | applyFlag(FA_BROWSABLE, browsableChk);
443 | applyFlag(FA_ARCHIVABLE, archivableChk);
444 | end;
445 |
446 | if not f.isRoot() then
447 | begin
448 | applyFlag(FA_HIDDEN, hiddenChk);
449 | if iconBox.itemIndex > -1 then
450 | f.setupImage(iconBox.itemIndex-iconOfs);
451 | end;
452 |
453 | if f.isRealFolder() then
454 | applyText(f.uploadFilterMask, uploadfilterBox);
455 |
456 | if f.isFileOrFolder() then
457 | applyFlag(FA_DONT_LOG, dontlogChk);
458 |
459 | if f.isFile() or f.isRealFolder() then
460 | applyFlag(FA_DL_FORBIDDEN, nodlChk);
461 | end;
462 | end;
463 |
464 | procedure TfilepropFrm.newaccBtnClick(Sender: TObject);
465 | var
466 | acc: Paccount;
467 | begin
468 | acc:=createAccountOnTheFly();
469 | if acc = NIL then exit;
470 | with accountsBox.Items.add() do
471 | begin
472 | caption:=acc.user;
473 | data:=acc;
474 | checked:=TRUE;
475 | end;
476 | end;
477 |
478 | procedure TfilepropFrm.textinputEnter(Sender: TObject);
479 |
480 | function chooseValue(var s:string):boolean;
481 | var
482 | l: string;
483 | begin
484 | l:=s;
485 | repeat s:=chop(#0, l)
486 | until (s > '') or (l = '');
487 | result:=TRUE;
488 | end; // chooseValue
489 |
490 | var
491 | box: TcustomEdit;
492 | s, h: string;
493 | begin
494 | box:=sender as TcustomEdit;
495 | if countSubstr(#0, box.hint) < 2 then exit;
496 |
497 | s:=box.hint;
498 | h:=chop(#0, s);
499 | if not chooseValue(s) then exit;
500 | box.text:=s;
501 | box.hint:=h;
502 | // these properties are unhappily kept unaccessible through TcustomEdit interface
503 | try (box as Tlabelededit).color:=clWindow except end;
504 | try (box as Tmemo).color:=clWindow except end;
505 | end;
506 |
507 | procedure TfilepropFrm.updateAccountsBox;
508 | var
509 | i: integer;
510 | a: Paccount;
511 | begin
512 | accountsBox.clear();
513 | for i:=0 to length(accounts)-1 do
514 | begin
515 | a:=@accounts[i];
516 | if not a.enabled then continue;
517 | accountsBox.addItem(a.user, Tobject(a));
518 | end;
519 | end; // updateAccountsBox
520 |
521 | end.
522 |
--------------------------------------------------------------------------------
/folderKindDlg.dfm:
--------------------------------------------------------------------------------
1 | object folderKindFrm: TfolderKindFrm
2 | Left = 257
3 | Top = 199
4 | BorderIcons = [biSystemMenu, biMinimize]
5 | BorderStyle = bsDialog
6 | Caption = 'What kind of folder do you want?'
7 | ClientHeight = 206
8 | ClientWidth = 367
9 | Color = clBtnFace
10 | Font.Charset = DEFAULT_CHARSET
11 | Font.Color = clWindowText
12 | Font.Height = -11
13 | Font.Name = 'MS Sans Serif'
14 | Font.Style = []
15 | OldCreateOrder = False
16 | Position = poMainFormCenter
17 | OnCreate = FormCreate
18 | PixelsPerInch = 96
19 | TextHeight = 13
20 | object realLbl: TLabel
21 | Left = 136
22 | Top = 40
23 | Width = 191
24 | Height = 13
25 | Caption = 'A real folder is faster, good for big folders'
26 | end
27 | object virtuaLbl: TLabel
28 | Left = 136
29 | Top = 96
30 | Width = 213
31 | Height = 13
32 | Caption = 'A virtual folder is easier, good for small folders'
33 | WordWrap = True
34 | end
35 | object Label3: TLabel
36 | Left = 48
37 | Top = 128
38 | Width = 28
39 | Height = 63
40 | Caption = '?'
41 | Font.Charset = ANSI_CHARSET
42 | Font.Color = clWindowText
43 | Font.Height = -56
44 | Font.Name = 'Times New Roman'
45 | Font.Style = [fsBold]
46 | ParentFont = False
47 | end
48 | object hintLbl: TLabel
49 | Left = 80
50 | Top = 152
51 | Width = 201
52 | Height = 33
53 | AutoSize = False
54 | Caption = 'Not sure? Hint: most time you need real folders!'
55 | end
56 | object realBtn: TBitBtn
57 | Left = 20
58 | Top = 34
59 | Width = 107
60 | Height = 25
61 | Caption = '&Real folder'
62 | Default = True
63 | ModalResult = 7
64 | TabOrder = 0
65 | Glyph.Data = {
66 | 36040000424D3604000000000000360000002800000010000000100000000100
67 | 2000000000000004000000000000000000000000000000000000FF00FF00FF00
68 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
69 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
70 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
71 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
72 | FF006D6DED001B1BC9001B1BC9003838E6007676EE00B2B2F600FF00FF00FF00
73 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
74 | FF006161EB008383EF006565EB004343E7001E1EDE001919BD001A1AC0002828
75 | E4006565EB00A4A4F400FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
76 | FF004848E8009494F2008686F0008686F0008686F0008686F0007C7CEE005A5A
77 | EA002C2CE4001B1BCD001919BB009393F100FF00FF00FF00FF00FF00FF00FF00
78 | FF002727E3009A9AF2008D8DF1008D8DF1008D8DF1008D8DF1008D8DF1008D8D
79 | F1008D8DF1008D8DF1003838E6005353E900FF00FF00FF00FF00FF00FF00FF00
80 | FF003131E500B1B1F5009696F2009696F2009696F2009696F2009696F2009696
81 | F2009696F2009696F2005E5EEA003535E500FF00FF00FF00FF00FF00FF00FF00
82 | FF002727E300B1B1F5009F9FF3009F9FF3009F9FF3009F9FF3009F9FF3009F9F
83 | F3009F9FF3009F9FF3007878EE001D1DDB00FF00FF00FF00FF00FF00FF00FF00
84 | FF004848E800A4A4F400A4A4F400A4A4F400A4A4F400A4A4F400A4A4F400A4A4
85 | F400A4A4F400A4A4F4009494F2001A1AC600FF00FF00FF00FF00FF00FF00FF00
86 | FF005E5EEA00AFAFF500C6C6F800C1C1F700BBBBF700BBBBF700BBBBF700BBBB
87 | F700BBBBF700BBBBF700ABABF5001B1BCB00FF00FF00FF00FF00FF00FF00D9D9
88 | FB008F8FF1006161EB006D6DED006F6FED009191F100D9D9FB00D1D1F900D2D2
89 | FA00D1D1F900D2D2FA00BBBBF7001E1EE200B4B4F600FF00FF00FF00FF00D9D9
90 | FB00B1B1F500A4A4F400A4A4F400A4A4F4008686F0006C6CEC009898F200BABA
91 | F600DDDDFB00EDEDFD00CFCFF9003C3CE6009F9FF300FF00FF00FF00FF00FF00
92 | FF00A1A1F300A4A4F400A4A4F400A4A4F400B2B2F6009191F1009494F2009494
93 | F2008686F0007171ED005151E9006161EB00FF00FF00FF00FF00FF00FF00FF00
94 | FF00A8A8F4009B9BF300A4A4F400B6B6F6007F7FEF00E4E4FC00FF00FF00CDCD
95 | F900AAAAF400ABABF500B4B4F600FF00FF00FF00FF00FF00FF00FF00FF00FF00
96 | FF00FF00FF00FF00FF00FF00FF00D9D9FB00FF00FF00FF00FF00FF00FF00FF00
97 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
98 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
99 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
100 | end
101 | object virtuaBtn: TBitBtn
102 | Left = 20
103 | Top = 90
104 | Width = 107
105 | Height = 25
106 | Caption = '&Virtual folder'
107 | ModalResult = 6
108 | TabOrder = 1
109 | Glyph.Data = {
110 | 36040000424D3604000000000000360000002800000010000000100000000100
111 | 2000000000000004000000000000000000000000000000000000FF00FF00FF00
112 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
113 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
114 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
115 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
116 | FF0086BED40049869B005A7E89008D8F9100B1B2B100D6D1D100FF00FF00FF00
117 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
118 | FF006AC3E20075DCFD005BCAF40043BCE70035A1C7003587A0004C7C8E008089
119 | 8C00A8A8A800CCCCCB00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
120 | FF0052B9DD0087E1FE0078DEFD0078DEFD0078DEFD0078DEFD006FD8FB0056C8
121 | EE0043A9CD003C8FAB0049798A00C1C2C100FF00FF00FF00FF00FF00FF00FF00
122 | FF0031ADD9008DE6FE0080E6FE0080E6FE0080E6FE0080E6FE0080E6FE0080E6
123 | FE0080E6FE0080E6FE003FB7DE009D9E9E00FF00FF00FF00FF00FF00FF00FF00
124 | FF003CB1D900A8F2FE0088EFFF0088EFFF0088EFFF0088EFFF0088EFFF0088EF
125 | FF0088EFFF0088EFFF0059CBEF0087919300FF00FF00FF00FF00FF00FF00FF00
126 | FF0031ADD900A7F8FE0093F8FF0093F8FF0093F8FF0093F8FF0093F8FF0093F8
127 | FF0093F8FF0093F8FF006ED8F80067859000FF00FF00FF00FF00FF00FF00FF00
128 | FF004CBAE300A2EDF60099FDFF0099FDFF0099FDFF0099FDFF0099FDFF0099FD
129 | FF0099FDFF0099FDFF0088E8FE004E7F9100FF00FF00FF00FF00FF00FF00FF00
130 | FF0065C1E200B0E8F400C0FCFE00B9FCFE00B3FDFF00B3FDFF00B3FDFF00B3FD
131 | FF00B3FDFF00B3FDFF00A1F3FF004A859B00FF00FF00FF00FF00FF00FF00DBEF
132 | F8008CE0F3005ED4ED006CCFED0074CDE80093D9EE00D6FBFD00CBFCFE00CDFB
133 | FE00CBFCFE00CDFBFE00B3F1FE005A93A600D4D4D500FF00FF00FF00FF00DBEF
134 | F800AFEDF60099FDFF0099FDFF0099FDFF0080ECF60072CBE5009CDBEE00BBEA
135 | F500DDF6FB00ECFDFE00CAF3FD0061A5C000C9C9C800FF00FF00FF00FF00FF00
136 | FF00A5DDEF0099FDFF0099FDFF0099FDFF00AFF1F90099D9E90093DFF20094DB
137 | F20089D8ED0074D4EA0062B9D8007ABAD200FF00FF00FF00FF00FF00FF00FF00
138 | FF00ADDDEF00A0DBED00A6E3F200B5ECF60098C3D500F0F0F000FF00FF00D0EB
139 | F600AFDEEE00B0DFF000BEE0EC00FF00FF00FF00FF00FF00FF00FF00FF00FF00
140 | FF00FF00FF00FF00FF00FF00FF00DBEFF800FF00FF00FF00FF00FF00FF00FF00
141 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
142 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
143 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
144 | end
145 | end
146 |
--------------------------------------------------------------------------------
/folderKindDlg.pas:
--------------------------------------------------------------------------------
1 | unit folderKindDlg;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls, Buttons, strUtils, ExtCtrls;
8 |
9 | type
10 | TfolderKindFrm = class(TForm)
11 | realLbl: TLabel;
12 | virtuaLbl: TLabel;
13 | realBtn: TBitBtn;
14 | virtuaBtn: TBitBtn;
15 | Label3: TLabel;
16 | hintLbl: TLabel;
17 | procedure FormCreate(Sender: TObject);
18 | private
19 | { Private declarations }
20 | public
21 | { Public declarations }
22 | end;
23 |
24 | implementation
25 |
26 | {$R *.dfm}
27 |
28 | procedure TfolderKindFrm.FormCreate(Sender: TObject);
29 | begin
30 | realBtn.Font.Style:=[fsBold];
31 | with hintLbl do caption:=ansiReplaceStr(caption,'? ','?'#13);
32 | end;
33 |
34 | end.
35 |
--------------------------------------------------------------------------------
/fontello.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "",
3 | "css_prefix_text": "fa-",
4 | "css_use_suffix": false,
5 | "hinting": true,
6 | "units_per_em": 1000,
7 | "ascent": 850,
8 | "glyphs": [
9 | {
10 | "uid": "823a9e02e643318116fea40a00190e4e",
11 | "css": "asterisk",
12 | "code": 59392,
13 | "src": "fontawesome"
14 | },
15 | {
16 | "uid": "43ab845088317bd348dee1d975700c48",
17 | "css": "check-circled",
18 | "code": 59393,
19 | "src": "fontawesome"
20 | },
21 | {
22 | "uid": "8b80d36d4ef43889db10bc1f0dc9a862",
23 | "css": "user",
24 | "code": 59394,
25 | "src": "fontawesome"
26 | },
27 | {
28 | "uid": "598a5f2bcf3521d1615de8e1881ccd17",
29 | "css": "clock",
30 | "code": 59395,
31 | "src": "fontawesome"
32 | },
33 | {
34 | "uid": "9a76bc135eac17d2c8b8ad4a5774fc87",
35 | "css": "download",
36 | "code": 59396,
37 | "src": "fontawesome"
38 | },
39 | {
40 | "uid": "eeec3208c90b7b48e804919d0d2d4a41",
41 | "css": "upload",
42 | "code": 59397,
43 | "src": "fontawesome"
44 | },
45 | {
46 | "uid": "98d9c83c1ee7c2c25af784b518c522c5",
47 | "css": "ban",
48 | "code": 59398,
49 | "src": "fontawesome"
50 | },
51 | {
52 | "uid": "d35a1d35efeb784d1dc9ac18b9b6c2b6",
53 | "css": "edit",
54 | "code": 59399,
55 | "src": "fontawesome"
56 | },
57 | {
58 | "uid": "dd6c6b221a1088ff8a9b9cd32d0b3dd5",
59 | "css": "check",
60 | "code": 59400,
61 | "src": "fontawesome"
62 | },
63 | {
64 | "uid": "f8aa663c489bcbd6e68ec8147dca841e",
65 | "css": "folder",
66 | "code": 59401,
67 | "src": "fontawesome"
68 | },
69 | {
70 | "uid": "197375a3cea8cb90b02d06e4ddf1433d",
71 | "css": "globe",
72 | "code": 59402,
73 | "src": "fontawesome"
74 | },
75 | {
76 | "uid": "d7271d490b71df4311e32cdacae8b331",
77 | "css": "home",
78 | "code": 59403,
79 | "src": "fontawesome"
80 | },
81 | {
82 | "uid": "f2aa28a2548ed3d2be718d087b65ee21",
83 | "css": "key",
84 | "code": 59404,
85 | "src": "fontawesome"
86 | },
87 | {
88 | "uid": "c1f1975c885aa9f3dad7810c53b82074",
89 | "css": "lock",
90 | "code": 59405,
91 | "src": "fontawesome"
92 | },
93 | {
94 | "uid": "a73c5deb486c8d66249811642e5d719a",
95 | "css": "refresh",
96 | "code": 59406,
97 | "src": "fontawesome"
98 | },
99 | {
100 | "uid": "09feb4465d9bd1364f4e301c9ddbaa92",
101 | "css": "retweet",
102 | "code": 59407,
103 | "src": "fontawesome"
104 | },
105 | {
106 | "uid": "474656633f79ea2f1dad59ff63f6bf07",
107 | "css": "star",
108 | "code": 59408,
109 | "src": "fontawesome"
110 | },
111 | {
112 | "uid": "0f4cae16f34ae243a6144c18a003f2d8",
113 | "css": "cancel-circled",
114 | "code": 59409,
115 | "src": "fontawesome"
116 | },
117 | {
118 | "uid": "7f3d8ff1d5f6ee019f0c00ed7a86caec",
119 | "css": "truck",
120 | "code": 59410,
121 | "src": "fontawesome"
122 | },
123 | {
124 | "uid": "559647a6f430b3aeadbecd67194451dd",
125 | "css": "menu",
126 | "code": 61641,
127 | "src": "fontawesome"
128 | },
129 | {
130 | "uid": "3a26448b711645ba1abfc86c1a6e2f30",
131 | "css": "coffee",
132 | "code": 61684,
133 | "src": "fontawesome"
134 | },
135 | {
136 | "uid": "ab95e1351ebaec5850101097cbf7097f",
137 | "css": "quote-left",
138 | "code": 61709,
139 | "src": "fontawesome"
140 | },
141 | {
142 | "uid": "e80ae555c1413a4ec18b33fb348b4049",
143 | "css": "file-archive",
144 | "code": 61894,
145 | "src": "fontawesome"
146 | },
147 | {
148 | "uid": "bbfb51903f40597f0b70fd75bc7b5cac",
149 | "css": "trash",
150 | "code": 61944,
151 | "src": "fontawesome"
152 | },
153 | {
154 | "uid": "818981e2ad316f18ae61cfa805d41309",
155 | "css": "user-circle",
156 | "code": 62141,
157 | "src": "fontawesome"
158 | },
159 | {
160 | "uid": "5278ef7773e948d56c4d442c8c8c98cf",
161 | "css": "lightbulb",
162 | "code": 61675,
163 | "src": "fontawesome"
164 | },
165 | {
166 | "uid": "56a21935a5d4d79b2e91ec00f760b369",
167 | "css": "sort",
168 | "code": 61660,
169 | "src": "fontawesome"
170 | },
171 | {
172 | "uid": "0cd2582b8c93719d066ee0affd02ac78",
173 | "css": "sort-alt-up",
174 | "code": 61792,
175 | "src": "fontawesome"
176 | },
177 | {
178 | "uid": "27b13eff5eb0ca15e01a6e65ffe6eeec",
179 | "css": "sort-alt-down",
180 | "code": 61793,
181 | "src": "fontawesome"
182 | },
183 | {
184 | "uid": "9dd9e835aebe1060ba7190ad2b2ed951",
185 | "css": "search",
186 | "code": 59411,
187 | "src": "fontawesome"
188 | },
189 | {
190 | "uid": "0d20938846444af8deb1920dc85a29fb",
191 | "css": "logout",
192 | "code": 59412,
193 | "src": "fontawesome"
194 | }
195 | ]
196 | }
--------------------------------------------------------------------------------
/hfs.bdsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 | hfs.dpr
14 |
15 |
16 | 7.0
17 |
18 |
19 | 8
20 | 0
21 | 1
22 | 1
23 | 0
24 | 0
25 | 1
26 | 1
27 | 1
28 | 0
29 | 0
30 | 1
31 | 0
32 | 1
33 | 1
34 | 1
35 | 0
36 | 0
37 | 0
38 | 0
39 | 0
40 | 1
41 | 1
42 | 1
43 | 2
44 | 1
45 | True
46 | True
47 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
48 |
49 | False
50 |
51 | True
52 | True
53 | True
54 | True
55 | True
56 | True
57 | True
58 | True
59 | True
60 | True
61 | True
62 | True
63 | True
64 | True
65 | True
66 | True
67 | True
68 | True
69 | True
70 | True
71 | True
72 | True
73 | True
74 | True
75 | True
76 | True
77 | True
78 | True
79 | True
80 | True
81 | True
82 | True
83 | True
84 | True
85 | True
86 | True
87 | True
88 | True
89 | True
90 | True
91 | True
92 | True
93 | True
94 | True
95 | True
96 | True
97 | False
98 | False
99 | False
100 | True
101 | True
102 | True
103 | True
104 | True
105 | True
106 |
107 |
108 |
109 | 3
110 | 0
111 | False
112 | 1
113 | False
114 | False
115 | False
116 | 16384
117 | 1048576
118 | 4194304
119 | HFS ~ HTTP File Server - www.rejetto.com/hfs
120 |
121 |
122 |
123 |
124 |
125 |
126 | $(DELPHI)\Lib\Debug;C:\code\other\jcl\source\include
127 | vcl;rtl;vclx;VclSmp;DJCL60;IcsDel60
128 |
129 | C:\code\other\ics\Delphi\Vc32\
130 | False
131 |
132 |
133 |
134 |
135 |
136 | False
137 |
138 |
139 | True
140 | False
141 |
142 |
143 |
144 | $00000000
145 |
146 |
147 |
148 | True
149 | False
150 | 2
151 | 3
152 | 0
153 | 0
154 | True
155 | False
156 | False
157 | False
158 | False
159 | 1040
160 | 1252
161 |
162 |
163 | rejetto
164 |
165 | 2.4.0.0
166 | HFS
167 | Copyright (C) 2002 Massimo Melina (www.rejetto.com)
168 |
169 | hfs.exe
170 | Http File Server
171 | 2.4
172 |
173 |
174 |
175 |
176 | Borland InterBase Express Components
177 | Intraweb 8.0 Design Package for Borland Development Studio 2006
178 | Indy 10 Core Design Time
179 | Borland Sample Components
180 | Indy 10 Protocols Design Time
181 | TeeChart Components
182 |
183 |
184 |
185 |
--------------------------------------------------------------------------------
/hfs.cfg:
--------------------------------------------------------------------------------
1 | -$A8
2 | -$B-
3 | -$C+
4 | -$D+
5 | -$E-
6 | -$F-
7 | -$G+
8 | -$H+
9 | -$I+
10 | -$J-
11 | -$K-
12 | -$L+
13 | -$M-
14 | -$N+
15 | -$O+
16 | -$P+
17 | -$Q-
18 | -$R-
19 | -$S-
20 | -$T-
21 | -$U-
22 | -$V+
23 | -$W+
24 | -$X+
25 | -$Y+
26 | -$Z1
27 | -GD
28 | -cg
29 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
30 | -H+
31 | -W+
32 | -M
33 | -$M16384,1048576
34 | -K$00400000
35 | -LE"C:\Users\rejetto\Documents\Borland Studio Projects\Bpl"
36 | -LN"C:\Users\rejetto\Documents\Borland Studio Projects\Bpl"
37 | -U"c:\program files (x86)\borland\bds\4.0\Lib\Debug;C:\code\other\jcl\source\include"
38 | -O"c:\program files (x86)\borland\bds\4.0\Lib\Debug;C:\code\other\jcl\source\include"
39 | -I"c:\program files (x86)\borland\bds\4.0\Lib\Debug;C:\code\other\jcl\source\include"
40 | -R"c:\program files (x86)\borland\bds\4.0\Lib\Debug;C:\code\other\jcl\source\include"
41 | -w-UNSAFE_TYPE
42 | -w-UNSAFE_CODE
43 | -w-UNSAFE_CAST
44 |
--------------------------------------------------------------------------------
/hfs.dfm:
--------------------------------------------------------------------------------
1 | object Form1: TForm1
2 | Left = 0
3 | Top = 0
4 | Caption = 'Form1'
5 | ClientHeight = 231
6 | ClientWidth = 505
7 | Color = clBtnFace
8 | Font.Charset = DEFAULT_CHARSET
9 | Font.Color = clWindowText
10 | Font.Height = -11
11 | Font.Name = 'Tahoma'
12 | Font.Style = []
13 | OldCreateOrder = False
14 | PixelsPerInch = 96
15 | TextHeight = 13
16 | end
17 |
--------------------------------------------------------------------------------
/hfs.dpr:
--------------------------------------------------------------------------------
1 | {
2 | Copyright (C) 2002-2014 Massimo Melina (www.rejetto.com)
3 |
4 | This file is part of HFS ~ HTTP File Server.
5 |
6 | HFS is free software; you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation; either version 2 of the License, or
9 | (at your option) any later version.
10 |
11 | HFS is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with HSG; if not, write to the Free Software
18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 | }
20 | {$INCLUDE defs.inc }
21 | {$SetPEOptFlags $100 } //IMAGE_DLLCHARACTERISTICS_NX_COMPAT
22 | program hfs;
23 |
24 | uses
25 | {$IFDEF EX_DEBUG}
26 | ftmExceptionForm,
27 | {$ENDIF }
28 | uFreeLocalizer,
29 | monoLib,
30 | Forms,
31 | windows,
32 | types,
33 | hslib,
34 | sysUtils,
35 | main in 'main.pas' {mainFrm},
36 | newuserpassDlg in 'newuserpassDlg.pas' {newuserpassFrm},
37 | optionsDlg in 'optionsDlg.pas' {optionsFrm},
38 | utillib in 'utillib.pas',
39 | longinputDlg in 'longinputDlg.pas' {longinputFrm},
40 | folderKindDlg in 'folderKindDlg.pas' {folderKindFrm},
41 | shellExtDlg in 'shellExtDlg.pas' {shellExtFrm},
42 | diffDlg in 'diffDlg.pas' {diffFrm},
43 | classesLib in 'classesLib.pas',
44 | ipsEverDlg in 'ipsEverDlg.pas' {ipsEverFrm},
45 | parserLib in 'parserLib.pas',
46 | purgeDlg in 'purgeDlg.pas' {purgeFrm},
47 | listSelectDlg in 'listSelectDlg.pas' {listSelectFrm},
48 | filepropDlg in 'filepropDlg.pas' {filepropFrm},
49 | runscriptDlg in 'runscriptDlg.pas' {runScriptFrm},
50 | scriptLib in 'scriptLib.pas',
51 | traylib in 'traylib.pas';
52 |
53 | {$R *.res}
54 |
55 | procedure processSlaveParams(params:string);
56 | var
57 | ss: TStringDynArray;
58 | begin
59 | if mainfrm = NIL then exit;
60 | ss:=split(#13,params);
61 | processParams_before(ss);
62 | mainfrm.processParams_after(ss);
63 | end;
64 |
65 | function isSingleInstance():boolean;
66 | var
67 | params:TStringDynArray;
68 | ini, tpl:string;
69 | begin
70 | result:=FALSE;
71 | // the -i parameter affects loadCfg()
72 | params:=paramsAsArray();
73 | processParams_before(params, 'i');
74 | loadCfg(ini, tpl);
75 | chop('only-1-instance=', ini);
76 | if ini = '' then exit;
77 | ini:=chopLine(ini);
78 | result:=sameText(ini, 'yes');
79 | end; // isSingleInstance
80 |
81 | begin
82 | mono.onSlaveParams:=processSlaveParams;
83 | if not holdingKey(VK_CONTROL) then
84 | begin
85 | if not mono.init('HttpFileServer') then
86 | begin
87 | msgDlg('monoLib error: '+mono.error, MB_ICONERROR+MB_OK);
88 | halt(1);
89 | end;
90 | if not mono.master and isSingleInstance() then
91 | begin
92 | mono.sendParams();
93 | exit;
94 | end;
95 | end;
96 | {$IFDEF EX_DEBUG}initErrorHandler(format('HFS %s (%s)', [VERSION, VERSION_BUILD]));{$ENDIF}
97 | Application.Initialize();
98 |
99 | if fileExists('hfs.lng') then
100 | begin
101 | FreeLocalizer.AutoTranslate := True;
102 | try FreeLocalizer.LanguageFile := 'hfs.lng';
103 | except msgDlg('Localization not supporting your codepage', MB_ICONERROR+MB_OK) end;
104 | end;
105 |
106 | Application.CreateForm(TmainFrm, mainFrm);
107 | Application.CreateForm(TnewuserpassFrm, newuserpassFrm);
108 | Application.CreateForm(ToptionsFrm, optionsFrm);
109 | Application.CreateForm(TdiffFrm, diffFrm);
110 | Application.CreateForm(TipsEverFrm, ipsEverFrm);
111 | Application.CreateForm(TrunScriptFrm, runScriptFrm);
112 | mainfrm.finalInit();
113 | Application.Run;
114 | {$IFDEF EX_DEBUG}closeErrorHandler();{$ENDIF}
115 | end.
116 |
--------------------------------------------------------------------------------
/hfs.dproj.local:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/hfs.otares:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rejetto/hfs2/6ff458fb731f86b13e0dee577a9220b6902100fd/hfs.otares
--------------------------------------------------------------------------------
/hfs.pas:
--------------------------------------------------------------------------------
1 | unit hfs;
2 |
3 | interface
4 |
5 | uses
6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
8 |
9 | type
10 | TForm1 = class(TForm)
11 | private
12 | { Private declarations }
13 | public
14 | { Public declarations }
15 | end;
16 |
17 | var
18 | Form1: TForm1;
19 |
20 | implementation
21 |
22 | {$R *.dfm}
23 |
24 | initialization
25 | showMessage('test');
26 |
27 |
28 | end.
29 |
--------------------------------------------------------------------------------
/hfs.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rejetto/hfs2/6ff458fb731f86b13e0dee577a9220b6902100fd/hfs.res
--------------------------------------------------------------------------------
/hfs_Icon.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rejetto/hfs2/6ff458fb731f86b13e0dee577a9220b6902100fd/hfs_Icon.ico
--------------------------------------------------------------------------------
/hfs_Icon1.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rejetto/hfs2/6ff458fb731f86b13e0dee577a9220b6902100fd/hfs_Icon1.ico
--------------------------------------------------------------------------------
/hfs_Icon2.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rejetto/hfs2/6ff458fb731f86b13e0dee577a9220b6902100fd/hfs_Icon2.ico
--------------------------------------------------------------------------------
/ipsEverDlg.dfm:
--------------------------------------------------------------------------------
1 | object ipsEverFrm: TipsEverFrm
2 | Left = 0
3 | Top = 0
4 | BorderStyle = bsDialog
5 | Caption = 'Addresses ever connected'
6 | ClientHeight = 271
7 | ClientWidth = 286
8 | Color = clBtnFace
9 | Constraints.MaxHeight = 300
10 | Constraints.MinHeight = 300
11 | Font.Charset = DEFAULT_CHARSET
12 | Font.Color = clWindowText
13 | Font.Height = -11
14 | Font.Name = 'Tahoma'
15 | Font.Style = []
16 | OldCreateOrder = False
17 | Position = poMainFormCenter
18 | OnShow = FormShow
19 | DesignSize = (
20 | 286
21 | 271)
22 | PixelsPerInch = 96
23 | TextHeight = 13
24 | object totalLbl: TLabel
25 | Left = 197
26 | Top = 246
27 | Width = 61
28 | Height = 13
29 | Anchors = [akLeft]
30 | Caption = 'Total label...'
31 | end
32 | object ipsBox: TMemo
33 | Left = 0
34 | Top = 0
35 | Width = 286
36 | Height = 236
37 | Align = alTop
38 | Anchors = [akLeft, akTop, akRight, akBottom]
39 | ReadOnly = True
40 | ScrollBars = ssVertical
41 | TabOrder = 0
42 | end
43 | object resetBtn: TButton
44 | Left = 114
45 | Top = 241
46 | Width = 75
47 | Height = 25
48 | Anchors = [akLeft]
49 | Caption = '&Reset'
50 | TabOrder = 1
51 | OnClick = resetBtnClick
52 | end
53 | object editBtn: TButton
54 | Left = 8
55 | Top = 241
56 | Width = 95
57 | Height = 25
58 | Anchors = [akLeft]
59 | Caption = '&Open in editor'
60 | TabOrder = 2
61 | OnClick = editBtnClick
62 | end
63 | end
64 |
--------------------------------------------------------------------------------
/ipsEverDlg.pas:
--------------------------------------------------------------------------------
1 | unit ipsEverDlg;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls;
8 |
9 | type
10 | TipsEverFrm = class(TForm)
11 | ipsBox: TMemo;
12 | resetBtn: TButton;
13 | totalLbl: TLabel;
14 | editBtn: TButton;
15 | procedure resetBtnClick(Sender: TObject);
16 | procedure FormShow(Sender: TObject);
17 | procedure editBtnClick(Sender: TObject);
18 | private
19 | { Private declarations }
20 | public
21 | procedure refreshData();
22 | { Public declarations }
23 | end;
24 |
25 | var
26 | ipsEverFrm: TipsEverFrm;
27 |
28 | implementation
29 |
30 | {$R *.dfm}
31 |
32 | uses
33 | main, utilLib;
34 |
35 | procedure TipsEverFrm.resetBtnClick(Sender: TObject);
36 | begin
37 | ipsEverConnected.clear();
38 | refreshData();
39 | end;
40 |
41 | procedure TipsEverFrm.editBtnClick(Sender: TObject);
42 | var
43 | fn: string;
44 | begin
45 | fn:=saveTempFile(ipsEverConnected.text);
46 | if renameFile(fn, fn+'.txt') then exec(fn+'.txt')
47 | else msgDlg(MSG_NO_TEMP, MB_ICONERROR);
48 | end;
49 |
50 | procedure TipsEverFrm.FormShow(Sender: TObject);
51 | begin refreshData() end;
52 |
53 | procedure TipsEverFrm.refreshData();
54 | begin
55 | ipsBox.text:=ipsEverConnected.text;
56 | totalLbl.caption:=format('Total: %d', [ipsEverConnected.count]);
57 | repaintTray();
58 | end; // refreshData
59 |
60 | end.
61 |
--------------------------------------------------------------------------------
/ipservices.txt:
--------------------------------------------------------------------------------
1 | http://hfsservice.rejetto.com/ip.php|!
2 | http://checkip.dyndns.org|:
3 |
--------------------------------------------------------------------------------
/listSelectDlg.dfm:
--------------------------------------------------------------------------------
1 | object listSelectFrm: TlistSelectFrm
2 | Left = 0
3 | Top = 0
4 | BorderStyle = bsToolWindow
5 | ClientHeight = 173
6 | ClientWidth = 183
7 | Color = clBtnFace
8 | Font.Charset = DEFAULT_CHARSET
9 | Font.Color = clWindowText
10 | Font.Height = -11
11 | Font.Name = 'Tahoma'
12 | Font.Style = []
13 | OldCreateOrder = False
14 | Position = poMainFormCenter
15 | PixelsPerInch = 96
16 | TextHeight = 13
17 | object listBox: TCheckListBox
18 | Left = 0
19 | Top = 0
20 | Width = 183
21 | Height = 136
22 | Align = alClient
23 | ItemHeight = 13
24 | TabOrder = 0
25 | end
26 | object Panel1: TPanel
27 | Left = 0
28 | Top = 136
29 | Width = 183
30 | Height = 37
31 | Align = alBottom
32 | BevelOuter = bvNone
33 | TabOrder = 1
34 | object okBtn: TButton
35 | Left = 8
36 | Top = 6
37 | Width = 75
38 | Height = 25
39 | Caption = '&OK'
40 | Default = True
41 | ModalResult = 1
42 | TabOrder = 0
43 | end
44 | object cancelBtn: TButton
45 | Left = 96
46 | Top = 6
47 | Width = 75
48 | Height = 25
49 | Caption = '&Cancel'
50 | ModalResult = 2
51 | TabOrder = 1
52 | end
53 | end
54 | end
55 |
--------------------------------------------------------------------------------
/listSelectDlg.pas:
--------------------------------------------------------------------------------
1 | unit listSelectDlg;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls, ExtCtrls, CheckLst, types, utilLib, strutils;
8 |
9 | type
10 | TlistSelectFrm = class(TForm)
11 | listBox: TCheckListBox;
12 | Panel1: TPanel;
13 | okBtn: TButton;
14 | cancelBtn: TButton;
15 | private
16 | { Private declarations }
17 | public
18 | { Public declarations }
19 | end;
20 |
21 | function listSelect(title:string; var options:TstringList):boolean;
22 |
23 | implementation
24 |
25 | {$R *.dfm}
26 |
27 | function listSelect(title:string; var options:TstringList):boolean;
28 | var
29 | dlg: TlistSelectFrm;
30 | i: integer;
31 | begin
32 | result:=FALSE;
33 | dlg:=TlistSelectFrm.Create(NIL);
34 | with dlg do
35 | try
36 | caption:=title;
37 | listBox.items.assign(options);
38 | for i:=0 to options.count-1 do
39 | if options.objects[i] <> NIL then
40 | listbox.Checked[i]:=TRUE;
41 | clientHeight:=clientHeight-listBox.ClientHeight+listBox.ItemHeight*minmax(5,15, listbox.count);
42 | if showModal() = mrCancel then exit;
43 | for i:=0 to listbox.Count-1 do
44 | options.Objects[i]:=if_(listbox.Checked[i], PTR1, NIL);
45 | result:=TRUE;
46 | finally dlg.free end;
47 | end;
48 |
49 | end.
50 |
--------------------------------------------------------------------------------
/longinputDlg.dfm:
--------------------------------------------------------------------------------
1 | object longinputFrm: TlonginputFrm
2 | Left = 191
3 | Top = 187
4 | BorderStyle = bsSizeToolWin
5 | Caption = 'longinputFrm'
6 | ClientHeight = 314
7 | ClientWidth = 465
8 | Color = clBtnFace
9 | Font.Charset = DEFAULT_CHARSET
10 | Font.Color = clWindowText
11 | Font.Height = -11
12 | Font.Name = 'MS Sans Serif'
13 | Font.Style = []
14 | OldCreateOrder = False
15 | Position = poMainFormCenter
16 | PixelsPerInch = 96
17 | TextHeight = 13
18 | object bottomPnl: TPanel
19 | Left = 0
20 | Top = 282
21 | Width = 465
22 | Height = 32
23 | Align = alBottom
24 | BevelOuter = bvNone
25 | TabOrder = 1
26 | OnResize = bottomPnlResize
27 | object okBtn: TButton
28 | Left = 55
29 | Top = 4
30 | Width = 75
31 | Height = 25
32 | Caption = '&OK'
33 | Default = True
34 | ModalResult = 1
35 | TabOrder = 0
36 | end
37 | object cancelBtn: TButton
38 | Left = 135
39 | Top = 4
40 | Width = 75
41 | Height = 25
42 | Caption = '&Cancel'
43 | ModalResult = 2
44 | TabOrder = 1
45 | end
46 | end
47 | object topPnl: TPanel
48 | Left = 0
49 | Top = 0
50 | Width = 465
51 | Height = 41
52 | Align = alTop
53 | BevelOuter = bvNone
54 | TabOrder = 2
55 | object msgLbl: TLabel
56 | Left = 0
57 | Top = 0
58 | Width = 17
59 | Height = 13
60 | Align = alClient
61 | Caption = 'test'
62 | Layout = tlCenter
63 | WordWrap = True
64 | end
65 | end
66 | object inputBox: TMemo
67 | Left = 0
68 | Top = 41
69 | Width = 465
70 | Height = 241
71 | Align = alClient
72 | Lines.Strings = (
73 | 'Memo1')
74 | ScrollBars = ssVertical
75 | TabOrder = 0
76 | OnKeyDown = inputBoxKeyDown
77 | end
78 | end
79 |
--------------------------------------------------------------------------------
/longinputDlg.pas:
--------------------------------------------------------------------------------
1 | unit longinputDlg;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls, ExtCtrls;
8 |
9 | type
10 | TlonginputFrm = class(TForm)
11 | bottomPnl: TPanel;
12 | okBtn: TButton;
13 | cancelBtn: TButton;
14 | topPnl: TPanel;
15 | msgLbl: TLabel;
16 | inputBox: TMemo;
17 | procedure bottomPnlResize(Sender: TObject);
18 | procedure inputBoxKeyDown(Sender: TObject; var Key: Word;
19 | Shift: TShiftState);
20 | private
21 | { Private declarations }
22 | public
23 | { Public declarations }
24 | end;
25 |
26 | implementation
27 |
28 | {$R *.dfm}
29 |
30 | procedure TlonginputFrm.bottomPnlResize(Sender: TObject);
31 | begin
32 | okBtn.left:=(bottomPnl.Width-cancelBtn.BoundsRect.right+okBtn.BoundsRect.left) div 2;
33 | cancelBtn.left:=okBtn.BoundsRect.Right+10;
34 | end;
35 |
36 | procedure TlonginputFrm.inputBoxKeyDown(Sender: TObject; var Key: Word;
37 | Shift: TShiftState);
38 | begin
39 | if shift = [ssCtrl] then
40 | if key = ord('A') then
41 | inputBox.SelectAll();
42 | end;
43 |
44 | end.
45 |
--------------------------------------------------------------------------------
/monoLib.pas:
--------------------------------------------------------------------------------
1 | {
2 | Copyright (C) 2002-2008 Massimo Melina (www.rejetto.com)
3 |
4 | This program is free software; you can redistribute it and/or modify
5 | it under the terms of the GNU General Public License as published by
6 | the Free Software Foundation; either version 2 of the License, or
7 | (at your option) any later version.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 | GNU General Public License for more details.
13 |
14 | You should have received a copy of the GNU General Public License
15 | along with this program; if not, write to the Free Software
16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17 |
18 |
19 | This lib ensures only one instance of the software does run
20 | }
21 | unit monoLib;
22 |
23 | interface
24 |
25 | uses
26 | windows, messages, forms, classes, sysUtils;
27 |
28 | type
29 | Tmono = class
30 | private
31 | msgID: Thandle;
32 | Fmaster: boolean;
33 | Ferror: string;
34 | Fworking: boolean;
35 | function hook(var msg:TMessage):boolean;
36 | public
37 | onSlaveParams: procedure(params:string);
38 | property error:string read Ferror;
39 | property master:boolean read Fmaster;
40 | property working:boolean read Fworking;
41 |
42 | function init(id:string):boolean; // FALSE on error
43 | procedure sendParams();
44 | end;
45 |
46 | var
47 | mono: Tmono;
48 | initialPath: string;
49 |
50 | implementation
51 |
52 | const
53 | //MSG_WHEREAREYOU = 1;
54 | //MSG_HEREIAM = 2;
55 | MSG_PARAMS = 3;
56 |
57 | function atomToStr(atom:Tatom):string;
58 | begin
59 | setlength(result, 5000);
60 | setlength(result, globalGetAtomName(atom, @result[1], length(result)));
61 | end; // atomToStr
62 |
63 | function Tmono.hook(var msg:TMessage):boolean;
64 | begin
65 | result:=master and (msg.msg = msgID) and (msg.wparam = MSG_PARAMS);
66 | if not result or not assigned(onSlaveParams) then exit;
67 | msg.Result:=1;
68 | onSlaveParams(atomToStr(msg.lparam));
69 | GlobalDeleteAtom(msg.LParam);
70 | end; // hook
71 |
72 | function Tmono.init(id:string):boolean;
73 | begin
74 | result:=FALSE;
75 | msgID:=registerWindowMessage(pchar(id));
76 | application.HookMainWindow(hook);
77 | // the mutex is auto-released when the application terminates
78 | if createMutex(nil, True, pchar(id)) = 0 then
79 | begin
80 | setlength(Ferror,1000);
81 | setlength(Ferror, FormatMessage(
82 | FORMAT_MESSAGE_FROM_SYSTEM+FORMAT_MESSAGE_IGNORE_INSERTS, NIL,
83 | GetLastError(), 0, @Ferror[1], length(Ferror), NIL) );
84 | exit;
85 | end;
86 | Fmaster:= GetLastError() <> ERROR_ALREADY_EXISTS;
87 | Fworking:=TRUE;
88 | result:=TRUE;
89 | end; // init
90 |
91 | procedure Tmono.sendParams();
92 | var
93 | s: string;
94 | i: integer;
95 | begin
96 | s:=initialPath+#13+paramStr(0);
97 | for i:=1 to paramCount() do
98 | s:=s+#13+paramStr(i);
99 | // the master will delete the atom
100 | postMessage(HWND_BROADCAST, msgId, MSG_PARAMS, globalAddAtom(pchar(s)));
101 | end; // sendParams
102 |
103 | initialization
104 | initialPath:=getCurrentDir();
105 | mono:=Tmono.create;
106 |
107 | finalization
108 | mono.free;
109 |
110 | end.
111 |
--------------------------------------------------------------------------------
/newuserpassDlg.dfm:
--------------------------------------------------------------------------------
1 | object newuserpassFrm: TnewuserpassFrm
2 | Left = 362
3 | Top = 207
4 | BorderStyle = bsDialog
5 | Caption = 'Insert the requested user/pass'
6 | ClientHeight = 131
7 | ClientWidth = 302
8 | Color = clBtnFace
9 | Font.Charset = DEFAULT_CHARSET
10 | Font.Color = clWindowText
11 | Font.Height = -11
12 | Font.Name = 'MS Sans Serif'
13 | Font.Style = []
14 | OldCreateOrder = False
15 | Position = poMainFormCenter
16 | OnShow = FormShow
17 | PixelsPerInch = 96
18 | TextHeight = 13
19 | object userBox: TLabeledEdit
20 | Left = 104
21 | Top = 16
22 | Width = 121
23 | Height = 21
24 | EditLabel.Width = 48
25 | EditLabel.Height = 13
26 | EditLabel.Caption = 'Username'
27 | LabelPosition = lpLeft
28 | TabOrder = 0
29 | end
30 | object pwdBox: TLabeledEdit
31 | Left = 104
32 | Top = 40
33 | Width = 121
34 | Height = 21
35 | EditLabel.Width = 46
36 | EditLabel.Height = 13
37 | EditLabel.Caption = 'Password'
38 | LabelPosition = lpLeft
39 | PasswordChar = '*'
40 | TabOrder = 1
41 | end
42 | object pwd2Box: TLabeledEdit
43 | Left = 104
44 | Top = 64
45 | Width = 121
46 | Height = 21
47 | EditLabel.Width = 85
48 | EditLabel.Height = 13
49 | EditLabel.Caption = 'Re-type password'
50 | LabelPosition = lpLeft
51 | PasswordChar = '*'
52 | TabOrder = 2
53 | end
54 | object okBtn: TButton
55 | Left = 104
56 | Top = 96
57 | Width = 75
58 | Height = 25
59 | Caption = '&Ok'
60 | Default = True
61 | TabOrder = 3
62 | OnClick = okBtnClick
63 | end
64 | object resetBtn: TButton
65 | Left = 192
66 | Top = 96
67 | Width = 75
68 | Height = 25
69 | Caption = '&Reset'
70 | TabOrder = 4
71 | OnClick = resetBtnClick
72 | end
73 | end
74 |
--------------------------------------------------------------------------------
/newuserpassDlg.pas:
--------------------------------------------------------------------------------
1 | {
2 | Copyright (C) 2002-2012 Massimo Melina (www.rejetto.com)
3 |
4 | This file is part of HFS ~ HTTP File Server.
5 |
6 | HFS is free software; you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation; either version 2 of the License, or
9 | (at your option) any later version.
10 |
11 | HFS is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with HFS; if not, write to the Free Software
18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 | }
20 | unit newuserpassDlg;
21 |
22 | interface
23 |
24 | uses
25 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
26 | Dialogs, StdCtrls, ExtCtrls, utilLib;
27 |
28 | type
29 | TnewuserpassFrm = class(TForm)
30 | userBox: TLabeledEdit;
31 | pwdBox: TLabeledEdit;
32 | pwd2Box: TLabeledEdit;
33 | okBtn: TButton;
34 | resetBtn: TButton;
35 | procedure okBtnClick(Sender: TObject);
36 | procedure resetBtnClick(Sender: TObject);
37 | procedure FormShow(Sender: TObject);
38 | private
39 | { Private declarations }
40 | public
41 | function prompt(var usr,pwd:string):boolean;
42 | end;
43 |
44 | var
45 | newuserpassFrm: TnewuserpassFrm;
46 |
47 | implementation
48 |
49 | {$R *.dfm}
50 |
51 | procedure TnewuserpassFrm.okBtnClick(Sender: TObject);
52 | var
53 | error: string;
54 | begin
55 | userBox.text:=trim(userBox.text);
56 | pwdBox.text:=trim(pwdBox.text);
57 | error:='';
58 | if (userBox.text > '') and not validUsername(userBox.Text)
59 | or (pwdBox.text > '') and not validUsername(pwdBox.text) then
60 | error:='The characters below are not allowed'#13'/\:?*"<>|;&&@'
61 | else if (pwdBox.text > '') and (userBox.text = '') then
62 | error:='User is mandatory'
63 | else if pwdBox.text <> pwd2Box.text then
64 | error:='The two passwords you entered don''t match';
65 |
66 | if error = '' then ModalResult:=mrOk
67 | else msgDlg(error, MB_ICONERROR);
68 | end;
69 |
70 | procedure TnewuserpassFrm.resetBtnClick(Sender: TObject);
71 | begin
72 | userBox.text:='';
73 | pwdBox.text:='';
74 | pwd2Box.text:='';
75 | end;
76 |
77 | procedure TnewuserpassFrm.FormShow(Sender: TObject);
78 | begin userBox.SetFocus() end;
79 |
80 | function TnewuserpassFrm.prompt(var usr,pwd:string):boolean;
81 | begin
82 | userBox.Text:=usr;
83 | pwdBox.text:=pwd;
84 | pwd2Box.text:=pwd;
85 | result:= ShowModal() = mrOk;
86 | usr:=userBox.Text;
87 | pwd:=pwdBox.text;
88 | end;
89 |
90 | end.
91 |
--------------------------------------------------------------------------------
/optionsDlg.dfm:
--------------------------------------------------------------------------------
1 | object optionsFrm: ToptionsFrm
2 | Left = 287
3 | Top = 162
4 | BorderIcons = [biSystemMenu, biMinimize]
5 | Caption = 'Options'
6 | ClientHeight = 449
7 | ClientWidth = 805
8 | Color = clBtnFace
9 | Font.Charset = DEFAULT_CHARSET
10 | Font.Color = clWindowText
11 | Font.Height = -11
12 | Font.Name = 'MS Sans Serif'
13 | Font.Style = []
14 | OldCreateOrder = False
15 | Position = poMainFormCenter
16 | OnActivate = FormActivate
17 | OnCreate = FormCreate
18 | OnResize = FormResize
19 | OnShow = FormShow
20 | PixelsPerInch = 96
21 | TextHeight = 14
22 | object pageCtrl: TPageControl
23 | Left = 0
24 | Top = 0
25 | Width = 805
26 | Height = 414
27 | ActivePage = accountsPage
28 | Align = alClient
29 | Images = mainFrm.images
30 | MultiLine = True
31 | TabOrder = 0
32 | object bansPage: TTabSheet
33 | Caption = 'Bans'
34 | ImageIndex = 25
35 | object Panel1: TPanel
36 | Left = 0
37 | Top = 0
38 | Width = 797
39 | Height = 30
40 | Align = alTop
41 | BevelOuter = bvNone
42 | TabOrder = 0
43 | object addBtn: TButton
44 | Left = 4
45 | Top = 5
46 | Width = 73
47 | Height = 21
48 | Caption = 'Add row'
49 | TabOrder = 0
50 | OnClick = addBtnClick
51 | end
52 | object deleteBtn: TButton
53 | Left = 86
54 | Top = 5
55 | Width = 73
56 | Height = 21
57 | Caption = 'Delete row'
58 | TabOrder = 1
59 | OnClick = deleteBtnClick
60 | end
61 | object sortBanBtn: TButton
62 | Left = 168
63 | Top = 5
64 | Width = 73
65 | Height = 21
66 | Caption = 'Sort'
67 | TabOrder = 2
68 | OnClick = sortBanBtnClick
69 | end
70 | end
71 | object bansBox: TValueListEditor
72 | Left = 0
73 | Top = 30
74 | Width = 797
75 | Height = 329
76 | Align = alClient
77 | KeyOptions = [keyEdit, keyAdd, keyDelete]
78 | Strings.Strings = (
79 | '=')
80 | TabOrder = 1
81 | TitleCaptions.Strings = (
82 | 'IP address mask'
83 | 'Comment')
84 | ColWidths = (
85 | 108
86 | 683)
87 | end
88 | object Panel3: TPanel
89 | Left = 0
90 | Top = 359
91 | Width = 797
92 | Height = 26
93 | Align = alBottom
94 | BevelOuter = bvNone
95 | TabOrder = 2
96 | object noreplybanChk: TCheckBox
97 | Left = 5
98 | Top = 5
99 | Width = 145
100 | Height = 17
101 | Caption = 'Disconnect with no reply'
102 | TabOrder = 0
103 | end
104 | object Button1: TButton
105 | Left = 176
106 | Top = 4
107 | Width = 141
108 | Height = 19
109 | Caption = 'How to invert the logic?'
110 | TabOrder = 1
111 | OnClick = Button1Click
112 | end
113 | end
114 | end
115 | object accountsPage: TTabSheet
116 | Caption = 'Accounts'
117 | ImageIndex = 29
118 | DesignSize = (
119 | 797
120 | 385)
121 | object Label1: TLabel
122 | Left = 9
123 | Top = 16
124 | Width = 57
125 | Height = 14
126 | Caption = 'Account list'
127 | FocusControl = accountsBox
128 | end
129 | object Label7: TLabel
130 | Left = 251
131 | Top = 349
132 | Width = 328
133 | Height = 14
134 | Hint = 'You also need to right click on the folder, then restrict access'
135 | Anchors = [akLeft, akBottom]
136 | Caption =
137 | 'WARNING: creating an account is not enough to protect your file' +
138 | 's...'
139 | ParentShowHint = False
140 | ShowHint = True
141 | WordWrap = True
142 | end
143 | object accountpropGrp: TGroupBox
144 | Left = 163
145 | Top = 26
146 | Width = 619
147 | Height = 317
148 | Anchors = [akLeft, akTop, akRight, akBottom]
149 | Caption = 'Account properties'
150 | TabOrder = 7
151 | DesignSize = (
152 | 619
153 | 317)
154 | object Label3: TLabel
155 | Left = 11
156 | Top = 173
157 | Width = 312
158 | Height = 28
159 | Caption = 'Here you can see protected resources this user can access...'
160 | FocusControl = accountAccessBox
161 | WordWrap = True
162 | end
163 | object Label8: TLabel
164 | Left = 345
165 | Top = 20
166 | Width = 28
167 | Height = 14
168 | Caption = 'Notes'
169 | FocusControl = notesBox
170 | WordWrap = True
171 | end
172 | object accountenabledChk: TCheckBox
173 | Left = 11
174 | Top = 20
175 | Width = 97
176 | Height = 17
177 | Caption = '&Enabled'
178 | TabOrder = 0
179 | OnClick = accountenabledChkClick
180 | end
181 | object accountAccessBox: TTreeView
182 | Left = 11
183 | Top = 192
184 | Width = 302
185 | Height = 116
186 | Anchors = [akLeft, akTop, akBottom]
187 | Images = mainFrm.images
188 | Indent = 19
189 | ParentShowHint = False
190 | ReadOnly = True
191 | ShowHint = False
192 | ShowRoot = False
193 | TabOrder = 7
194 | OnContextPopup = accountAccessBoxContextPopup
195 | OnDblClick = accountAccessBoxDblClick
196 | end
197 | object ignoreLimitsChk: TCheckBox
198 | Left = 226
199 | Top = 20
200 | Width = 97
201 | Height = 17
202 | Caption = '&Ignore limits'
203 | TabOrder = 2
204 | end
205 | object pwdBox: TLabeledEdit
206 | Left = 11
207 | Top = 63
208 | Width = 198
209 | Height = 22
210 | EditLabel.Width = 50
211 | EditLabel.Height = 14
212 | EditLabel.Caption = '&Password'
213 | ParentShowHint = False
214 | PasswordChar = '*'
215 | ShowHint = True
216 | TabOrder = 3
217 | OnChange = pwdBoxChange
218 | OnMouseEnter = pwdBoxMouseEnter
219 | end
220 | object redirBox: TLabeledEdit
221 | Left = 11
222 | Top = 106
223 | Width = 198
224 | Height = 22
225 | EditLabel.Width = 105
226 | EditLabel.Height = 14
227 | EditLabel.Caption = 'After login, redirect to'
228 | TabOrder = 4
229 | OnChange = redirBoxChange
230 | end
231 | object accountLinkBox: TLabeledEdit
232 | Left = 11
233 | Top = 146
234 | Width = 198
235 | Height = 22
236 | EditLabel.Width = 51
237 | EditLabel.Height = 14
238 | EditLabel.Caption = 'Member of'
239 | TabOrder = 5
240 | OnExit = accountLinkBoxExit
241 | end
242 | object groupChk: TCheckBox
243 | Left = 114
244 | Top = 20
245 | Width = 97
246 | Height = 17
247 | Caption = '&Group'
248 | TabOrder = 1
249 | OnClick = groupChkClick
250 | end
251 | object groupsBtn: TButton
252 | Left = 215
253 | Top = 146
254 | Width = 90
255 | Height = 21
256 | Caption = 'Choose...'
257 | TabOrder = 6
258 | OnClick = groupsBtnClick
259 | end
260 | object notesBox: TMemo
261 | Left = 345
262 | Top = 39
263 | Width = 271
264 | Height = 269
265 | Anchors = [akLeft, akTop, akRight, akBottom]
266 | ParentShowHint = False
267 | ScrollBars = ssVertical
268 | ShowHint = False
269 | TabOrder = 8
270 | end
271 | object notesWrapChk: TCheckBox
272 | Left = 502
273 | Top = 21
274 | Width = 91
275 | Height = 17
276 | Anchors = [akTop, akRight]
277 | Caption = 'Wrap'
278 | Checked = True
279 | State = cbChecked
280 | TabOrder = 9
281 | OnClick = notesWrapChkClick
282 | end
283 | end
284 | object deleteaccountBtn: TButton
285 | Left = 3
286 | Top = 351
287 | Width = 45
288 | Height = 17
289 | Anchors = [akLeft, akBottom]
290 | Caption = 'de&lete'
291 | Enabled = False
292 | Font.Charset = ANSI_CHARSET
293 | Font.Color = clWindowText
294 | Font.Height = -11
295 | Font.Name = 'Tahoma'
296 | Font.Style = []
297 | ParentFont = False
298 | TabOrder = 2
299 | OnClick = deleteaccountBtnClick
300 | end
301 | object renaccountBtn: TButton
302 | Left = 53
303 | Top = 328
304 | Width = 49
305 | Height = 17
306 | Anchors = [akLeft, akBottom]
307 | Caption = '&rename'
308 | Enabled = False
309 | Font.Charset = ANSI_CHARSET
310 | Font.Color = clWindowText
311 | Font.Height = -11
312 | Font.Name = 'Tahoma'
313 | Font.Style = []
314 | ParentFont = False
315 | TabOrder = 3
316 | OnClick = renaccountBtnClick
317 | end
318 | object addaccountBtn: TButton
319 | Left = 3
320 | Top = 328
321 | Width = 45
322 | Height = 17
323 | Anchors = [akLeft, akBottom]
324 | Caption = 'ad&d'
325 | Font.Charset = ANSI_CHARSET
326 | Font.Color = clWindowText
327 | Font.Height = -11
328 | Font.Name = 'Tahoma'
329 | Font.Style = []
330 | ParentFont = False
331 | TabOrder = 1
332 | OnClick = addaccountBtnClick
333 | end
334 | object upBtn: TButton
335 | Left = 107
336 | Top = 328
337 | Width = 45
338 | Height = 17
339 | Anchors = [akLeft, akBottom]
340 | Caption = '&up'
341 | Font.Charset = ANSI_CHARSET
342 | Font.Color = clWindowText
343 | Font.Height = -11
344 | Font.Name = 'Tahoma'
345 | Font.Style = []
346 | ParentFont = False
347 | TabOrder = 5
348 | OnClick = upBtnClick
349 | OnMouseUp = upBtnMouseUp
350 | end
351 | object downBtn: TButton
352 | Left = 107
353 | Top = 351
354 | Width = 45
355 | Height = 17
356 | Anchors = [akLeft, akBottom]
357 | Caption = 'do&wn'
358 | Font.Charset = ANSI_CHARSET
359 | Font.Color = clWindowText
360 | Font.Height = -11
361 | Font.Name = 'Tahoma'
362 | Font.Style = []
363 | ParentFont = False
364 | TabOrder = 6
365 | OnClick = upBtnClick
366 | OnMouseUp = upBtnMouseUp
367 | end
368 | object sortBtn: TButton
369 | Left = 53
370 | Top = 351
371 | Width = 49
372 | Height = 17
373 | Anchors = [akLeft, akBottom]
374 | Caption = 'sort'
375 | Font.Charset = ANSI_CHARSET
376 | Font.Color = clWindowText
377 | Font.Height = -11
378 | Font.Name = 'Tahoma'
379 | Font.Style = []
380 | ParentFont = False
381 | TabOrder = 4
382 | OnClick = sortBtnClick
383 | OnMouseUp = upBtnMouseUp
384 | end
385 | object accountsBox: TListView
386 | Left = 3
387 | Top = 35
388 | Width = 149
389 | Height = 287
390 | Anchors = [akLeft, akTop, akBottom]
391 | Columns = <>
392 | DragMode = dmAutomatic
393 | HideSelection = False
394 | OwnerData = True
395 | RowSelect = True
396 | ParentShowHint = False
397 | ShowHint = False
398 | SmallImages = mainFrm.images
399 | TabOrder = 0
400 | ViewStyle = vsList
401 | OnChange = accountsBoxChange
402 | OnClick = accountsBoxClick
403 | OnData = accountsBoxData
404 | OnDblClick = accountsBoxDblClick
405 | OnEdited = accountsBoxEdited
406 | OnEditing = accountsBoxEditing
407 | OnDragDrop = accountsBoxDragDrop
408 | OnDragOver = accountsBoxDragOver
409 | OnKeyDown = accountsBoxKeyDown
410 | OnKeyPress = accountsBoxKeyPress
411 | end
412 | end
413 | object mimePage: TTabSheet
414 | Caption = 'MIME types'
415 | ImageIndex = 7
416 | object mimeBox: TValueListEditor
417 | Left = 0
418 | Top = 30
419 | Width = 797
420 | Height = 355
421 | Align = alClient
422 | KeyOptions = [keyEdit, keyAdd, keyDelete]
423 | Strings.Strings = (
424 | '=')
425 | TabOrder = 0
426 | TitleCaptions.Strings = (
427 | 'File Mask'
428 | 'MIME Description')
429 | ColWidths = (
430 | 108
431 | 683)
432 | end
433 | object Panel5: TPanel
434 | Left = 0
435 | Top = 0
436 | Width = 797
437 | Height = 30
438 | Align = alTop
439 | BevelOuter = bvNone
440 | TabOrder = 1
441 | object addMimeBtn: TButton
442 | Left = 4
443 | Top = 5
444 | Width = 73
445 | Height = 21
446 | Caption = 'Add row'
447 | TabOrder = 0
448 | OnClick = addMimeBtnClick
449 | end
450 | object deleteMimeBtn: TButton
451 | Left = 86
452 | Top = 5
453 | Width = 73
454 | Height = 21
455 | Caption = 'Delete row'
456 | TabOrder = 1
457 | OnClick = deleteMimeBtnClick
458 | end
459 | object inBrowserIfMIMEchk: TCheckBox
460 | Left = 184
461 | Top = 7
462 | Width = 305
463 | Height = 17
464 | Caption = 'Open directly in browser when MIME type is defined'
465 | TabOrder = 2
466 | end
467 | end
468 | end
469 | object trayPage: TTabSheet
470 | Caption = 'Tray Message'
471 | ImageIndex = 10
472 | object Label2: TLabel
473 | Left = 8
474 | Top = 16
475 | Width = 292
476 | Height = 168
477 | Caption =
478 | 'You can customize the message in the tray icon tip. '#13#10'The messag' +
479 | 'e length is determined by your Windows version'#13#10'(in XP the limit' +
480 | ' is 127 characters including spaces).'#13#10'Available symbols:'#13#10#13#10' %' +
481 | 'uptime% - server uptime'#13#10' %url% - server main URL'#13#10' %ip% - IP ' +
482 | 'address set as default'#13#10' %port% - Port on which the server is l' +
483 | 'istening'#13#10' %hits% - number of requests made to the server'#13#10' %d' +
484 | 'ownloads% - number of files downloaded'#13#10' %version% - HFS versio' +
485 | 'n'
486 | end
487 | object Label10: TLabel
488 | Left = 291
489 | Top = 170
490 | Width = 40
491 | Height = 14
492 | Caption = 'Preview'
493 | end
494 | object traymsgBox: TMemo
495 | Left = 16
496 | Top = 192
497 | Width = 233
498 | Height = 121
499 | Lines.Strings = (
500 | 'traymsgBox')
501 | TabOrder = 0
502 | OnChange = traymsgBoxChange
503 | end
504 | object traypreviewBox: TMemo
505 | Left = 291
506 | Top = 192
507 | Width = 233
508 | Height = 121
509 | Color = clInfoBk
510 | ReadOnly = True
511 | TabOrder = 1
512 | end
513 | end
514 | object a2nPage: TTabSheet
515 | Caption = 'Address2name'
516 | ImageIndex = -1
517 | object Panel4: TPanel
518 | Left = 0
519 | Top = 0
520 | Width = 797
521 | Height = 67
522 | Align = alTop
523 | Alignment = taLeftJustify
524 | BevelOuter = bvNone
525 | TabOrder = 0
526 | object Label4: TLabel
527 | Left = 8
528 | Top = 8
529 | Width = 243
530 | Height = 28
531 | Caption =
532 | 'You can associate a label to an address (or many addresses). It ' +
533 | 'will be used in the log.'
534 | WordWrap = True
535 | end
536 | object deleteA2Nbtn: TButton
537 | Left = 83
538 | Top = 40
539 | Width = 73
540 | Height = 21
541 | Caption = '&Delete row'
542 | TabOrder = 0
543 | OnClick = deleteA2NbtnClick
544 | end
545 | object addA2Nbtn: TButton
546 | Left = 4
547 | Top = 41
548 | Width = 73
549 | Height = 21
550 | Caption = 'Add &row'
551 | TabOrder = 1
552 | OnClick = addA2NbtnClick
553 | end
554 | end
555 | object a2nBox: TValueListEditor
556 | Left = 0
557 | Top = 67
558 | Width = 797
559 | Height = 318
560 | Align = alClient
561 | KeyOptions = [keyEdit, keyAdd, keyDelete]
562 | Strings.Strings = (
563 | '=')
564 | TabOrder = 1
565 | TitleCaptions.Strings = (
566 | 'Name'
567 | 'IP Mask')
568 | ColWidths = (
569 | 108
570 | 683)
571 | end
572 | end
573 | object iconsPage: TTabSheet
574 | Caption = 'Icon masks'
575 | ImageIndex = -1
576 | DesignSize = (
577 | 797
578 | 385)
579 | object Label5: TLabel
580 | Left = 8
581 | Top = 32
582 | Width = 227
583 | Height = 14
584 | Caption = 'Each line is a file-mask associated with an icon'
585 | WordWrap = True
586 | end
587 | object Label6: TLabel
588 | Left = 272
589 | Top = 128
590 | Width = 76
591 | Height = 14
592 | Caption = 'Icon associated'
593 | end
594 | object iconMasksBox: TMemo
595 | Left = 8
596 | Top = 49
597 | Width = 225
598 | Height = 245
599 | Anchors = [akLeft, akTop, akBottom]
600 | TabOrder = 0
601 | OnChange = iconMasksBoxChange
602 | end
603 | object iconsBox: TComboBox
604 | Left = 272
605 | Top = 144
606 | Width = 76
607 | Height = 22
608 | Style = csOwnerDrawFixed
609 | TabOrder = 1
610 | OnChange = iconsBoxChange
611 | OnDrawItem = iconsBoxDrawItem
612 | OnDropDown = iconsBoxDropDown
613 | end
614 | end
615 | end
616 | object Panel2: TPanel
617 | Left = 0
618 | Top = 414
619 | Width = 805
620 | Height = 35
621 | Align = alBottom
622 | BevelOuter = bvNone
623 | TabOrder = 1
624 | DesignSize = (
625 | 805
626 | 35)
627 | object okBtn: TButton
628 | Left = 561
629 | Top = 6
630 | Width = 75
631 | Height = 25
632 | Anchors = [akRight, akBottom]
633 | Caption = '&OK'
634 | TabOrder = 0
635 | OnClick = okBtnClick
636 | end
637 | object applyBtn: TButton
638 | Left = 724
639 | Top = 6
640 | Width = 75
641 | Height = 25
642 | Anchors = [akRight, akBottom]
643 | Caption = '&Apply'
644 | TabOrder = 1
645 | OnClick = applyBtnClick
646 | end
647 | object cancelBtn: TButton
648 | Left = 643
649 | Top = 6
650 | Width = 75
651 | Height = 25
652 | Anchors = [akRight, akBottom]
653 | Caption = '&Cancel'
654 | TabOrder = 2
655 | OnClick = cancelBtnClick
656 | end
657 | end
658 | end
659 |
--------------------------------------------------------------------------------
/optionsDlg.pas:
--------------------------------------------------------------------------------
1 | {
2 | Copyright (C) 2002-2012 Massimo Melina (www.rejetto.com)
3 |
4 | This file is part of HFS ~ HTTP File Server.
5 |
6 | HFS is free software; you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation; either version 2 of the License, or
9 | (at your option) any later version.
10 |
11 | HFS is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with HFS; if not, write to the Free Software
18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 | }
20 | unit optionsDlg;
21 |
22 | interface
23 |
24 | uses
25 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Math,
26 | Dialogs, ExtCtrls, StdCtrls, Grids, ComCtrls, ValEdit, types, main, CheckLst;
27 |
28 | type
29 | ToptionsFrm = class(TForm)
30 | pageCtrl: TPageControl;
31 | bansPage: TTabSheet;
32 | accountsPage: TTabSheet;
33 | accountpropGrp: TGroupBox;
34 | accountenabledChk: TCheckBox;
35 | pwdBox: TLabeledEdit;
36 | Label1: TLabel;
37 | deleteaccountBtn: TButton;
38 | renaccountBtn: TButton;
39 | mimePage: TTabSheet;
40 | mimeBox: TValueListEditor;
41 | trayPage: TTabSheet;
42 | Label2: TLabel;
43 | traymsgBox: TMemo;
44 | Panel1: TPanel;
45 | Label3: TLabel;
46 | accountAccessBox: TTreeView;
47 | Panel2: TPanel;
48 | okBtn: TButton;
49 | applyBtn: TButton;
50 | cancelBtn: TButton;
51 | bansBox: TValueListEditor;
52 | addBtn: TButton;
53 | deleteBtn: TButton;
54 | Panel3: TPanel;
55 | noreplybanChk: TCheckBox;
56 | Button1: TButton;
57 | a2nPage: TTabSheet;
58 | Panel4: TPanel;
59 | Label4: TLabel;
60 | a2nBox: TValueListEditor;
61 | ignoreLimitsChk: TCheckBox;
62 | Panel5: TPanel;
63 | addMimeBtn: TButton;
64 | deleteMimeBtn: TButton;
65 | deleteA2Nbtn: TButton;
66 | addA2Nbtn: TButton;
67 | iconsPage: TTabSheet;
68 | iconMasksBox: TMemo;
69 | iconsBox: TComboBox;
70 | Label5: TLabel;
71 | Label6: TLabel;
72 | Label7: TLabel;
73 | redirBox: TLabeledEdit;
74 | inBrowserIfMIMEchk: TCheckBox;
75 | traypreviewBox: TMemo;
76 | Label10: TLabel;
77 | accountLinkBox: TLabeledEdit;
78 | groupChk: TCheckBox;
79 | groupsBtn: TButton;
80 | addaccountBtn: TButton;
81 | upBtn: TButton;
82 | downBtn: TButton;
83 | sortBtn: TButton;
84 | notesBox: TMemo;
85 | Label8: TLabel;
86 | sortBanBtn: TButton;
87 | notesWrapChk: TCheckBox;
88 | accountsBox: TListView;
89 | procedure FormShow(Sender: TObject);
90 | procedure FormResize(Sender: TObject);
91 | procedure addaccountBtnClick(Sender: TObject);
92 | procedure deleteaccountBtnClick(Sender: TObject);
93 | procedure accountsBoxEdited(Sender: TObject; Item: TListItem; var S: String);
94 | procedure renaccountBtnClick(Sender: TObject);
95 | procedure accountAccessBoxDblClick(Sender: TObject);
96 | procedure accountAccessBoxContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
97 | procedure cancelBtnClick(Sender: TObject);
98 | procedure okBtnClick(Sender: TObject);
99 | procedure applyBtnClick(Sender: TObject);
100 | procedure addBtnClick(Sender: TObject);
101 | procedure Button1Click(Sender: TObject);
102 | procedure deleteBtnClick(Sender: TObject);
103 | procedure addMimeBtnClick(Sender: TObject);
104 | procedure deleteMimeBtnClick(Sender: TObject);
105 | procedure addA2NbtnClick(Sender: TObject);
106 | procedure deleteA2NbtnClick(Sender: TObject);
107 | procedure iconsBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
108 | procedure iconsBoxDropDown(Sender: TObject);
109 | procedure iconsBoxChange(Sender: TObject);
110 | procedure iconMasksBoxChange(Sender: TObject);
111 | procedure traymsgBoxChange(Sender: TObject);
112 | procedure FormActivate(Sender: TObject);
113 | procedure accountLinkBoxExit(Sender: TObject);
114 | procedure groupChkClick(Sender: TObject);
115 | procedure groupsBtnClick(Sender: TObject);
116 | procedure accountenabledChkClick(Sender: TObject);
117 | procedure upBtnClick(Sender: TObject);
118 | procedure sortBtnClick(Sender: TObject);
119 | procedure ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
120 | State: TDragState; var Accept: Boolean);
121 | procedure upBtnMouseUp(Sender: TObject; Button: TMouseButton;
122 | Shift: TShiftState; X, Y: Integer);
123 | procedure sortBanBtnClick(Sender: TObject);
124 | procedure notesWrapChkClick(Sender: TObject);
125 | procedure FormCreate(Sender: TObject);
126 | procedure accountsBoxData(Sender: TObject; Item: TListItem);
127 | procedure accountsBoxKeyDown(Sender: TObject; var Key: Word;
128 | Shift: TShiftState);
129 | procedure accountsBoxClick(Sender: TObject);
130 | procedure accountsBoxDragOver(Sender, Source: TObject; X, Y: Integer;
131 | State: TDragState; var Accept: Boolean);
132 | procedure accountsBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
133 | procedure accountsBoxChange(Sender: TObject; Item: TListItem;
134 | Change: TItemChange);
135 | procedure updateAccessBox();
136 | procedure accountsBoxDblClick(Sender: TObject);
137 | procedure redirBoxChange(Sender: TObject);
138 | procedure accountsBoxKeyPress(Sender: TObject; var Key: Char);
139 | procedure accountsBoxEditing(Sender: TObject; Item: TListItem;
140 | var AllowEdit: Boolean);
141 | procedure pwdBoxMouseEnter(Sender: TObject);
142 | procedure pwdBoxChange(Sender: TObject);
143 | public
144 | procedure checkRedir();
145 | procedure loadAccountProperties();
146 | function saveAccountProperties():boolean;
147 | procedure deleteAccount(idx:integer=-1);
148 | procedure loadValues();
149 | function saveValues():boolean; // it may fail on incorrect input
150 | function checkValues():string; // returns an error message
151 | procedure updateIconMap();
152 | procedure updateIconsBox();
153 | procedure selectAccount(i:integer; saveBefore:boolean=TRUE);
154 | end;
155 |
156 | var
157 | optionsFrm: ToptionsFrm;
158 |
159 | implementation
160 |
161 | {$R *.dfm}
162 |
163 | uses
164 | utilLib, HSlib, strUtils, classesLib, listSelectDlg;
165 |
166 | var
167 | lastAccountSelected: integer = -1; // stores the previous selection index
168 | tempAccounts: Taccounts; // the GUI part can't store the temp data
169 | tempIcons: array of integer;
170 | renamingAccount: boolean;
171 |
172 | procedure ToptionsFrm.selectAccount(i:integer; saveBefore:boolean=TRUE);
173 | begin
174 | if saveBefore then saveAccountProperties();
175 | accountsBox.itemIndex:=i;
176 | accountsBox.ItemFocused:=accountsBox.Selected;
177 | loadAccountProperties();
178 | end; // selectAccount
179 |
180 | procedure ToptionsFrm.loadValues();
181 | var
182 | i:integer;
183 | begin
184 | // bans
185 | noreplybanChk.checked:=noReplyBan;
186 | bansBox.Strings.Clear();
187 | for i:=0 to length(banList)-1 do
188 | bansBox.strings.Add(banList[i].ip+'='+banlist[i].comment);
189 | // mime types
190 | inBrowserIfMIMEchk.Checked:=inBrowserIfMIME;
191 | mimeBox.Strings.Clear();
192 | for i:=0 to length(mimeTypes) div 2-1 do
193 | mimeBox.strings.add(mimeTypes[i*2]+'='+mimeTypes[i*2+1]);
194 | for i:=0 to length(DEFAULT_MIME_TYPES) div 2-1 do
195 | if not stringExists(DEFAULT_MIME_TYPES[i*2], mimeTypes) then
196 | mimeBox.strings.add(DEFAULT_MIME_TYPES[i*2]+'='+DEFAULT_MIME_TYPES[i*2+1]);
197 | // address2name
198 | a2nBox.Strings.clear();
199 | for i:=0 to length(address2name) div 2-1 do
200 | a2nBox.strings.Add(address2name[i*2]+'='+address2name[i*2+1]);
201 | // tray message
202 | traymsgBox.Text:=replaceStr(trayMsg,#13,CRLF);
203 | // accounts
204 | tempAccounts:=accounts;
205 | setLength(tempAccounts, length(tempAccounts)); // unlink from the source
206 | accountsBox.items.count:=length(accounts);
207 | lastAccountSelected:=-1;
208 | loadAccountProperties();
209 | // remember original name for tracking possible later renaming
210 | for i:=0 to length(accounts)-1 do
211 | with accounts[i] do
212 | wasUser:=user;
213 | // icons
214 | updateIconsBox();
215 | i:=length(iconMasks);
216 | setLength(tempIcons, i+1);
217 | iconMasksBox.Text:='';
218 | for i:=0 to i-1 do
219 | begin
220 | iconMasksBox.lines.Add(iconMasks[i].str);
221 | tempIcons[i]:=iconMasks[i].int;
222 | end;
223 | iconMasksBox.SelStart:=0;
224 | end; // loadValues
225 |
226 | procedure ToptionsFrm.notesWrapChkClick(Sender: TObject);
227 | begin
228 | notesBox.WordWrap:=notesWrapChk.checked;
229 | if notesBox.WordWrap then
230 | notesBox.ScrollBars:=ssVertical
231 | else
232 | notesBox.ScrollBars:=ssBoth
233 | end;
234 |
235 | function ToptionsFrm.checkValues():string;
236 | var
237 | i: integer;
238 | s: string;
239 | begin
240 | for i:=bansBox.Strings.count downto 1 do
241 | begin
242 | bansbox.cells[0,i]:=trim(bansbox.cells[0,i]);
243 | s:=bansbox.cells[0,i];
244 | if s = '' then continue;
245 | if bansBox.strings.indexOfName(s)+1 < i then
246 | begin
247 | result:=format('Bans: "%s" is duplicated', [s]);
248 | exit;
249 | end;
250 | if not checkAddressSyntax(s) then
251 | begin
252 | result:=format('Bans: syntax error for "%s"', [s]);
253 | exit;
254 | end;
255 | end;
256 | for i:=a2nBox.Strings.count downto 1 do
257 | begin
258 | s:=trim(a2nBox.cells[1,i]);
259 | if trim(s+a2nBox.cells[0,i]) = '' then
260 | a2nBox.DeleteRow(i)
261 | else
262 | if (s>'') and not checkAddressSyntax(s) then
263 | begin
264 | result:=format('Address2name: syntax error for "%s"', [s]);
265 | exit;
266 | end;
267 | end;
268 | result:='';
269 | end; // checkValues
270 |
271 | function ToptionsFrm.saveValues():boolean;
272 | var
273 | i, n: integer;
274 | s: string;
275 | begin
276 | result:=FALSE;
277 | s:=checkValues();
278 | if s > '' then
279 | begin
280 | msgDlg(s, MB_ICONERROR);
281 | exit;
282 | end;
283 | if not saveAccountProperties() then exit;
284 | // bans
285 | noReplyBan:=noreplybanChk.checked;
286 | i:=bansbox.Strings.Count;
287 | if bansbox.Cells[0,i] = '' then dec(i);
288 | setlength(banlist, i);
289 | n:=0;
290 | for i:=0 to length(banlist)-1 do
291 | begin
292 | banlist[n].ip:=trim(bansBox.Cells[0,i+1]); // mod by mars
293 | if banlist[n].ip = '' then continue;
294 | banlist[n].comment:=bansBox.Cells[1,i+1];
295 | inc(n);
296 | end;
297 | setlength(banlist, n);
298 | kickBannedOnes();
299 | // mime types
300 | inBrowserIfMIME:=inBrowserIfMIMEchk.checked;
301 | mimeTypes:=NIL;
302 | for i:=1 to mimebox.rowCount-1 do
303 | addArray(mimeTypes, [mimeBox.cells[0,i], mimeBox.cells[1,i]]);
304 |
305 | // address2name
306 | address2name:=NIL;
307 | for i:=1 to a2nBox.RowCount-1 do
308 | begin
309 | s:=trim(a2nBox.Cells[1,i]);
310 | if s > '' then addArray(address2name, [a2nBox.Cells[0,i], s]);
311 | end;
312 | // tray message
313 | trayMsg:=replaceStr(traymsgBox.Text, #10,'');
314 | // accounts
315 | accounts:=tempAccounts;
316 | purgeVFSaccounts();
317 | mainfrm.filesBox.repaint();
318 | // icons
319 | setlength(iconMasks, 0); // mod by mars
320 | n:=0;
321 | for i:=0 to iconMasksBox.Lines.Count-1 do
322 | begin
323 | s:=iconMasksBox.Lines[i];
324 | if trim(s) = '' then continue;
325 | inc(n);
326 | setlength(iconMasks, n);
327 | iconMasks[n-1].str:=s;
328 | iconMasks[n-1].int:=tempIcons[i];
329 | end;
330 | result:=TRUE;
331 | end; // saveValues
332 |
333 | function ipListComp(list: TStringList; index1, index2: integer):integer;
334 |
335 | function extract(s:string; var o:integer):string;
336 | var
337 | i: integer;
338 | begin
339 | i:=posEx('.',s,o);
340 | if i = 0 then i:=length(s)+1;
341 | result:=substr(s,o,i-1);
342 | o:=i+1;
343 | end; // extract
344 |
345 | function compare(a,b:string):integer;
346 | begin
347 | try result:=compare_(strToInt(a), strToInt(b));
348 | except
349 | result:=compare_(length(a), length(b));
350 | if result = 0 then
351 | result:=ansiCompareStr(a,b);
352 | end;
353 | end; // compare
354 |
355 | var
356 | o1, o2: integer;
357 | s1, s2: string;
358 | begin
359 | s1:=getTill('=', list[index1]);
360 | s2:=getTill('=', list[index2]);
361 | o1:=1;
362 | o2:=1;
363 | repeat
364 | result:=compare(extract(s1,o1), extract(s2,o2));
365 | until (result <> 0) or (o1 > length(s1)) and (o2 > length(s2));
366 | end; // ipListComp
367 |
368 | procedure ToptionsFrm.sortBanBtnClick(Sender: TObject);
369 | begin
370 | (bansbox.strings as TstringList).customSort(ipListComp);
371 | end;
372 |
373 | procedure ToptionsFrm.sortBtnClick(Sender: TObject);
374 |
375 | function sortIt(reverse:boolean=FALSE):boolean;
376 | var
377 | s, i, j, l: integer;
378 | begin
379 | result:=FALSE;
380 | s:=accountsBox.ItemIndex;
381 | l:=length(tempAccounts);
382 | for i:=0 to l-2 do
383 | for j:=i+1 to l-1 do
384 | if reverse XOR (compareText(tempAccounts[i].user, tempAccounts[j].user) > 0) then
385 | begin
386 | swapMem(tempAccounts[i], tempAccounts[j], sizeof(tempAccounts[0]));
387 | if i = s then
388 | s:=j
389 | else if j = s then
390 | s:=i;
391 | result:=TRUE;
392 | end;
393 | accountsBox.ItemIndex:=s;
394 | end; // sortIt
395 |
396 | begin
397 | lastAccountSelected:=-1;
398 | if not sortIt(FALSE) then sortIt(TRUE);
399 | accountsBox.invalidate();
400 | end;
401 |
402 | procedure ToptionsFrm.traymsgBoxChange(Sender: TObject);
403 | begin traypreviewBox.text:=mainfrm.getTrayTipMsg(traymsgBox.text) end;
404 |
405 | procedure ToptionsFrm.FormShow(Sender: TObject);
406 | var
407 | i: integer;
408 | s: string;
409 | begin
410 | // if we do this, any hint window will bring focus to the main form
411 | //setwindowlong(handle, GWL_HWNDPARENT, 0); // get a taskbar button
412 | loadValues();
413 | if pageCtrl.activePage <> a2nPage then exit;
414 | s:=mainfrm.ipPointedInLog();
415 | if s = '' then exit;
416 | // select row or insert new one
417 | i:=length(address2name)-1;
418 | while (i > 0) and not addressmatch(address2name[i], s) do
419 | dec(i, 2);
420 | if i <= 0 then a2nBox.row:=a2nBox.insertRow('',s,TRUE)
421 | else
422 | try a2nBox.Row:=i
423 | except end; // this should not happen, but in case (it was reported once) just skip selecting
424 |
425 | a2nBox.SetFocus();
426 | a2nBox.EditorMode:=TRUE;
427 | end;
428 |
429 | procedure ToptionsFrm.groupChkClick(Sender: TObject);
430 | begin
431 | pwdBox.visible:=not groupChk.checked;
432 | accountsBox.invalidate();
433 | end;
434 |
435 | procedure ToptionsFrm.FormActivate(Sender: TObject);
436 | begin traymsgBoxChange(NIL) end;
437 |
438 | procedure ToptionsFrm.FormCreate(Sender: TObject);
439 | begin
440 | notesWrapChk.Checked:=TRUE;
441 | end;
442 |
443 | procedure ToptionsFrm.FormResize(Sender: TObject);
444 | begin bansBox.ColWidths[1]:=bansBox.ClientWidth-bansBox.colWidths[0]-2 end;
445 |
446 | procedure setEnabledRecur(c:Tcontrol; v:boolean);
447 | var
448 | i: integer;
449 | begin
450 | c.enabled:=v;
451 | if c is TTreeView then
452 | (c as TTreeView).items.clear();
453 | if c is TLabeledEdit then
454 | (c as TLabeledEdit).text:='';
455 | if c is Tmemo then
456 | (c as Tmemo).text:='';
457 | if c is Tcheckbox then
458 | (c as Tcheckbox).checked:=FALSE;
459 |
460 | if c is Twincontrol then
461 | with c as Twincontrol do
462 | for i:=0 to controlCount-1 do
463 | setEnabledRecur(controls[i], v);
464 | end; // setEnabledRecur
465 |
466 | procedure ToptionsFrm.updateAccessBox();
467 | var
468 | n: Ttreenode;
469 | f: Tfile;
470 | props: TstringDynArray;
471 | act: TfileAction;
472 | s: string;
473 | a, other: Paccount;
474 | begin
475 | accountAccessBox.items.clear();
476 | if lastAccountSelected < 0 then exit;
477 | a:=@tempAccounts[lastAccountSelected];
478 | n:=rootNode;
479 | while n <> NIL do
480 | begin
481 | f:=Tfile(n.data);
482 | n:=n.getNext();
483 | if f = NIL then continue;
484 |
485 | props:=NIL;
486 | for act:=low(TfileAction) to high(TfileAction) do
487 | begin
488 | s:=FILEACTION2STR[act];
489 | // any_account will suffice, otherwise our username (or a linked one) must be there explicitly, otherwise the resource is not protected or we have no access and thus must not be listed
490 | if not stringExists(USER_ANY_ACCOUNT, f.accounts[act]) then
491 | begin
492 | other:=findEnabledLinkedAccount(a, f.accounts[act]);
493 | if other = NIL then continue;
494 | if other <> a then
495 | s:=s+' via '+other.user;
496 | end;
497 | addString(s, props);
498 | end;
499 | if props = NIL then continue;
500 |
501 | with accountAccessBox.items.addObject(NIL, f.name+' ['+join(', ',props)+']', f.node) do
502 | begin
503 | imageIndex:=f.node.imageIndex;
504 | selectedIndex:=imageIndex;
505 | end;
506 | end;
507 | end; // updateAccessBox
508 |
509 | procedure ToptionsFrm.checkRedir();
510 | begin // mod by mars
511 | redirBox.color:=blend(clWindow, clRed,
512 | ifThen((redirBox.text >'') and not fileExistsByURL(redirBox.text), 0.5, 0) );
513 | end; // checkRedir
514 |
515 | procedure ToptionsFrm.loadAccountProperties();
516 | var
517 | a: Paccount;
518 | b, bakWrap: boolean;
519 | i: integer;
520 | begin
521 | lastAccountSelected:=accountsBox.ItemIndex;
522 | b:=lastAccountSelected >= 0;
523 | bakWrap:=notesWrapChk.checked;
524 | setEnabledRecur(accountpropGrp, b);
525 | notesWrapChk.checked:=bakWrap;
526 | renAccountBtn.enabled:=b;
527 | deleteAccountBtn.enabled:=b;
528 | upBtn.Enabled:=b;
529 | downBtn.enabled:=b;
530 |
531 | if not accountpropGrp.Enabled then exit;
532 | a:=@tempAccounts[lastAccountSelected];
533 | accountEnabledChk.checked:=a.enabled;
534 | pwdBox.Text:=a.pwd;
535 | groupChk.Checked:=a.group;
536 | accountLinkBox.text:=join(';',a.link);
537 | ignoreLimitsChk.Checked:=a.noLimits;
538 | redirBox.Text:=a.redir;
539 | notesBox.text:=a.notes;
540 |
541 | groupsBtn.enabled:=FALSE;;
542 | for i:=0 to length(tempAccounts)-1 do
543 | if tempAccounts[i].group and (i <> accountsBox.itemIndex) then
544 | groupsBtn.enabled:=TRUE;
545 |
546 | updateAccessBox();
547 | accountsBox.invalidate();
548 | end; // loadAccountProperties
549 |
550 | function ToptionsFrm.saveAccountProperties():boolean;
551 | const
552 | MSG_CHARS = 'The characters below are not allowed'
553 | +#13'/\:?*"<>|;&&@';
554 | MSG_PWD = 'Invalid password.'#13+MSG_CHARS;
555 | var
556 | a: Paccount;
557 | begin
558 | result:=TRUE;
559 | if lastAccountSelected < 0 then exit;
560 | result:=FALSE;
561 | if not validUsername(pwdbox.Text, TRUE) then
562 | begin
563 | msgDlg(MSG_PWD, MB_ICONERROR);
564 | exit;
565 | end;
566 |
567 | a:=@tempAccounts[lastAccountSelected];
568 | a.enabled:=accountEnabledChk.checked;
569 | a.pwd:=pwdBox.Text;
570 | a.noLimits:=ignoreLimitsChk.checked;
571 | a.redir:=redirBox.Text;
572 | a.notes:=notesBox.text;
573 | a.link:=split(';', trim(accountLinkBox.text));
574 | a.group:=groupChk.Checked;
575 | uniqueStrings(a.link);
576 | result:=TRUE;
577 | accountsBox.invalidate();
578 | end; // saveAccountProperties
579 |
580 | function findUser(user:string):integer;
581 | begin
582 | result:=length(tempAccounts)-1;
583 | while (result >= 0) and not sameText(tempAccounts[result].user, user) do
584 | dec(result);
585 | end; // findUser
586 |
587 | function userExists(user:string):boolean; overload;
588 | begin result:=findUser(user) >= 0 end;
589 |
590 | function userExists(user:string; excpt:integer):boolean; overload;
591 | var
592 | i: integer;
593 | begin
594 | i:=findUser(user);
595 | result:=(i >= 0) and (i <> excpt);
596 | end;
597 |
598 | procedure ToptionsFrm.addaccountBtnClick(Sender: TObject);
599 | var
600 | i: integer;
601 | a: Taccount;
602 | begin
603 | a.user:=getUniqueName('new user', userExists);
604 | a.pwd:='';
605 | a.group:=FALSE;
606 | a.enabled:=TRUE;
607 | a.noLimits:=FALSE;
608 | a.redir:='';
609 |
610 | i:=length(tempAccounts);
611 | setLength(tempAccounts, i+1);
612 | tempAccounts[i]:=a;
613 | accountsBox.items.add();
614 | selectAccount(i);
615 |
616 | renaccountBtnClick(sender);
617 | end;
618 |
619 | procedure ToptionsFrm.deleteAccount(idx:integer=-1);
620 | var
621 | i: integer;
622 | begin
623 | if idx < 0 then
624 | begin
625 | idx:=accountsBox.itemIndex;
626 | if idx < 0 then exit;
627 | if msgDlg('Delete?', MB_ICONQUESTION+MB_YESNO) = IDNO then
628 | exit;
629 | end;
630 | // shift
631 | for i:=idx+1 to length(tempAccounts)-1 do
632 | tempAccounts[i-1]:=tempAccounts[i];
633 | // shorten
634 | with accountsBox.items do count:=count-1; // dunno why, but invoking delete* methods doesn't work
635 | setlength(tempAccounts, length(tempAccounts)-1);
636 | selectAccount(min(idx, length(tempAccounts)-1), FALSE);
637 | end; // deleteAccount
638 |
639 | procedure ToptionsFrm.deleteaccountBtnClick(Sender: TObject);
640 | begin deleteAccount() end;
641 |
642 | procedure swapItems(i, j:integer);
643 | var
644 | s: integer;
645 | begin
646 | s:=length(tempAccounts)-1;
647 | if not inRange(i, 0,s) or not inRange(j, 0,s) then exit;
648 | s:=optionsFrm.accountsBox.itemIndex;
649 | lastAccountSelected:=-1; // avoid data saving from fields while moving
650 | swapMem(tempAccounts[i], tempAccounts[j], sizeof(tempAccounts[i]));
651 | if i = s then
652 | s:=j
653 | else if j = s then
654 | s:=i;
655 | with optionsFrm.accountsBox do
656 | begin
657 | itemIndex:=s;
658 | selected.focused:=TRUE;
659 | invalidate();
660 | end;
661 | end; // swapItems
662 |
663 | procedure ToptionsFrm.accountsBoxChange(Sender: TObject; Item: TListItem; Change: TItemChange);
664 | begin
665 | if (change = ctState) and assigned(item) and item.selected then
666 | selectAccount(item.index);
667 | end;
668 |
669 | procedure ToptionsFrm.accountsBoxClick(Sender: TObject);
670 | begin
671 | selectAccount(accountsBox.itemIndex);
672 | end;
673 |
674 | procedure ToptionsFrm.accountsBoxData(Sender: TObject; Item: TListItem);
675 | var
676 | a: Paccount;
677 | begin
678 | if (item = NIL) or not inRange(item.index, 0,length(tempAccounts)-1) then
679 | exit;
680 | a:=@tempAccounts[item.index];
681 | item.caption:=a.user;
682 | item.imageIndex:=if_(item.index = lastAccountSelected,
683 | accountIcon(accountenabledChk.checked, groupChk.checked),
684 | accountIcon(a)
685 | );
686 | end;
687 |
688 | procedure ToptionsFrm.accountsBoxDblClick(Sender: TObject);
689 | begin renaccountBtnClick(renaccountBtn) end;
690 |
691 | procedure ToptionsFrm.accountsBoxDragDrop(Sender, Source: TObject; X,
692 | Y: Integer);
693 | begin
694 | swapItems(accountsBox.getItemAt(x,y).index, accountsBox.itemIndex);
695 | end;
696 |
697 | procedure ToptionsFrm.accountsBoxDragOver(Sender, Source: TObject; X,
698 | Y: Integer; State: TDragState; var Accept: Boolean);
699 | begin
700 | accept:=(sender = source) and assigned(accountsBox.getItemAt(x,y));
701 | end;
702 |
703 | procedure ToptionsFrm.accountsBoxEdited(Sender: TObject; Item: TListItem; var S: String);
704 | var
705 | old, err: string;
706 | i, idx: integer;
707 | begin
708 | renamingAccount:=FALSE;
709 | try idx:=item.index // workaround to wine's bug http://www.rejetto.com/forum/index.php/topic,9563.msg1053890.html#msg1053890
710 | except idx:=lastAccountSelected end;
711 | old:=tempAccounts[idx].user;
712 | if not validUsername(s) then
713 | err:='Invalid username'
714 | else if userExists(s, accountsBox.itemIndex) then
715 | err:='Username already used'
716 | else
717 | err:='';
718 |
719 | if err > '' then
720 | begin
721 | msgDlg(err, MB_ICONERROR);
722 | s:=old;
723 | exit;
724 | end;
725 | // update linkings
726 | for i:=0 to length(tempAccounts)-1 do
727 | replaceString(tempAccounts[i].link, old, s);
728 | tempAccounts[idx].user:=s;
729 | end;
730 |
731 | procedure ToptionsFrm.accountsBoxEditing(Sender: TObject; Item: TListItem;
732 | var AllowEdit: Boolean);
733 | begin
734 | renamingAccount:=TRUE;
735 | end;
736 |
737 | procedure ToptionsFrm.accountsBoxKeyDown(Sender: TObject; var Key: Word;
738 | Shift: TShiftState);
739 | begin
740 | if shift = [] then
741 | case key of
742 | VK_F2: renaccountBtn.click();
743 | VK_INSERT: addaccountBtn.click(); // mod by mars
744 | VK_DELETE: deleteAccount();
745 | end;
746 | {mod by mars}
747 | if shift = [ssAlt] then
748 | case key of
749 | VK_UP: upBtn.click();
750 | VK_DOWN: downBtn.click();
751 | end;
752 | {/mod}
753 | end;
754 |
755 | procedure ToptionsFrm.accountsBoxKeyPress(Sender: TObject; var Key: Char);
756 | var
757 | s, i, ir, n: integer;
758 | begin
759 | if renamingAccount then
760 | exit;
761 | key:=upcase(key);
762 | if charInSet(key, ['0'..'9','A'..'Z']) then
763 | begin
764 | s:=accountsBox.ItemIndex;
765 | n:=length(tempAccounts);
766 | for i:=1 to n-1 do
767 | begin
768 | ir:=(s+i) mod n;
769 | if key = upcase(tempAccounts[ir].user[1]) then
770 | begin
771 | selectAccount(ir);
772 | exit;
773 | end;
774 | end;
775 | end;
776 | end;
777 |
778 | procedure ToptionsFrm.redirBoxChange(Sender: TObject);
779 | begin checkRedir() end;
780 |
781 | procedure ToptionsFrm.renaccountBtnClick(Sender: TObject);
782 | begin
783 | if accountsBox.selected = NIL then exit;
784 | accountsBox.Selected.editCaption();
785 | end;
786 |
787 | procedure ToptionsFrm.accountLinkBoxExit(Sender: TObject);
788 | const
789 | MSG_MISSING_USERS = 'Cannot find these linked usernames: %s'
790 | +#13'This is abnormal, but you may add them later.';
791 | var
792 | users, missing: TStringDynArray;
793 | i: integer;
794 | begin
795 | users:=split(';', trim(accountLinkBox.text));
796 | // check for non-existent linked account
797 | missing:=NIL;
798 | for i:=0 to length(users)-1 do
799 | if not userExists(users[i]) then
800 | addString(users[i], missing);
801 | if assigned(missing) then
802 | msgDlg(format(MSG_MISSING_USERS, [join(', ', missing)]), MB_ICONWARNING);
803 | // permissions may have been changed
804 | updateAccessBox();
805 | end;
806 |
807 | procedure ToptionsFrm.accountAccessBoxDblClick(Sender: TObject);
808 | begin
809 | with sender as Ttreeview do
810 | begin
811 | if selected = NIL then exit;
812 | mainfrm.filesBox.selected:=selected.Data;
813 | mainfrm.setFocus();
814 | end;
815 | end;
816 |
817 | procedure ToptionsFrm.accountenabledChkClick(Sender: TObject);
818 | begin accountsBox.invalidate() end;
819 |
820 | procedure ToptionsFrm.accountAccessBoxContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
821 | begin
822 | with sender as Ttreeview do
823 | if selected = NIL then handled:=TRUE
824 | else mainfrm.filesBox.selected:=selected.data;
825 | end;
826 |
827 | procedure ToptionsFrm.cancelBtnClick(Sender: TObject);
828 | begin close() end;
829 |
830 | procedure ToptionsFrm.applyBtnClick(Sender: TObject);
831 | begin saveValues() end;
832 |
833 | procedure ToptionsFrm.okBtnClick(Sender: TObject);
834 | begin if saveValues() then close() end;
835 |
836 | procedure ToptionsFrm.Button1Click(Sender: TObject);
837 | resourcestring MSG_INVERT_BAN =
838 | 'Normal behavior of the Ban is to prevent access to the addresses you specify (also called black-list).'
839 | +#13'If you want the opposite, to allow the addresses that you specify (white-list), enter all addresses in a single row preceded by a \ character.'
840 | +#13
841 | +#13'Let say you want to allow all your 192.168 local network plus your office at 1.1.1.1.'
842 | +#13'Just put this IP address mask: \192.168.*;1.1.1.1'
843 | +#13'The opening \ character inverts the logic, so everything else is banned.'
844 | +#13
845 | +#13'If you want to know more about address masks, check the guide.';
846 | begin msgDlg(MSG_INVERT_BAN) end;
847 |
848 | procedure ToptionsFrm.groupsBtnClick(Sender: TObject);
849 | var
850 | i: integer;
851 | there: TStringDynArray;
852 | groups: TstringList;
853 | s: string;
854 | begin
855 | there:=split(';', accountLinkBox.Text);
856 | groups:=TstringList.create;
857 | try
858 | for i:=0 to length(tempAccounts)-1 do
859 | if tempAccounts[i].group and (i <> accountsBox.itemIndex) then
860 | begin
861 | s:=tempAccounts[i].user;
862 | groups.AddObject(s, if_(stringExists(s, there), PTR1, NIL));
863 | end;
864 | if not listSelect('Select groups', groups) then exit;
865 | s:='';
866 | for i:=0 to groups.Count-1 do
867 | if groups.Objects[i] <> NIL then
868 | s:=s+groups[i]+';';
869 | accountLinkBox.Text:=getTill(-1, s);
870 | finally groups.free end;
871 | end;
872 |
873 | procedure ToptionsFrm.pwdBoxChange(Sender: TObject);
874 | begin pwdBox.hint:=pwdBox.text end;
875 |
876 | procedure ToptionsFrm.pwdBoxMouseEnter(Sender: TObject);
877 | begin pwdBox.hint:=pwdBox.text end;
878 |
879 | procedure ToptionsFrm.addBtnClick(Sender: TObject);
880 | begin bansBox.InsertRow('','',TRUE) end;
881 |
882 | procedure ToptionsFrm.deleteBtnClick(Sender: TObject);
883 | begin
884 | if bansbox.strings.count > 0 then
885 | bansBox.Strings.Delete(bansBox.Row-1)
886 | end;
887 |
888 | procedure ToptionsFrm.addMimeBtnClick(Sender: TObject);
889 | begin mimeBox.InsertRow('','',TRUE) end;
890 |
891 | procedure ToptionsFrm.deleteMimeBtnClick(Sender: TObject);
892 | begin
893 | if mimeBox.strings.count > 0 then
894 | mimeBox.Strings.Delete(mimeBox.Row-1)
895 | end;
896 |
897 | procedure ToptionsFrm.addA2NbtnClick(Sender: TObject);
898 | begin
899 | a2nBox.insertRow('','',TRUE);
900 | a2nBox.setFocus();
901 | end;
902 |
903 | procedure ToptionsFrm.deleteA2NbtnClick(Sender: TObject);
904 | begin
905 | if a2nBox.strings.count > 0 then
906 | a2nBox.Strings.Delete(a2nBox.Row-1)
907 | end;
908 |
909 | procedure ToptionsFrm.iconsBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
910 | var
911 | cnv: TCanvas;
912 | bmp: Tbitmap;
913 | begin
914 | cnv:=iconsBox.Canvas;
915 | bmp:=Tbitmap.create;
916 | try
917 | mainfrm.images.GetBitmap(index, bmp);
918 | cnv.FillRect(rect);
919 | cnv.Draw(rect.Left, rect.Top, bmp);
920 | cnv.TextOut(rect.Left+mainfrm.images.Width+2, rect.Top, idx_label(index));
921 | finally bmp.free end;
922 | end;
923 |
924 | procedure ToptionsFrm.updateIconsBox();
925 | // alloc enough slots. the text is not used, labels are built by the paint event
926 | begin iconsBox.Items.Text:=dupeString(CRLF, mainfrm.images.count) end;
927 |
928 | procedure ToptionsFrm.iconsBoxDropDown(Sender: TObject);
929 | begin updateIconsBox() end;
930 |
931 | procedure ToptionsFrm.ListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
932 | begin
933 | accept:=source = sender;
934 | end;
935 |
936 | procedure ToptionsFrm.upBtnClick(Sender: TObject);
937 | var
938 | i, dir: integer;
939 | begin
940 | dir:=if_(sender = upBtn, -1, +1);
941 | i:=accountsBox.itemIndex;
942 | if not inRange(i+dir, 0,length(tempAccounts)-1) then exit;
943 | swapItems(i, i+dir);
944 | end;
945 |
946 | procedure ToptionsFrm.upBtnMouseUp(Sender: TObject; Button: TMouseButton;
947 | Shift: TShiftState; X, Y: Integer);
948 | begin
949 | accountsBox.setFocus()
950 | end;
951 |
952 | procedure ToptionsFrm.updateIconMap();
953 | begin
954 | if not iconsBox.DroppedDown then
955 | iconsBox.ItemIndex:=tempIcons[iconMasksBox.CaretPos.Y];
956 | end;
957 |
958 | procedure ToptionsFrm.iconsBoxChange(Sender: TObject);
959 | begin tempIcons[iconMasksBox.CaretPos.Y]:=iconsBox.ItemIndex end;
960 |
961 | procedure ToptionsFrm.iconMasksBoxChange(Sender: TObject);
962 | begin setLength(tempIcons, iconMasksBox.Lines.count+1) end;
963 |
964 | end.
965 |
--------------------------------------------------------------------------------
/parserLib.pas:
--------------------------------------------------------------------------------
1 | unit parserLib;
2 |
3 | interface
4 |
5 | uses
6 | strutils, sysutils, classes, types, utilLib, windows;
7 |
8 | type
9 | TmacroCB = function(fullMacro:string; pars:Tstrings; cbData:pointer):string;
10 | EtplError = class(Exception)
11 | pos, row, col: integer;
12 | code: string;
13 | constructor Create(const msg, code:string; row,col:integer);
14 | end;
15 | const
16 | MARKER_OPEN = '{.';
17 | MARKER_CLOSE = '.}';
18 | MARKER_SEP = '|';
19 | MARKER_QUOTE = '{:';
20 | MARKER_UNQUOTE = ':}';
21 | MARKERS: array [0..4] of string = ( MARKER_OPEN, MARKER_CLOSE, MARKER_SEP, MARKER_QUOTE, MARKER_UNQUOTE );
22 |
23 | function anyMacroMarkerIn(s:string):boolean;
24 | function findMacroMarker(s:string; ofs:integer=1):integer;
25 | procedure applyMacrosAndSymbols(var txt:string; cb:TmacroCB; cbData:pointer; removeQuotings:boolean=TRUE);
26 |
27 | implementation
28 |
29 | const
30 | MAX_RECUR_LEVEL = 50;
31 | type
32 | TparserIdsStack = array [1..MAX_RECUR_LEVEL] of string;
33 |
34 | constructor EtplError.create(const msg, code:string; row, col:integer);
35 | begin
36 | inherited create(msg);
37 | self.row:=row;
38 | self.col:=col;
39 | self.code:=code;
40 | end;
41 |
42 | procedure applyMacrosAndSymbols2(var txt:string; cb:TmacroCB; cbData:pointer; var idsStack:TparserIdsStack; recurLevel:integer=0);
43 | const
44 | // we don't track SEPs, they are handled just before the callback
45 | QUOTE_ID = 0; // QUOTE must come before OPEN because it is a substring
46 | UNQUOTE_ID = 1;
47 | OPEN_ID = 2;
48 | CLOSE_ID = 3;
49 | MAX_MARKER_ID = 3;
50 |
51 | function alreadyRecurredOn(s:string):boolean;
52 | var
53 | i: integer;
54 | begin
55 | result:=TRUE;
56 | for i:=recurLevel downto 1 do
57 | if sameText(s, idsStack[i]) then exit;
58 | result:=FALSE;
59 | end; // alreadyRecurredOn
60 |
61 | procedure handleSymbols();
62 | var
63 | b, e, l : integer;
64 | s, newS: string;
65 | begin
66 | e:=0;
67 | l:=length(txt);
68 | while e < l do
69 | begin
70 | // search for next symbol
71 | b:=posEx('%',txt,e+1);
72 | if b = 0 then break;
73 | e:=b+1;
74 | if txt[e] = '%' then
75 | begin // we don't accept %% as a symbol. so, restart parsing from the second %
76 | e:=b;
77 | continue;
78 | end;
79 | if not charInSet(txt[e], ['_','a'..'z','A'..'Z']) then continue; // first valid character
80 | while (e < l) and charInSet(txt[e], ['0'..'9','a'..'z','A'..'Z','-','_']) do
81 | inc(e);
82 | if txt[e] <> '%' then continue;
83 | // found!
84 | s:=substr(txt,b,e);
85 | if alreadyRecurredOn(s) then continue; // the user probably didn't meant to create an infinite loop
86 |
87 | newS:=cb(s, NIL, cbData);
88 | if s = newS then continue;
89 |
90 | idsStack[recurLevel]:=s; // keep track of what we recur on
91 | // apply translation, and eventually recur
92 | try applyMacrosAndSymbols2(newS, cb, cbData, idsStack, recurLevel);
93 | except end;
94 | idsStack[recurLevel]:='';
95 | inc(e, replace(txt, newS, b, e));
96 | l:=length(txt);
97 | end;
98 | end; // handleSymbols
99 |
100 | procedure handleMacros();
101 | var
102 | pars: Tstrings;
103 |
104 | function expand(from,to_:integer):integer;
105 | var
106 | s, fullMacro: string;
107 | i, o, q, u: integer;
108 | begin
109 | result:=0;
110 | fullMacro:=substr(txt, from+length(MARKER_OPEN), to_-length(MARKER_CLOSE));
111 | if alreadyRecurredOn(fullMacro) then exit; // the user probably didn't meant to create an infinite loop
112 |
113 | // let's find the SEPs to build 'pars'
114 | pars.clear();
115 | i:=1; // char pointer from where we shall copy the macro parameter
116 | o:=0;
117 | q:=posEx(MARKER_QUOTE, fullMacro); // q points to _QUOTE
118 | repeat
119 | o:=posEx(MARKER_SEP, fullmacro, o+1);
120 | if o = 0 then break;
121 | if (q > 0) and (q < o) then // this SEP is possibly quoted
122 | begin
123 | // update 'q' and 'u'
124 | repeat
125 | u:=posEx(MARKER_UNQUOTE, fullMacro, q);
126 | if u = 0 then exit; // macro quoting not properly closed
127 | q:=posEx(MARKER_QUOTE, fullMacro, q+1); // update q for next cycle
128 | // if we find other _QUOTEs before _UNQUOTE, then they are stacked, and we must go through the same number of both markers
129 | while (q > 0) and (q < u) do
130 | begin
131 | u:=posEx(MARKER_UNQUOTE, fullMacro, u+1);
132 | if u = 0 then exit; // macro quoting not properly closed
133 | q:=posEx(MARKER_QUOTE, fullMacro, q+1);
134 | end;
135 | until (q = 0) or (o < q);
136 | // eventually skip this chunk of string
137 | if o < u then
138 | begin // yes, this SEP is quoted
139 | o:=u;
140 | continue;
141 | end;
142 | end;
143 | // ok, that's a valid SEP, so we collect this as a parameter
144 | pars.add(substr(fullMacro, i, o-1));
145 | i:=o+length(MARKER_SEP);
146 | until false;
147 | pars.add(substr(fullMacro, i, length(fullMacro))); // last piece
148 | // ok, 'pars' has now been built
149 |
150 | // do the call, recur, and replace with the result
151 | s:=cb(fullMacro, pars, cbData);
152 | idsStack[recurLevel]:=fullmacro; // keep track of what we recur on
153 | try
154 | try applyMacrosAndSymbols2(s, cb, cbData, idsStack, recurLevel) except end;
155 | finally idsStack[recurLevel]:='' end;
156 | result:=replace(txt, s, from, to_);
157 | end; // expand
158 |
159 | const
160 | ID2TAG: array [0..MAX_MARKER_ID] of string = (MARKER_QUOTE, MARKER_UNQUOTE, MARKER_OPEN, MARKER_CLOSE);
161 | type
162 | TstackItem = record
163 | pos: integer;
164 | row, col: word;
165 | quote: boolean;
166 | end;
167 | var
168 | i, lastNL, row, m, t: integer;
169 | stack: array of TstackItem;
170 | Nstack: integer;
171 | begin
172 | setLength(stack, length(txt) div length(MARKER_OPEN)); // it will never need more than this
173 | Nstack:=0;
174 | pars:=TstringList.create;
175 | try
176 | i:=1;
177 | row:=1;
178 | lastNL:=0;
179 | while i <= length(txt) do
180 | begin
181 | if txt[i] = #10 then
182 | begin
183 | inc(row);
184 | lastNL:=i;
185 | end;
186 | for m:=0 to MAX_MARKER_ID do
187 | begin
188 | if not strAt(txt, ID2TAG[m], i) then continue;
189 | case m of
190 | QUOTE_ID,
191 | OPEN_ID:
192 | begin
193 | if (m = OPEN_ID) and (Nstack > 0) and stack[Nstack-1].quote then continue; // don't consider quoted OPEN markers
194 | stack[Nstack].pos:=i;
195 | stack[Nstack].quote:= m=QUOTE_ID;
196 | stack[Nstack].row:=row;
197 | stack[Nstack].col:=i-lastNL;
198 | inc(Nstack);
199 | end;
200 | CLOSE_ID:
201 | begin
202 | if Nstack = 0 then
203 | raise EtplError.create('unmatched marker', copy(txt,i,30), row, i-lastNL);
204 | if (Nstack > 0) and stack[Nstack-1].quote then continue; // don't consider quoted CLOSE markers
205 | t:=length(MARKER_CLOSE);
206 | inc(i, t-1+expand(stack[Nstack-1].pos, i+t-1));
207 | dec(Nstack);
208 | end;
209 | UNQUOTE_ID:
210 | begin
211 | if (Nstack = 0) or not stack[Nstack-1].quote then continue;
212 | dec(Nstack);
213 | end;
214 | end;
215 | end;//for
216 | inc(i);
217 | end;
218 | finally pars.free end;
219 | if Nstack > 0 then
220 | with stack[Nstack-1] do
221 | raise EtplError.create('unmatched marker', copy(txt,pos,30), row, col)
222 | end; // handleMacros
223 |
224 | begin
225 | if recurLevel > MAX_RECUR_LEVEL then exit;
226 | inc(recurLevel);
227 | handleSymbols();
228 | handleMacros();
229 | end; //applyMacrosAndSymbols2
230 |
231 | procedure applyMacrosAndSymbols(var txt:string; cb:TmacroCB; cbData:pointer; removeQuotings:boolean=TRUE);
232 | var
233 | idsStack: TparserIdsStack;
234 | begin
235 | enforceNUL(txt);
236 | applyMacrosAndSymbols2(txt,cb,cbData,idsStack);
237 | if removeQuotings then
238 | txt:=xtpl(txt, [MARKER_QUOTE, '', MARKER_UNQUOTE, ''])
239 | end;
240 |
241 | function findMacroMarker(s:string; ofs:integer=1):integer;
242 | begin result:=reMatch(s, '\{[.:]|[.:]\}|\|', 'm!', ofs) end;
243 |
244 | function anyMacroMarkerIn(s:string):boolean;
245 | begin result:=findMacroMarker(s) > 0 end;
246 |
247 | end.
248 |
--------------------------------------------------------------------------------
/progFrmLib.pas:
--------------------------------------------------------------------------------
1 | {
2 | Copyright (C) 2002-2008 Massimo Melina (www.rejetto.com)
3 |
4 | This program is free software; you can redistribute it and/or modify
5 | it under the terms of the GNU General Public License as published by
6 | the Free Software Foundation; either version 2 of the License, or
7 | (at your option) any later version.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 | GNU General Public License for more details.
13 |
14 | You should have received a copy of the GNU General Public License
15 | along with this program; if not, write to the Free Software
16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17 |
18 |
19 | }
20 | unit progFrmLib;
21 |
22 | interface
23 |
24 | uses
25 | ComCtrls, Forms, controls, ExtCtrls, buttons, graphics;
26 |
27 | type
28 | TprogressForm = class
29 | private
30 | prog: TProgressBar;
31 | frm: Tform;
32 | msgPnl: Tpanel;
33 | cancelBtn: TbitBtn;
34 | btnPnl: Tpanel;
35 | stack: array of record ofs,length:real end;
36 | partialLength: real;
37 | canceled: boolean;
38 | function getPos():real;
39 | procedure setPos(x:real);
40 | function getGlobalPos():real;
41 | procedure setGlobalPos(x:real);
42 | function getCaption():string;
43 | procedure setCaption(x:string);
44 | function getVisible():boolean;
45 | procedure onCancel(Sender: TObject);
46 | procedure onResize(Sender: TObject);
47 | public
48 | preventBackward: boolean;
49 | constructor create;
50 | procedure show(caption_:string=''; cancel:boolean=FALSE);
51 | procedure hide();
52 | property progress:real read getPos write setPos;
53 | property globalPosition:real read getGlobalPos write setGlobalPos;
54 | property caption:string read getCaption write setCaption;
55 | property visible:boolean read getVisible;
56 | property cancelRequested:boolean read canceled;
57 | procedure push(sublength:real);
58 | procedure pop();
59 | procedure showCancel();
60 | procedure hideCancel();
61 | procedure reset();
62 | end;
63 |
64 | implementation
65 |
66 | function max(a,b:integer):integer;
67 | begin if a > b then result:=a else result:=b end;
68 |
69 | constructor TprogressForm.create;
70 | begin
71 | frm:=Tform.create(NIL);
72 | frm.Position:=poScreenCenter;
73 | frm.Width:=200;
74 | frm.BorderStyle:=bsNone;
75 | frm.BorderWidth:=15;
76 | frm.Height:=25+frm.BorderWidth*2;
77 | frm.OnResize:=onResize;
78 | //frm.FormStyle:=fsStayOnTop;
79 |
80 | msgPnl:=Tpanel.create(frm);
81 | msgPnl.Parent:=frm;
82 | msgPnl.align:=alTop;
83 | msgPnl.height:=20;
84 | msgPnl.BevelOuter:=bvLowered;
85 |
86 | prog:=TProgressBar.Create(frm);
87 | prog.Parent:=frm;
88 | prog.BorderWidth:=3;
89 | prog.Min:=0;
90 | prog.max:=100; // resolution
91 | prog.Align:=alClient;
92 | prog.smooth:=TRUE;
93 |
94 | btnPnl:=Tpanel.create(frm);
95 | btnPnl.parent:=frm;
96 | btnPnl.Align:=alBottom;
97 | btnPnl.BevelOuter:=bvLowered;
98 |
99 | cancelBtn:=TbitBtn.create(frm);
100 | cancelBtn.parent:=btnPnl;
101 | cancelBtn.Kind:=bkCancel;
102 | cancelBtn.top:=10;
103 | cancelBtn.OnClick:=onCancel;
104 |
105 | btnPnl.Height:=cancelBtn.Height+cancelBtn.top*2;
106 | btnPnl.Hide();
107 |
108 | partialLength:=1;
109 | push(1); // init stack
110 | frm.Height:=frm.Height+msgPnl.Height;
111 | end; // constructor
112 |
113 | function TprogressForm.getVisible():boolean;
114 | begin result:=frm.Visible end;
115 |
116 | procedure TprogressForm.showCancel();
117 | begin
118 | if btnPnl.visible then exit;
119 | frm.Height:=frm.Height+btnPnl.Height;
120 | btnPnl.show();
121 | end; // showCancel
122 |
123 | procedure TprogressForm.hideCancel();
124 | begin
125 | if not btnPnl.visible then exit;
126 | frm.Height:=frm.Height-btnPnl.Height;
127 | btnPnl.hide();
128 | end; // hideCancel
129 |
130 | procedure TprogressForm.show(caption_: string; cancel:boolean);
131 | begin
132 | canceled:=FALSE;
133 | if not frm.visible then reset();
134 | if caption_ > '' then caption:=caption_;
135 | if cancel then showCancel();
136 | frm.Show();
137 | end; // show
138 |
139 | procedure TprogressForm.hide();
140 | begin
141 | frm.hide();
142 | hideCancel();
143 | end;
144 |
145 | function TprogressForm.getCaption():string;
146 | begin result:=msgPnl.caption end;
147 |
148 | procedure TprogressForm.setCaption(x:string);
149 | begin
150 | msgPnl.caption:=x;
151 | frm.Width:=max(200,
152 | frm.Canvas.TextWidth(x)+(msgPnl.BorderWidth+frm.BorderWidth)*2+20 );
153 | end;
154 |
155 | procedure TprogressForm.setGlobalPos(x:real);
156 | begin
157 | x:=x*prog.max;
158 | if preventBackward and (prog.position > x) then x:=prog.position;
159 | prog.position:=round(x);
160 | end; // setGlobalPos
161 |
162 | function TprogressForm.getGlobalPos():real;
163 | begin result:=prog.position/prog.max end;
164 |
165 | procedure TprogressForm.setPos(x:real);
166 | begin setGlobalPos(stack[length(stack)-1].ofs + x*partialLength ) end;
167 |
168 | function TprogressForm.getPos():real;
169 | begin result:=getGlobalPos()/partialLength + stack[length(stack)-1].ofs end;
170 |
171 | procedure TprogressForm.push(sublength:real);
172 | var
173 | i: integer;
174 | begin
175 | assert(sublength <= 1,'TprogressForm.push(X): X>1');
176 | i:=length(stack);
177 | setLength(stack, i+1);
178 | stack[i].ofs:=globalPosition;
179 | stack[i].length:=partialLength;
180 | partialLength:=partialLength*sublength;
181 | end; // push
182 |
183 | procedure TprogressForm.pop();
184 | var
185 | i: integer;
186 | begin
187 | assert(length(stack) > 1, 'TprogressForm.pop(): empty stack');
188 | progress:=1;
189 | i:=length(stack)-1;
190 | partialLength:=stack[i].length;
191 | setlength(stack, i);
192 | end; // pop
193 |
194 | procedure TprogressForm.onCancel(Sender: TObject);
195 | begin canceled:=TRUE end;
196 |
197 | procedure TprogressForm.onResize(Sender: TObject);
198 | begin cancelBtn.left:=(frm.width-cancelBtn.width) div 2-frm.borderWidth end;
199 |
200 | procedure TprogressForm.reset();
201 | begin prog.position:=0 end;
202 |
203 | end.
204 |
--------------------------------------------------------------------------------
/purgeDlg.dfm:
--------------------------------------------------------------------------------
1 | object purgeFrm: TpurgeFrm
2 | Left = 0
3 | Top = 0
4 | Caption = 'Purge options'
5 | ClientHeight = 152
6 | ClientWidth = 186
7 | Color = clBtnFace
8 | Font.Charset = DEFAULT_CHARSET
9 | Font.Color = clWindowText
10 | Font.Height = -11
11 | Font.Name = 'Tahoma'
12 | Font.Style = []
13 | OldCreateOrder = False
14 | Position = poMainFormCenter
15 | PixelsPerInch = 96
16 | TextHeight = 13
17 | object Label1: TLabel
18 | Left = 8
19 | Top = 8
20 | Width = 127
21 | Height = 13
22 | Caption = 'Choose what to remove...'
23 | end
24 | object rmFilesChk: TCheckBox
25 | Left = 8
26 | Top = 35
27 | Width = 177
28 | Height = 17
29 | Caption = 'Non-existent files'
30 | Checked = True
31 | State = cbChecked
32 | TabOrder = 0
33 | end
34 | object rmRealFoldersChk: TCheckBox
35 | Left = 8
36 | Top = 58
37 | Width = 171
38 | Height = 17
39 | Caption = 'Non-existent real folders'
40 | Checked = True
41 | State = cbChecked
42 | TabOrder = 1
43 | end
44 | object rmEmptyFoldersChk: TCheckBox
45 | Left = 8
46 | Top = 81
47 | Width = 177
48 | Height = 17
49 | Caption = 'Empty folders'
50 | Checked = True
51 | State = cbChecked
52 | TabOrder = 2
53 | end
54 | object Button1: TButton
55 | Left = 8
56 | Top = 118
57 | Width = 75
58 | Height = 25
59 | Caption = '&Ok'
60 | Default = True
61 | ModalResult = 1
62 | TabOrder = 3
63 | end
64 | object Button2: TButton
65 | Left = 103
66 | Top = 118
67 | Width = 75
68 | Height = 25
69 | Caption = '&Cancel'
70 | ModalResult = 2
71 | TabOrder = 4
72 | end
73 | end
74 |
--------------------------------------------------------------------------------
/purgeDlg.pas:
--------------------------------------------------------------------------------
1 | unit purgeDlg;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls;
8 |
9 | type
10 | TpurgeFrm = class(TForm)
11 | rmFilesChk: TCheckBox;
12 | Label1: TLabel;
13 | rmRealFoldersChk: TCheckBox;
14 | rmEmptyFoldersChk: TCheckBox;
15 | Button1: TButton;
16 | Button2: TButton;
17 | private
18 | { Private declarations }
19 | public
20 | { Public declarations }
21 | end;
22 |
23 | var
24 | purgeFrm: TpurgeFrm;
25 |
26 | implementation
27 |
28 | {$R *.dfm}
29 |
30 | end.
31 |
--------------------------------------------------------------------------------
/recompile data.bat:
--------------------------------------------------------------------------------
1 | brcc32 data.rc
2 | dcc32.exe hfs.dpr -$W+ --no-config -M -Q -TX.exe -AForms=VCL.Forms;Generics.Collections=System.Generics.Collections;Generics.Defaults=System.Generics.Defaults;WinTypes=Winapi.Windows;WinProcs=Winapi.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE -DDEBUG -I"c:\program files (x86)\embarcadero\studio\20.0\Lib\Debug";"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";C:\Users\rejetto\Documents\Embarcadero\Studio\20.0\Imports;"c:\program files (x86)\embarcadero\studio\20.0\Imports"; C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";Presbylutheran;C:\code\other\compiled; C:\code\other\fastmm4;uFreeLocalizer;C:\code\other\kdl;c:\code\other\ics8\source;c:\code\other\GifImage;c:\code\other\DelphiZLib; c:\code\other\regexp\Source;c:\code\other\jcl\source\windows;c:\code\other\jcl\source\include;c:\code\other\jcl\source\common -LEC:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl -LNC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp -NSData.Win;Datasnap.Win;Web.Win; Soap.Win;Xml.Win;Bde;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win; -O"c:\program files (x86)\embarcadero\studio\20.0\Lib\Debug";"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";"c:\program files (x86)\embarcadero\studio\20.0\Imports"; C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";Presbylutheran;C:\code\other\compiled; C:\code\other\fastmm4;uFreeLocalizer;C:\code\other\kdl;c:\code\other\ics8\source;c:\code\other\GifImage;c:\code\other\DelphiZLib; c:\code\other\regexp\Source;c:\code\other\jcl\source\windows;c:\code\other\jcl\source\include;c:\code\other\jcl\source\common -R"c:\program files (x86)\embarcadero\studio\20.0\Lib\Debug";"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";"c:\program files (x86)\embarcadero\studio\20.0\Imports"; C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";Presbylutheran;C:\code\other\compiled; C:\code\other\fastmm4;uFreeLocalizer;C:\code\other\kdl;c:\code\other\ics8\source;c:\code\other\GifImage;c:\code\other\DelphiZLib; c:\code\other\regexp\Source;c:\code\other\jcl\source\windows;c:\code\other\jcl\source\include;c:\code\other\jcl\source\common -U"c:\program files (x86)\embarcadero\studio\20.0\Lib\Debug";"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";"c:\program files (x86)\embarcadero\studio\20.0\Imports"; C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";Presbylutheran;C:\code\other\compiled; C:\code\other\fastmm4;uFreeLocalizer;C:\code\other\kdl;c:\code\other\ics8\source;c:\code\other\GifImage;c:\code\other\DelphiZLib; c:\code\other\regexp\Source;c:\code\other\jcl\source\windows;c:\code\other\jcl\source\include;c:\code\other\jcl\source\common -K00400000 --description:"HFS ~ HTTP File Server - www.rejetto.com/hfs" -GD -NBC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp -NHC:\Users\Public\Documents\Embarcadero\Studio\20.0\hpp\Win32
3 |
--------------------------------------------------------------------------------
/runscriptDlg.dfm:
--------------------------------------------------------------------------------
1 | object runScriptFrm: TrunScriptFrm
2 | Left = 0
3 | Top = 0
4 | Caption = 'Run script'
5 | ClientHeight = 312
6 | ClientWidth = 544
7 | Color = clBtnFace
8 | Font.Charset = DEFAULT_CHARSET
9 | Font.Color = clWindowText
10 | Font.Height = -11
11 | Font.Name = 'Tahoma'
12 | Font.Style = []
13 | OldCreateOrder = False
14 | PixelsPerInch = 96
15 | TextHeight = 13
16 | object resultBox: TMemo
17 | Left = 0
18 | Top = 41
19 | Width = 544
20 | Height = 271
21 | Align = alClient
22 | Lines.Strings = (
23 | 'Write your script in the external editor, then click Run.'
24 | 'In this box will see the result of the script you run.')
25 | TabOrder = 0
26 | end
27 | object Panel1: TPanel
28 | Left = 0
29 | Top = 0
30 | Width = 544
31 | Height = 41
32 | Align = alTop
33 | BevelOuter = bvNone
34 | TabOrder = 1
35 | object sizeLbl: TLabel
36 | Left = 503
37 | Top = 24
38 | Width = 32
39 | Height = 13
40 | Alignment = taRightJustify
41 | Caption = 'Size: 0'
42 | end
43 | object runBtn: TButton
44 | Left = 16
45 | Top = 10
46 | Width = 75
47 | Height = 25
48 | Caption = '&Run'
49 | TabOrder = 0
50 | OnClick = runBtnClick
51 | end
52 | object autorunChk: TCheckBox
53 | Left = 104
54 | Top = 16
55 | Width = 169
56 | Height = 17
57 | Caption = '&Auto run at every saving'
58 | Checked = True
59 | State = cbChecked
60 | TabOrder = 1
61 | end
62 | end
63 | end
64 |
--------------------------------------------------------------------------------
/runscriptDlg.pas:
--------------------------------------------------------------------------------
1 | unit runscriptDlg;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls, ExtCtrls;
8 |
9 | type
10 | TrunScriptFrm = class(TForm)
11 | resultBox: TMemo;
12 | Panel1: TPanel;
13 | runBtn: TButton;
14 | autorunChk: TCheckBox;
15 | sizeLbl: TLabel;
16 | procedure runBtnClick(Sender: TObject);
17 | private
18 | { Private declarations }
19 | public
20 | { Public declarations }
21 | end;
22 |
23 | var
24 | runScriptFrm: TrunScriptFrm;
25 |
26 | implementation
27 |
28 | {$R *.dfm}
29 |
30 | uses
31 | main, utilLib, classesLib, scriptLib;
32 |
33 | procedure TrunScriptFrm.runBtnClick(Sender: TObject);
34 | var
35 | tpl: Ttpl;
36 | begin
37 | tpl:=Ttpl.create;
38 | try
39 | try
40 | tpl.fullText:=loadTextFile(tempScriptFilename);
41 | resultBox.text:=runScript(tpl[''], NIL, tpl);
42 | sizeLbl.Caption:=getTill(':', sizeLbl.Caption)+': '+intToStr(length(resultBox.text));
43 | except on e:Exception do resultBox.text:=e.message end;
44 | finally tpl.free end;
45 | end;
46 |
47 | end.
48 |
--------------------------------------------------------------------------------
/shellExtDlg.dfm:
--------------------------------------------------------------------------------
1 | object shellExtFrm: TshellExtFrm
2 | Left = 226
3 | Top = 146
4 | Caption = 'Option...'
5 | ClientHeight = 265
6 | ClientWidth = 388
7 | Color = clBtnFace
8 | ParentFont = True
9 | OldCreateOrder = False
10 | Position = poDesktopCenter
11 | PixelsPerInch = 96
12 | TextHeight = 13
13 | object Image1: TImage
14 | Left = 0
15 | Top = 0
16 | Width = 388
17 | Height = 169
18 | Align = alTop
19 | AutoSize = True
20 | Picture.Data = {
21 | 0954474946496D6167654749463839618301A900B300000000000033660066CC
22 | 3333663333996600006666666699CC99999999CCFFCC9933CCCC99CCCCCCFFCC
23 | 99FFFFFF00000021F904000000FF002C000000008301A9008300000000336600
24 | 66CC3333663333996600006666666699CC99999999CCFFCC9933CCCC99CCCCCC
25 | FFCC99FFFFFF00000004FFD0C949ABBD38EBCDBBFF60288E64699E68AAAE2CC8
26 | B4702CCF746DDF789E31C7612C08C68241D4198FC8A472C9641D180647742A7D
27 | 35AFD8AC76CBD5202CC5CBB74B2E9BCFE8120331B03C31E3B47C9E6C140080C3
28 | A441903400087778091C767800010B040B512E560D7A1206840E050167446B6D
29 | 156F069E56551F0D8D74A5A6210D940894900E0D03097C7E7D1BAD15B2B591AF
30 | 939284B8BB945D999A6EA01506A0AF0503AB0E0A87B17D0D5699B7067ACF88B1
31 | B0AEB0D900C1A7E24BBCAE8BDCBF02859113417A86E016B80A07F412F6B6F4F6
32 | C245C49C2F9E3E494A862E40B00602F82C8065079B3A0AB8FCA8C3F750E2B88B
33 | 756875E3E64A50BC5A1EFF132D22C0009DC63DB42635B8E46A2225952CB90CF3
34 | 47E1CD056428FD1488252891255FB45E859305EF124267BE7A625C9AC3CE4166
35 | 2C7F9DC410D19CA20521C399DBEAB41B14A01DB55E99497342A7805670CED2C9
36 | 06A82205EA7E719CB510AC1445DDEC32DD2BA36B4EB85BF3D63AA970A40659DF
37 | F2DC43402B31BB2C64D914C3A036F04ABCCE443A3BD0D0595C939815B054702D
38 | B068BEA85B08BD45AB00E7A03133542DCC60A7EC4BB65D45FD987BA5CC9992FF
39 | 85A250B928A16C060C3734645030623CC9FD70443E35B575128ED77634D053AC
40 | 3CC2CA95EA1C14B1EBEAF2B92103DF54D3181104F0935527E1FBBAFDFBF8AB39
41 | 88CC9EC21A0401C11704FF44F3A1728777F825A8E029D59055D604FF91B5E084
42 | 1456B88183EB59A8E1861C5E886126C1B523E088027668E2897C7D08627F0E04
43 | 81218028C62863292ABEC7621C167C41CA8C3CF6A8458D0FE25801809EF868E4
44 | 914A0019A2045F903822005078501592543655608A2A2ED9628B018816C0975F
45 | 0220859457B256E575F0C425C83B7734A7DD1F8140534848575DE9111ED81CA2
46 | C79D082E51A3964D8229680062EE785899049E695D2ABD30EA946DF571C55050
47 | 880696E8A1139CC62444B1A9F721A05B8251A8746B3A030D51E030A7D59A45D5
48 | A6A7A2A7AC360132E870A49049160D46205EF068F54B7A1001EBE98B376EA940
49 | 0112A8C3C0A8CEB9D9D2FFAD3C39646667E5750A6B1A3F1158DB4BAC0C60AB47
50 | 7DEE41E74825E9F56681FBFCF669B15F1480AC000708B0EC9896ED541456CDC9
51 | 359434944A17EEB564F8655E77D2211055BFBAA274555697E2D2A61FD60EEB20
52 | A86320EBC097F336F26B5B56110098BE89D6E7F06300CFA14052BE6A84585C41
53 | CD45157875CA16546FD208FB6396EC62C8EC2F9A6586173D9D7D5C2B4F600156
54 | B21C2787252B05AEE554C96B1017023349366B97D95AE9F2B3EE900E1CE2F521
55 | F41A672A00C9F1EA9AAA8299CAD9213EE1E1ECD101CBE9D81F8A396D07776EFF
56 | 6B69C71DB96D66A67AC2A38DBAC472BD81C695967014DC8C2F88F39040220E43
57 | 366F376EB9758F1317D0FFE69C1B7AF9E700670EFAE8A45F207AE9A8937EFA3D
58 | 0AB4AE40EAB0875E3805AF378040030DBC1EFBEE546E9DE902402C0BBCEBAEF3
59 | 6E7C8CBEDFB3A998B72CC03CA61D4C9985F4851D7F46F57324EF8C2B410080FB
60 | F7B83B2F35995C254E3E7DD5611F3DA2D29F6F06F56D2685879A725A0608B852
61 | 1E52D1CB17A89F86F6B55B1603C0F73DF1256C7CED5B02F50CE3BE0D3DC35A49
62 | FB18B796B616A148A503A2A144D264D63F06CA0180AE0084F708D800032A034F
63 | 7D43C4D862221545B88A6CE7B8C3016438B68F7483551E13C9426448C36F0C45
64 | 29BDAA1EDA0087881772267E7C108DD9F034C40978A46C0328D516A6741EC230
65 | C46556C1554B3A500E22FFA62A87460CA2617C182CF220318A7938D009BFA8A9
66 | 14CC4E79D30802094BC8BCF3F8E41DE72044395AC8AF2CC62255B1595CB3B082
67 | C7BAFC211681AC08B5F2D8B18549CB5F528846471CB2C8DAE8A26946BB850E0B
68 | A2372350716812C8163CD8F18A6FD5EF3058DC434268E69C91602657A164856D
69 | E0624140D6453758E9E407DEB83D388D9080269C1963E8922DBB29875FBCEA63
70 | 51EC568061F28D2835F3DBB9B0C2B63A61465676701334A5734D0F820C2293BA
71 | 66D5143895F3CCC52F6129D8C1ACC6C15BF4E4954419D712556835B924936F1D
72 | 71660354C0CB00CA9184C1640BC2B2C90A4ADD5388C8D462BDF4794C3F5A8A8F
73 | BB62200509BACD6E7413FF9E2D5B552167A64B2BDD42A1F708C71EFBF0B18C82
74 | 6428A051591F15C6C8F2A8949BCA94683383C2CF89F5A776229C63407139CB44
75 | 44628FDC50A234C219D3D0B01036172D6A6358D85342B2D4A999B4854A1882C9
76 | 8450CA923A91D66A8C86BD484DCFA4117489D27C61ABD6404D37187493028C0A
77 | 4FAA1EC4954B659A2C8F63D5F25DB36735B529ED80C7D7BEF6B58E04A35BD9A4
78 | 780FE830F019658BE9D8A2331E6D40749BD481886153A8C3683A6B94853DA263
79 | FB354AB459F09D8B2098167C789EF8857010297CAB4EF036380CEA6FB11E54DB
80 | BDC63859719971B376ED4E558C3102ED75ED6BC0C5033B9590400A15D77A2B38
81 | 2E0A7C0B02E5E2C0B909FF822E724D205D123077BAD89DD175B3CB5D13F9D649
82 | 24EAAE78EFF3DD4F796EBCE8BDC87733A0A3F4BA1723EB854340DE4B5F53AC17
83 | BCF081D279F7C682EAD6970EFE1DC77DBB342842D1EB3B7D299072033C5DBAB1
84 | 6970987DD3FD4E291B79DAE96B7942219FC830E0021B78BF0C6E202ACC97DD95
85 | 0423ACAE4059052735DC0E22187A57DBD41E228685FB9A6E6768CC4312999863
86 | CEF498B235941F227698461D8F241B2463554F5E5837EC6EB095C728E82DD331
87 | 3E96A6F66FE80C56478F60E363256B3F38F6C51D715990298F7936AB2C24436C
88 | 19DA77742A9E789C317705B70DB2AA563AA6442D48AA492E905A065D24DB828D
89 | DDE50078C96B67C23468FFA2055A41D0D245A9DD9CD64053793C73962B6DE87C
90 | 85C1CE55E54753336F0D6B0D3DBDAA35FE70AD6212C018A2198D4F3BE8B30006
91 | 38D89425DAD0C2443A64EB7C5A7765452BBB64796596A1F4A53C7DA55F15349D
92 | 66B8AFCEC286544543ECAEB9C4A7129B0A69CE0ECD3C24DD5F76F1E10DBAA6CD
93 | 6967834DA73BB62DFEDD639D59E3302FB7145CB0694CB706D56D60D906DBD326
94 | D6AEB44EDB33D6E6B64F570EB982905F73B2532FD6FEFBC58F06F2B06BA85950
95 | 973A431410D24D5ABCF0040AF20617FFAFF1CA5B23C9B573B894DB720942AE71
96 | E4FAB67328DF6FC957EEA7FFE097452C8F391D82E0AD9ADBDC5B43C22F7C64CE
97 | 73894928E2E6EDB9D05BFFFE21C389E1C0434F3A0E6A64F41CCD57E950AF01D3
98 | 23DE22FCEA37EA670AB17D55746A020F8A59AA41980DB40EBB34A5F023BF98B0
99 | 9E0F63E10D7C634F5E137992B84E75837918ECFD157B0DC89E3A464592829292
100 | 247F5DFC370CB41147A44E36DDDB11AA0A648C544CCC214F200CC48057024F4A
101 | 762C1A67A818D2364DD39F77D99A482BF93216D123816E9C05B1082DCB689BF0
102 | 09EF95B8BC9365C52F7E535FF072A1C11CB6327FBEAA8B9CF59F27E9995A2212
103 | 229FF98A57BA385C84742658718EDAE84449D852CA92C254B1F0A55D6AF8D4AB
104 | FBF65B6AD7BBE2F5F8854EFAA259B9A03D15BB4CB5012ED0BFEA77FA262D772A
105 | 65BA3750E1F4011BC9B0FFC03C0CADD933758C876A171300E5B73193A629FE33
106 | 7CEB67575AF407A4D464395145AF2467FEE77D96F3649184352C034930D648F3
107 | 213035537F73077E4DB26C1E771933434990D266E06467415357D06454160529
108 | 03106DE6247842B5076EB51599E4734012844238844458844678844898843F67
109 | 0240C235ED265CEF9637E80161F4D67EFB265B48A458D4E15497F17906212BFB
110 | B6852A830ED5245A63817537D08454773814570BAF670A19F723FBA184745887
111 | 76788778588773B85C02C82491D386174072E22088C230877978888898888A88
112 | 848678026A382B29C7393CF7028B588996788995D8884CD887680806868889A0
113 | 188AA238841210066AD0FF873D908AAAB88A3D207394388AB0188BB2480DBC25
114 | 028FE8008F9100BA28162468729F3884067008CC308BC4588C45B7879B787BB9
115 | B88B362101BD683DAF4884C12820030025C6788DD7588AA6D85BA8588A09C000
116 | DFC80307100CCF783CD13884789009D3188C06508DC308057830006B00000310
117 | 8C64838DF8A887DA788ADD088EBB4804F1D28A0E20167C573AE72884E94804EB
118 | 488FF9258F084036ECF89080B01080908F16798410528BBB748B91300CBA082F
119 | 3D400804091E85C73B07198409398F9E5091CB0225D5388FCC708FF0E8221759
120 | 93419891FCA88CDA4804BAA88AEA3092FBB73B27092429C98ED34804D5E83C5F
121 | F390C8309336F99402B8FF8D21709366E18D9990003E098E8535641E13796F61
122 | 80D5B77932B4460F464FBDF38B28698D3379942D591213093C4CA9902C099574
123 | 391338695D1CB993E2E893BA28183FE0858ED47C6B864866C68524D62143D971
124 | 15C906FA758FC1E890F7C80671E994755999A628958ED087B5F802BBA88B4540
125 | 507F1633CDA754AC56908E839641688F0C098FC2A88E87905F4DC99696599777
126 | C98D9AE991B8388E00A99BE2D233B6F65221834C33136B80A85DA87984B2399B
127 | CA49959A688BB7C800044012D1C90001700004D003D7F90652C550A2E91C2C36
128 | 8348D5826792982AD26ED54893CB999EC7D89C53798B0E109DF09900D5799DD5
129 | D9032FD0598A5681FB66FF4145356FD27496EA19A09898911AD901CC2901F469
130 | 9DD4699FD969803460716FD823E429A014AA8FFB689BB7079D9C4912060890F0
131 | 59A02A3025848824135AA1268A913B89A1195A8A19699FFDE08AC779A2325A84
132 | FE01A21A20849DB803311A8A9F30A3C4C8A29869A0070A0201B012465AA4487A
133 | A44A9AA44CBAA44EDAA450FAA4521AA5543AA5565AA5587AA5565AA22F228CE8
134 | 899C4DE9A3B208A436BA03432A059B731B1EB6A66CDAA66EFAA6701AA7723AA7
135 | 745AA718B3A35D8A0040D0A349C8A7621A8BB599999C6800F041A8307201769A
136 | A88ABAA88CDAA88ECAA564E1A736E22D2E628FF2B839F3880744528D32F9A7A1
137 | B81FC8D89EB7C83910D9FF3910E3A8A89AAAAABAAA740AA9C00108E809004320
138 | 4044003C80D08E41E03C7A3A04D3080473E9A99708AA41CA01383A2B85FA90E0
139 | 158C05C8AACCDAA6F2320072FA1008F0ACCDDAA8AE3A13AA19047C4AA8C380A9
140 | 5010A6DFAA8EE00AAC9978A1A2DA8786BA92C92A260851128C4AAD6002AF702A
141 | AF6FFAACF24AAF82421206202F2401ADD5CAA6F83A28D74A16BE0A205F830CED
142 | 081D3DEAA7DB3AAEE4AA88812AA8EB2905854A36EBBAAC8D4AAF019BAAF6EAAE
143 | F3EAB11BFBAF723AB00EB2397D358F7AEAAD0C1BA692FAB08998A22A8A21C401
144 | 9BB04A22CADAAEFEDAB1D09A0003C00EFBAA955C42090B0026425B11FEFA258A
145 | 249DEEDAAF15116B44ABFF8DAAF0ACBAE0AF04F05625D1B482E2B33A6B103D3B
146 | 2B066130FA2A28C1100424A10A028BA725CBADC8BA1095EA0990891642F08EE1
147 | AA90081B9B76EBB2FAA81FCE5974C690AE9E70B10100AFFDFA048CE1B1817B14
148 | 06931003A0B12551B506C31960E2B881ABA1B090B87CE0AEF77AB55C6255945B
149 | 9D47DBB14A0BAD01CBB93DBB06FD1AAF2B911087EB619CDB07B1A60E47EBA046
150 | C8989A6A23D08194F4588F7C2A91B7CAB2754BB7C08BB74A68AE7B2BB37D4BB3
151 | 178BB360E203D6B9000230B4498BB9576BB893BBB8D29BB3D2CBB42BE103DAF6
152 | B9D32BBA1A5AB50E10BBD5CBAFD059019FCB83CCBB08CF1BB83CD8AF09607782
153 | A20E3F7BBA610B26242BFFBC154ABCE7EA20A06AAC4462A8362B26D5BBBC648B
154 | 95D32A05937BBA5B1BAFDF5BC0870BBEA79B004C4BBD0E6CBD12BCB484E0BDD6
155 | 1BBA0546BFD57B00072CC2204CADF16BC15FBBC04B0B058292BFFA2BA0FC2BB1
156 | 1272BC4C59B32372B3993BB44FF0B3D0FA1AD7CBB80320B990FB25616BBE3D2C
157 | 040120B91FFCC0E64B007697004E5BBEE11BBF4BDCC3AF202F3A0C05D4EA63EE
158 | 3BB4053CC4461CC12D8CB62F2CA331BC917CAB39911810042CAF45FC0A6E4204
159 | 0CECAE84E0C55F52C7463BBF2871BD48CB83623B87192CBE0E60C752CCB47E7C
160 | C7DA18C42CACB871ECB1508CB48D1B0CD24901E4EBC2659C9E67EC0143FA845F
161 | A31B223BAF2BF1C9A28CFFB470ECA6216BC997AC9C992CA4693C02A3CCA6C140
162 | BEAFDCAC545CAF287CA7D439CBBABCCBBC3C2841F02539E9BF65AAA6BD5CCCC6
163 | 3CA79478CCCABCCCAA8A0CC08C979CF801593ACD5A4ACDD65CCDD87CCDDA9CCD
164 | 529ACCCCFCCDE05CA74F10003027C34B98A38EB71F1C6BB8211BCEEE6CA70450
165 | 9D609B8C138BCE10A2CE75BA0D8392B91C0CB0207BBE945C1184FCCEB35C8FF5
166 | 19002AC7CAF56CCFC25AA7F2C2C2F3CBCE122DCB170CC9A74BC42CBC0804CDCB
167 | 06DD03D549CF32CBD0FE81CF737A000B90005EAC488B7BC86EE2BC13D0CF2A7C
168 | B417BDD11C7D0001C018370DD2FE2BD2F79CCB730AC58A2BB9FC4AC5FC2CC4A1
169 | ECBE0B37BE6246D3BC1CFFCFFE3ACC371ACDF6ECCDD1DAB85A9CBD7C0CC9180C
170 | C1F01AC6FBECC94CFDCAB10BD551BDD0534DD271FA18CE8BD5E0CBC1D4DAD5FF
171 | 3CD3F97ACB61FDC9E5DCBFE72CD2541DA7B5CCB9B1E6C37F5DCAD56BD4151DD3
172 | F19AD274FD7575BDAA24A1D376C9D3403AA782ABC589FC1048F9C72E2D0130ED
173 | D5882C0971EA358B8DAA9551BC3B0DD97B1DDA757AA96C83DA893A20C1FCD8A6
174 | 8DD6708AA861FD3CACC9DA754AD6661AD2B1EDD3B83DA75032249CFADB6F3ADA
175 | 313B0C901DD9C44DA712C724ABBDDC02ABDB18007E0C7DDAD0EDA6775D8AAA79
176 | DD492CDDD36DD6E88CCAE9F93C37FA985FAACA6E04DE392ADECB298FC4CA98F5
177 | 18A0794516D9DD89ECADFF9C45623A066BB1263A035A52DD646C930B4184FFDD
178 | 22F4F8032A32E09699DEA696DC24AB9478228A033EE1F248B06C3313E44D1C37
179 | 58E19900E1CFCBE14408E11D1A84D434E246C8870DDEDB215EE10A3E8A14EE20
180 | 0A2E1AC3C00C6B88A6204E4842F003203E84316EE21F82E332CE888EFD20005E
181 | 843DBE4306A894492E8F138E0C9423047AD2E14CCEE4847A8382E02D6B22E5B5
182 | 2A8FDF400AC8FAD2F3B3E5C340647900E54544E64F20E671CB069660E626AEE0
183 | 2D8EA2D00C712ACEE35E63D2650EE489C0E5D7B0100AAEE36A1EB70C401A26BD
184 | E182EE3C4F10E4823EE826FE0C2FFD922F0DAE6D52AB653E6D899E08953EE247
185 | 9EE7AEC1E81DDEE9382EFFE422905F5EB322C92DAC2BBEE570CEE297EA038CB1
186 | 301D0AE145A48EAEEE4A53BEE82D2EE2947E089408250F090ABF3AE843C6EAAB
187 | CE06B5DAE9667EE6AC1EE8C9EEE3273E0212F992A6EEE001AEE56BBEEC824E0F
188 | 376800F470EC37BDE399A0ED8C400F2FBEEAD64EE94FC0B652608DC1480DC1CE
189 | B6C4CEEAC62E04C81EE7E6BEE83311E772EE02BFB5E3051EDED5AEE64AC4E29D
190 | 2EE30B212F84BE00E9DE4CC89EEFD69BF0B77EEFF8BEE8A21105F4B8E5B63D91
191 | 2411B7ABAEE73D7EEEB85EF0CE8E150F3DBCBDA596D35EE742A8EBB9EE36C77E
192 | E9F41EE6BAFEE930AFE077E02D81AEEF57FE92171FB7ED08216A9707E6AEE4CD
193 | 3EE637CEE1443F0CD950FFF2264FDA29CFD3F79D9EDEE2B03FEFDCB3BAF2E08E
194 | 8D4E3F0CFFBEDE014F04C0959EEDEE20F5D80E280F24FA8E8F5BFFF47AFDF527
195 | 3AEF644F0AED78A2E64CE750EFF66FAF22342E09598FDE1FA0732352DF6818F5
196 | 7F0A08564FA121C00637B7F8828F75842FA6CE338FFD8DD7A95CF98F2FA60FD9
197 | F77E5FF7965FC678AFBFE7BDE0C84DF99D7FC99F7F89695FFAA4F8896BAFFAFA
198 | FBF5700E6B9A9FEA2F6EE1775E231E4EE2B34F9BA34FFAAE2FBCB00FEABB7F84
199 | B5EFF03C0EEA0E0BE3C33F9BC7FDFBC06F847031E81F9EEC857EE8615AEE55FE
200 | 69581EE1CC8EE6319F07479FE544FF694C2FDFAFEDFC2EEBF632EE1A7E1EEF83
201 | DEE748CFE7855EEE99DEFFE1A08DE88C1EEAAE12EB99AEE7130F014C4E5AEDC5
202 | 596FEAFC0743D1E34AF344537565DBD6519761311879017220608CC340101604
203 | 8A0F28140E6C4A99A4E9544E9EB72845B19B160CD1E6D3F5054B4663322C7C46
204 | A7D5EB9539653010A915C56166A85BEDB47A97C9ADF25A8212941A40E0D2021C
205 | 644B73C3288B246BA4ACB4BCDC783CB93A585A28E834146050F0A190192D3DF0
206 | 63F4129C9A017522F28C5208F8ECBC65C484942461009EF82516E93D464E7E59
207 | 81B5D1E1C925E53995DD7D2A00185874D2C9D98272CE39C016C7C999369F66C0
208 | 1E4D2E1EE978970F51AEB7BFD7BCEF2DD4BF98FF0718A9DF408267F271E896A3
209 | A0097EEE3404841851E248C48515591CC4F7EBC4187B1F1E4E041952E44812C0
210 | 4AC210669112C61428CD9084C9F1584C9A356DDEC49953E7CE916A78FE041A54
211 | E850A245CB042B6154E952A64D9D3E851A3102003B}
212 | ExplicitTop = -6
213 | end
214 | object Panel1: TPanel
215 | Left = 0
216 | Top = 169
217 | Width = 388
218 | Height = 96
219 | Align = alClient
220 | BevelOuter = bvLowered
221 | TabOrder = 0
222 | object Label1: TLabel
223 | Left = 16
224 | Top = 16
225 | Width = 217
226 | Height = 13
227 | Caption = 'Do you want HFS in your shell context menu?'
228 | end
229 | object Button1: TButton
230 | Left = 108
231 | Top = 56
232 | Width = 75
233 | Height = 25
234 | Caption = '&Yes'
235 | Default = True
236 | ModalResult = 6
237 | TabOrder = 0
238 | end
239 | object Button2: TButton
240 | Left = 204
241 | Top = 56
242 | Width = 75
243 | Height = 25
244 | Caption = '&No'
245 | ModalResult = 7
246 | TabOrder = 1
247 | end
248 | end
249 | end
250 |
--------------------------------------------------------------------------------
/shellExtDlg.pas:
--------------------------------------------------------------------------------
1 | unit shellExtDlg;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, ExtCtrls, StdCtrls, utilLib, Vcl.Imaging.GIFImg;
8 |
9 | type
10 | TshellExtFrm = class(TForm)
11 | Image1: TImage;
12 | Panel1: TPanel;
13 | Label1: TLabel;
14 | Button1: TButton;
15 | Button2: TButton;
16 | private
17 | { Private declarations }
18 | public
19 | { Public declarations }
20 | end;
21 |
22 | var
23 | shellExtFrm: TshellExtFrm;
24 |
25 | implementation
26 |
27 | {$R *.dfm}
28 |
29 | end.
30 |
--------------------------------------------------------------------------------
/todo.txt:
--------------------------------------------------------------------------------
1 | - update doesn't work without 'only 1 instance' (it's the -q)
2 | + replace shellExtDlg.gif with transparent png (english system)
3 | + self-test supporting https
4 | + expiring links
5 | * dismiss regexp lib http://docwiki.embarcadero.com/Libraries/Rio/en/System.RegularExpressions.TRegEx
6 | + load *.events
7 | + url auth limited to resource
8 | + global limit speed for downloads (browsing excluded)
9 | * consider letting comment "protected" files. Can it really cause harm?
10 | * flag to enable lnk files in a folder (disabled by default)
11 | + sign exe http://www.rejetto.com/forum/hfs-~-http-file-server/'unsafe'/msg1061437/#msg1061437
12 | * cache reReplace
13 | + {.calc.} to have a third numeric parameter that becomes 'x' symbol
14 | + hash&salt passwords
15 | - setInterval > setTimeout
16 | + target=_blank as an option on links
17 | - an unsaved VFS will be asked twice if a restart is caused by an update
18 | + more macros http://www.rejetto.com/forum/index.php/topic,10631.0.html
19 | - long folder names are overflowing the tree-box http://www.rejetto.com/forum/index.php/topic,10631.0.html
20 | + {.vfs delete.}
21 | + log: color upload and downloads http://www.rejetto.com/forum/index.php/topic,10202.0.html
22 | + make simple variables work outside connections http://www.rejetto.com/forum/index.php/topic,9805.msg1054886.html#msg1054886
23 | + {.server stop.} http://www.rejetto.com/forum/index.php/topic,9577.msg1054784.html#msg1054784
24 | + macros missing to cache a folder: {.reply|content=|var=|code=|filename=|mime=.}
25 | - unexpected scripting behavior http://www.rejetto.com/forum/index.php/topic,9728.msg1054517.html#msg1054517
26 | in handleItem() translate only symbols, and run all macros at the end
27 | document: [section|ver=MASK|build=MIN-MAX|template=MASK]
28 | document: {.if|var}
29 | document: {.exec|out|timeout|exitcode.}
30 | document: [+section]
31 | document: {.set item|diff template.}
32 | document: {.add header|overwrite=0.}
33 | document: {.calc| ][ }
34 | document: single line diff templates (file path)
35 | document: {.disconnection reason|if=XXX.}
36 | document: %url%
37 | document: commands returning white space: add folder, save, set account, exec, mkdir, chdir, delete, rename, move copy, set
38 | document: pipe, base64, base64decode, dir, disk free, filetime, file changed, load tpl, sha256, for line
39 | document {.convert|macros|dec|hex.}
40 | document: new event [login]
41 | + event to filter logging http://www.rejetto.com/forum/index.php/topic,9784.0.html
42 | - wrong browser http://www.rejetto.com/forum/index.php/topic,9710.0.html
43 | solution:
44 | read HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\http\UserChoice::Progid
45 | read ROOT\$program-id\shell\open\command::Default
46 | * findExtOnStartupChk, when failing, is not reporting the server
47 | - better dialog message http://www.rejetto.com/forum/index.php/topic,9778.0.html
48 | + upload to non-browsable folder
49 | - android doesn't upload http://www.rejetto.com/forum/index.php/topic,9699.0/topicseen.html#msg1054287
50 | - android doesn't work with passwords http://www.rejetto.com/forum/index.php/topic,9575.msg1054029.html#msg1054029
51 | ? default tpl: consider css data uri http://www.nczonline.net/blog/2010/07/06/data-uris-make-css-sprites-obsolete/
52 | + next VFS file format version should be text (yaml or json)
53 | + remove the "progress" from "log what", and use [progress|no log] instead
54 | + folder archive depth limit http://www.rejetto.com/forum/index.php/topic,8546.msg1050027.html#msg1050027
55 | ? in getPage() many %symbols% are translated in a way incompatible with {.section.}
56 | ? Windows Script Interfaces
57 | ? {.image|src=file|width=x|dst=outfile.}
58 | + user input through {.dialog.} or similar
59 | + show missing files in VFS http://www.rejetto.com/forum/index.php/topic,8203.new.html
60 | * {.cache.} should be able to work on a simple variable
61 | + plugins system http://www.rejetto.com/wiki/index.php/HFS:_plugins_design
62 | ? tpl as plugin category
63 | ? try merging 2 implementations of runEventScript()
64 | + support PUT http method
65 | ? use the system index for faster searching http://msdn.microsoft.com/en-us/library/bb266517(VS.85).aspx http://www.rejetto.com/forum/index.php/topic,7700.msg1047024.html#msg1047024
66 | - out of memory / GDI http://www.rejetto.com/forum/index.php/topic,7703.msg1047118.html#msg1047118
67 | ? consider using tpl.appendString() in getFolderPage() instead of getRecursiveDiffTplAsStr() to avoid some string concatenations
68 | ? fake the by-default "anyone" in permission/download, to reflect the behavior www.rejetto.com/forum/?topic=7301
69 | + log event to filter www.rejetto.com/forum/?topic=7332.0
70 | ? integration with mediainfo.dll www.rejetto.com/forum/?topic=7329
71 | + folder archive log, just as for deletion http://www.rejetto.com/forum/index.php?topic=6904.msg1042974;topicseen#msg1042974
72 | - AV with RealVNC on hints by mouse hovering www.rejetto.com/forum/?topic=5261
73 | - N-Stalker can locally crash HFS
74 | - AV in #179 http://www.rejetto.com/forum/index.php?topic=5653.msg1033457#msg1033457 www.rejetto.com/forum/?topic=5681
75 | - AV in #184 http://www.rejetto.com/forum/index.php?topic=5792.msg1034538#msg1034538
76 | - AV in #185 http://www.rejetto.com/forum/indebx.php?topic=5795.msg1034536#msg1034536 www.rejetto.com/forum/?topic=5873
77 | - focus problem hovering this hint http://www.rejetto.com/forum/index.php?topic=6321.msg1038272#msg1038272
78 | - lock icon is lost on moving http://www.rejetto.com/forum/index.php?topic=6371.msg1038531#msg1038531
79 | - there seems to be problems with SMB resources www.rejetto.com/forum/?topic=6365
80 | - malfunctions with incorrect timestamps http://www.rejetto.com/forum/index.php?topic=6418.msg1039179#msg1039179
81 | ? permission events www.rejetto.com/forum/?topic=6698
82 | - show error message http://www.rejetto.com/forum/index.php?topic=6695.msg1041212#msg1041212
83 | - AV deleting files in #221 www.rejetto.com/forum/?topic=6629
84 | + "no download" should become a permission http://www.rejetto.com/forum/index.php?topic=6870.msg1042583#msg1042583
85 | + http://www.rejetto.com/forum/index.php?topic=6719.msg1041559#msg1041559
86 | + link properties: "open in new window"
87 | + authentication digest
88 | + improve the connections box http://www.rejetto.com/forum/index.php?topic=6689.msg1041182#msg1041182
89 | + ban page can't eventually access template files www.rejetto.com/forum/?topic=6628
90 | + support POSTed files www.rejetto.com/forum/?topic=6618
91 | + clicking on a group, user should get notified of what accounts are part of it
92 | + multi-span folder archive www.rejetto.com/forum/?topic=6575
93 | + an updated hint on virtual folders, to explain how to get upload working
94 | - requesting a non-existant file inside an unauthorized folder, apache replies 401, hfs 404. try to comply.
95 | + make %list% available in every page
96 | + support for ALT+F4 with option "Minimize to tray clicking the close button" www.rejetto.com/forum/?topic=6351
97 | + replace and delete icons http://www.rejetto.com/forum/index.php?topic=6317.msg1038157#msg1038157
98 | ? currently the delete permission is only inside a folder. you can't mark a file or delete the marked folder. is this ok?
99 | + when a link is protected (no access for this user) it may be displayed as a link to the %item-name%, then 401, and if login is successful provide a redirection
100 | + change folder/link/generic-file icons (via GUI, without editing the template)
101 | + a way to get bigger icons (client side)
102 | + be able to produce rss http://www.rejetto.com/forum/index.php?topic=5846.msg1035481#msg1035481
103 | * better warning message http://www.rejetto.com/forum/index.php?topic=5795.msg1034406#msg1034406
104 | ? on the fly files compression www.rejetto.com/forum/?topic=5492
105 | ? firewall mode www.rejetto.com/forum/?topic=5461
106 | ? auto-removing folders www.rejetto.com/forum/?topic=3149
107 | + last-access-time for files www.rejetto.com/forum/?topic=5266
108 | + expiration time for account www.rejetto.com/forum/?topic=5409
109 | + warn the user if there's no useful IP address http://www.rejetto.com/forum/index.php?topic=3193.msg1031371#msg1031371
110 | + GUI suggestions www.rejetto.com/forum/?topic=5334
111 | + {.cookie.} http://www.rejetto.com/forum/index.php?topic=5349.0
112 | + restrict access to -> ip mask www.rejetto.com/forum/?topic=5244
113 | + an option to not consider LAN traffic graph/statistics http://www.rejetto.com/forum/index.php?topic=5244.msg1030090#msg1030090
114 | + url command to save the output in a cache, given an ID an an expiry time (minutes?) http://www.rejetto.com/forum/index.php?topic=5239.msg1030223#msg1030223
115 | + ban list sorting (maybe always sort?) www.rejetto.com/forum/?topic=5251
116 | ? shutdown message www.rejetto.com/forum/?topic=3206
117 | + a variant of ?limit to trim after full listing (rename limit? the other method recalls the SQL limit, would fit better) http://www.rejetto.com/forum/index.php?topic=5196.msg1029734#msg1029734
118 | + show update news inside HFS
119 | + a way to filter/show only "new" files www.rejetto.com/forum/?topic=5227
120 | ? add to the LOG the X-REQUEST To to be able to know whom the proxy is forwarding to
121 | + a way to add via cmdline a file specifying its virtual name/path
122 | ? "sticky file" with an hint on adding a leading blank space www.rejetto.com/forum/?topic=5088
123 | + upload file overwriting per-folder www.rejetto.com/forum/?topic=5086
124 | + https
125 | + filter mask based on host, to disconnect who is not using our dyndns
126 | + mouse hovering the graph, shows the speed and time for that point
127 | + per-folder no-limit
128 | + windows auth (NLTM? seems to be available in ICS) www.rejetto.com/forum/?topic=3762
129 | + more stats www.rejetto.com/forum/?topic=4968
130 | + to disable single ban rules
131 | + ban by hostname
132 | + edit comments for real folders www.rejetto.com/forum/?topic=4667
133 | + a way to pass ini commands through the command line
134 | + create folders via command line www.rejetto.com/forum/?topic=3955
135 | ? support mp3ToIon www.rejetto.com/forum/?topic=4600
136 | + download only for
137 | + account: see all transfers in ~progress http://www.rejetto.com/forum/index.php/topic,9325.msg1053416/topicseen.html#msg1053416
138 | + limit account to a host mask
139 | + tray icons for uploads
140 | + MAC filter
141 | + if robots.txt does not exist, an option "don't be listed on search engines"
142 | + menu -> limits -> temporarily disable all limits
143 | + menu -> limits -> max speed for each address
144 | + option to display counter for folders as number of accesses instead of total access to files in it
145 | + autodisabling accounts www.rejetto.com/forum/?topic=5379
146 | + on update, propose a link to the "what's new" page
147 | + add special folder (expert mode): let you specify a special folder, like documents, or manually enter a path (useful for relative paths), or GUID
148 | + logs rotation (hfs always append)
149 | + double address bar, one for LAN and one for the Internet
150 | + per user diff-tpl (apply both folder and user diff-tpl.s, and let the user decide priority, default:user,folder)
151 | + "Folder image mask", a file mask indicating the external file that should be used as icon (~img_folder)
152 | + to be able to add icons from multi-icon files (like shell32.dll)
153 | + installer (saving to registry, and making ini-file the new default, don't ask for shell menu)
154 | + support unicode filenames (FindFirstFileW. Cannot be done because widgets don't support unicode)
155 | * show "(home)" instead of "/" in VFS
156 | + show updateinfo notice also in autocheck
157 | + top 10 downloaded files
158 | + after the self test fails, and a router problem is detected, prompt a wizard for portforwad.com (extract routers list)
159 | + export vfs map as txt/html
160 | + specific message for each disabled account
161 | + search for files including meta information (id3 tag) www.rejetto.com/forum/?topic=5312
162 | + multiupload using flash
163 | ? support shortcut to folders in real-folders
164 | * save custom icons in VFS only once
165 | + DNS reverse for ips www.rejetto.com/forum/?topic=4970
166 | + UPnP (www.upnpworks.alcidelic.com/links.html) (www.whitebear.ch) (http://miniupnp.free.fr/) (http://miniupnp.free.fr/files/xchat-upnp20061022.patch)
167 | + UPnP Media Server www.rejetto.com/forum/?topic=5538
168 | + save to registry in different strings
169 | + loading cfg, if version < current then warn user
170 | + auto-ban IP if: bad login X times (with IP exclusion mask) [macros?]
171 | + deny listing and download for uploading files
172 | + download/upload quota (global and account-based)
173 | + purge VFS from unexistant items: files, real folders, virtual folders, empty folders
174 | + custom browser [with an help on how to get a new browser window]
175 | + admin panel (with stats, and maybe commands)
176 | + limit bandwidth/downloads/kb by user, by ip
177 | + external text files with list of authorized IP addresses/accounts
178 | + periodic password changer? (t=1061)
179 | + thumbnails mode (create thumbnails on addition)
180 | ? socks5
181 | + SSI
182 | + support file renaming notification
183 | + multi-language
184 | + zip format for folder archives
185 | * stop using /~commands and move all of them in the standard ?name=value form
186 |
187 | VER 3
188 | + new kind of folder (no more real/virtual folders)
189 |
190 | VER 3.5
191 | + search for files
192 | + file/folder properties in a window (collect menu commands)
193 | + undo (multilevel)
194 |
195 | VER 4
196 | + PHP/ASP via CGI (http://cgi-spec.golux.com/)
197 |
198 | VER 5
199 | + ftp / webdav
200 |
--------------------------------------------------------------------------------
/traylib.pas:
--------------------------------------------------------------------------------
1 | {
2 | Copyright (C) 2002-2008 Massimo Melina (www.rejetto.com)
3 |
4 | This file is part of Http File Server (HFS).
5 |
6 | HFS is free software; you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation; either version 2 of the License, or
9 | (at your option) any later version.
10 |
11 | HFS is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with HFS; if not, write to the Free Software
18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 | }
20 | unit traylib;
21 |
22 | interface
23 |
24 | uses
25 | forms, ShellAPI, Messages, windows, graphics, sysutils, classes;
26 |
27 | const
28 | WM_TRAY = WM_USER+1;
29 | type
30 | TtrayEvent = (TE_CLICK, TE_2CLICK, TE_RCLICK);
31 | TtrayMessageType = (
32 | TM_NONE = NIIF_NONE,
33 | TM_INFO = NIIF_INFO,
34 | TM_WARNING = NIIF_WARNING,
35 | TM_ERROR = NIIF_ERROR
36 | );
37 |
38 | TNotifyIconData = record
39 | cbSize: DWORD;
40 | wnd: HWND;
41 | uID: UINT;
42 | uFlags: UINT;
43 | uCallbackMessage: UINT;
44 | hIcon: HICON;
45 | szTip: array [0..127] of Char;
46 | dwState: DWORD;
47 | dwStateMask: DWORD;
48 | szInfo: array[0..255] of Char;
49 | uVersion: UINT;
50 | szInfoTitle: array[0..63] of Char;
51 | dwInfoFlags: DWORD;
52 | hBaloonIcon: HICON;
53 | end;
54 |
55 | TmyTrayIcon=class
56 | private
57 | icondata: TNotifyIconData;
58 | shown: boolean;
59 | procedure wndProc(var Message: TMessage);
60 | procedure notify(ev:TtrayEvent);
61 | public
62 | data: pointer; // user data
63 | onEvent: procedure(sender:Tobject; ev:TtrayEvent) of object;
64 | constructor create(form:Tform);
65 | destructor Destroy; override;
66 | procedure minimize;
67 | procedure update;
68 | procedure hide;
69 | procedure show;
70 | procedure setIcon(icon:Ticon);
71 | procedure setTip(s:string);
72 | function balloon(msg:string; secondsTimeout:real=3; kind:TtrayMessageType=TM_NONE; title:string=''):boolean;
73 | procedure setIconFile(fn:string);
74 | procedure updateHandle(handle:HWND);
75 | end; // TmyTrayIcon
76 |
77 | implementation
78 |
79 | var
80 | maxTipLength: integer;
81 |
82 | constructor TmyTrayIcon.create(form:Tform);
83 | begin
84 | with icondata do
85 | begin
86 | uCallbackMessage := WM_TRAY;
87 | cbSize := sizeof(icondata);
88 | Wnd := classes.AllocateHWnd(wndproc);
89 | uID := 1;
90 | uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
91 | uVersion:=3;
92 | end;
93 | setIcon(application.icon);
94 | setTip(application.title);
95 | end; // create
96 |
97 | destructor TmyTrayIcon.destroy;
98 | begin
99 | classes.DeallocateHWnd(icondata.wnd);
100 | hide;
101 | end;
102 |
103 | procedure TmyTrayIcon.updateHandle(handle:HWND);
104 | begin
105 | if not shown then
106 | begin
107 | icondata.wnd:=handle;
108 | exit;
109 | end;
110 | hide;
111 | icondata.wnd:=handle;
112 | Shell_NotifyIcon(NIM_ADD, @icondata)
113 | end;
114 |
115 | procedure TmyTrayIcon.update();
116 | begin
117 | if shown then
118 | if not Shell_NotifyIconW(NIM_MODIFY, @icondata) then
119 | Shell_NotifyIconW(NIM_ADD, @icondata);
120 | end; { update }
121 |
122 | procedure TmyTrayIcon.setIcon(icon:Ticon);
123 | begin
124 | if icon=NIL then exit;
125 | icondata.hIcon:=icon.handle;
126 | update();
127 | end; { setIcon }
128 |
129 | procedure TmyTrayIcon.setIconFile(fn:string);
130 | var
131 | ico:Ticon;
132 | begin
133 | ico:=Ticon.create;
134 | try
135 | ico.loadFromFile(fn);
136 | setIcon(ico);
137 | finally ico.free end; // is this ok, or should we ensure the system resource is not deallocated?
138 | end; // setIconFile
139 |
140 | procedure TmyTrayIcon.setTip(s:string);
141 | begin
142 | s:=stringReplace(s,'&','&&',[rfReplaceAll]);
143 | if length(s) > maxTipLength then setlength(s,maxTipLength);
144 | if string(icondata.szTip) = s then exit;
145 | strPLCopy(icondata.szTip, s, sizeOf(icondata.szTip)-1);
146 | update();
147 | end; // setTip
148 |
149 | procedure TmyTrayIcon.minimize();
150 | begin
151 | show();
152 | Application.ShowMainForm := False;
153 | // Toolwindows dont have a TaskIcon. (Remove if TaskIcon is to be show when form is visible)
154 | SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
155 | end; // minimizeToTray
156 |
157 | procedure TmyTrayIcon.show();
158 | begin
159 | if shown then exit;
160 | shown:=true;
161 | Shell_NotifyIcon(NIM_ADD, @icondata);
162 | Shell_NotifyIcon(NIM_SETVERSION, @iconData);
163 | end; // show
164 |
165 | procedure TmyTrayIcon.hide();
166 | begin
167 | if not shown then exit;
168 | shown:=FALSE;
169 | Shell_NotifyIcon(NIM_DELETE, @icondata);
170 | end; // hide
171 |
172 | procedure TmyTrayIcon.wndproc(var Message: TMessage);
173 | begin
174 | case message.msg of
175 | WM_TRAY:
176 | case message.lParam of
177 | WM_RBUTTONUP: notify(TE_RCLICK);
178 | WM_LBUTTONUP: notify(TE_CLICK);
179 | WM_LBUTTONDBLCLK: notify(TE_2CLICK);
180 | end;
181 | WM_QUERYENDSESSION:
182 | message.result := 1;
183 | WM_ENDSESSION:
184 | if TWmEndSession(Message).endSession then
185 | hide();
186 | NIN_BALLOONHIDE,
187 | NIN_BALLOONTIMEOUT:
188 | icondata.uFlags := icondata.uFlags and not NIF_INFO;
189 | end;
190 | message.result:=1;
191 | end;
192 |
193 | procedure TmyTrayIcon.notify(ev:TtrayEvent);
194 | begin if assigned(onEvent) then onEvent(self, ev) end;
195 |
196 | function TmyTrayIcon.balloon(msg:string; secondsTimeout:real; kind:TtrayMessageType; title:string):boolean;
197 | begin
198 | case kind of
199 | TM_WARNING: icondata.dwInfoFlags:=NIIF_WARNING;
200 | TM_ERROR: icondata.dwInfoFlags:=NIIF_ERROR;
201 | TM_INFO: icondata.dwInfoFlags:=NIIF_INFO;
202 | else icondata.dwInfoFlags:=NIIF_NONE;
203 | end;
204 | strPLCopy(icondata.szInfo, msg, sizeOf(icondata.szInfo)-1);
205 | strPLCopy(icondata.szInfoTitle, title, sizeOf(icondata.szInfoTitle)-1);
206 | icondata.uVersion:=round(secondsTimeout*1000);
207 | icondata.uFlags := icondata.uFlags or NIF_INFO;
208 | update();
209 | icondata.uFlags := icondata.uFlags and not NIF_INFO;
210 | result:=TRUE;
211 | end; // balloon
212 |
213 | INITIALIZATION
214 | if byte(getVersion()) < 5 then maxTipLength:=63
215 | else maxTipLength:=127;
216 |
217 | end.
218 |
--------------------------------------------------------------------------------