1 //
2 // AggPas 2.4 RM3 demo framework file utility library
3 // Milan Marusinec alias Milano (c) 2006
4 //
5 unit
6 file_utils_ ;
7
8 INTERFACE
9
10 {$I agg_mode.inc }
11 {$I- }
12 uses
13 agg_basics ;
14
15 { TYPES DEFINITION }
16 type
17 api_file_ptr = ^api_file;
18 api_file = record
19 fileName : shortstring;
20 isOpened : boolean;
21
22 fSize ,
23 fRead : int;
24
25 // FSOpenFork parameters
26 df : file;
27
28 end;
29
30 { GLOBAL PROCEDURES }
cut_strnull31 function cut_str(s : shortstring ) : shortstring;
up_strnull32 function up_str (s : shortstring ) : shortstring;
cmp_strnull33 function cmp_str(s : shortstring ) : shortstring;
34
str_dirnull35 function str_dir(s : shortstring ) : shortstring;
dir_strnull36 function dir_str(s : shortstring ) : shortstring;
37
str_disknull38 function str_disk(fn : shortstring ) : shortstring;
str_pathnull39 function str_path(fn : shortstring ) : shortstring;
str_namenull40 function str_name(fn : shortstring ) : shortstring;
str_extnull41 function str_ext (fn : shortstring ) : shortstring;
42
fold_namenull43 function fold_name (p ,n ,x : shortstring ) : shortstring;
44 procedure spread_name(fn : shortstring; var p ,n ,x : shortstring );
45
file_existsnull46 function file_exists(fn : shortstring ) : boolean;
47
api_open_filenull48 function api_open_file (var af : api_file; fname : shortstring ) : boolean;
api_read_filenull49 function api_read_file (var af : api_file; buff : pointer; aloc : int; var read : int ) : boolean;
api_close_filenull50 function api_close_file(var af : api_file ) : boolean;
51
param_countnull52 function param_count : int;
param_strnull53 function param_str(i : int ) : shortstring;
54
55
56 IMPLEMENTATION
57 { LOCAL VARIABLES & CONSTANTS }
58 type
59 tSCAN = (
60
61 SCAN_0 ,
62 SCAN_1 ,SCAN_2 ,SCAN_3 ,SCAN_4 ,SCAN_5 ,SCAN_6 ,SCAN_7 ,SCAN_8 ,SCAN_9 ,
63 SCAN_A ,SCAN_B ,SCAN_C ,SCAN_D ,SCAN_E ,SCAN_F ,SCAN_G ,SCAN_H ,SCAN_I ,
64 SCAN_J ,SCAN_K ,SCAN_L ,SCAN_M ,SCAN_N ,SCAN_O ,SCAN_P ,SCAN_Q ,SCAN_R ,
65 SCAN_S ,SCAN_T ,SCAN_U ,SCAN_V ,SCAN_W ,SCAN_X ,SCAN_Y ,SCAN_Z
66
67 );
68
69 tITEM = (
70
71 ITEM_0 ,
72 ITEM_1 ,ITEM_2 ,ITEM_3 ,ITEM_4 ,ITEM_5 ,ITEM_6 ,ITEM_7 ,ITEM_8 ,ITEM_9 ,
73 ITEM_A ,ITEM_B ,ITEM_C ,ITEM_D ,ITEM_E ,ITEM_F ,ITEM_G ,ITEM_H ,ITEM_I ,
74 ITEM_J ,ITEM_K ,ITEM_L ,ITEM_M ,ITEM_N ,ITEM_O ,ITEM_P ,ITEM_Q ,ITEM_R ,
75 ITEM_S ,ITEM_T ,ITEM_U ,ITEM_V ,ITEM_W ,ITEM_X ,ITEM_Y ,ITEM_Z
76
77 );
78
79 const
80 dir_slash = '/';
81
82 pageEqHigh : shortstring =
83 #1#2#3#4#5#6#7#8#9#10#11#12#13#14#15#16 +
84 #17#18#19#20#21#22#23#24#25#26#27#28#29#30#31#32 +
85 #33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48 +
86 #49#50#51#52#53#54#55#56#57#58#59#60#61#62#63#64 +
87 #65#66#67#68#69#70#71#72#73#74#75#76#77#78#79#80 +
88 #81#82#83#84#85#86#87#88#89#90#91#92#93#94#95#96 +
89 #65#66#67#68#69#70#71#72#73#74#75#76#77#78#79#80 +
90 #81#82#83#84#85#86#87#88#89#90#123#124#125#126#127#128 +
91 #129#130#131#132#133#134#135#136#137#138#139#140#141#142#143#144 +
92 #145#146#147#148#149#150#151#152#153#154#155#156#157#158#159#160 +
93 #161#162#163#164#165#166#167#168#169#170#171#172#173#174#175#176 +
94 #177#178#179#180#181#182#183#184#185#186#187#188#189#190#191#192 +
95 #193#194#195#196#197#198#199#200#201#202#203#204#205#206#207#208 +
96 #209#210#211#212#213#214#215#216#217#218#219#220#221#222#223#224 +
97 #225#226#227#228#229#230#231#232#233#234#235#236#237#238#239#240 +
98 #241#242#243#244#245#246#247#248#249#250#251#252#253#254#255;
99
100 { UNIT IMPLEMENTATION }
101 { CUT_STR }
cut_strnull102 function cut_str;
103 var
104 fcb : byte;
105 scn : tSCAN;
106
107 begin
108 result:='';
109
110 scn:=SCAN_1;
111
112 if length(s ) > 0 then
113 for fcb:=length(s ) downto 1 do
114 case scn of
115 SCAN_1 :
116 case s[fcb ] of
117 ' ' :
118 else
119 begin
120 result:=s[fcb ];
121
122 scn:=SCAN_2;
123
124 end;
125
126 end;
127
128 SCAN_2 :
129 result:=s[fcb ] + result;
130
131 end;
132
133 end;
134
135 { CMP_STR }
cmp_strnull136 function cmp_str;
137 begin
138 cmp_str:=up_str(cut_str(s ) );
139
140 end;
141
142 { UP_STR }
up_strnull143 function up_str;
144 var
145 fcb : byte;
146
147 begin
148 if length(s ) > 0 then
149 for fcb:=1 to length(s ) do
150 if byte(s[fcb ] ) > 0 then
151 s[fcb ]:=pageEqHigh[byte(s[fcb ] ) ];
152
153 result:=s;
154
155 end;
156
157 { STR_DIR }
str_dirnull158 function str_dir;
159 begin
160 s:=cut_str(s );
161
162 if length(s ) > 0 then
163 if s[length(s ) ] <> dir_slash then
164 s:=s + dir_slash;
165
166 result:=s;
167
168 end;
169
170 { DIR_STR }
dir_strnull171 function dir_str;
172 begin
173 s:=cut_str(s );
174
175 if length(s ) > 0 then
176 if s[length(s ) ] = dir_slash then
177 dec(byte(s[0 ] ) );
178
179 result:=s;
180
181 end;
182
183 { STR_DISK }
str_disknull184 function str_disk;
185 var
186 fcb : byte;
187 str : shortstring;
188 itm : tITEM;
189
190 begin
191 str:='';
192 itm:=ITEM_1;
193
194 if length(fn ) > 0 then
195 for fcb:=1 to length(fn ) do
196 case itm of
197 ITEM_1 :
198 case fn[fcb ] of
199 'a'..'z' ,'A'..'Z' :
200 begin
201 str:=fn[fcb ];
202 itm:=ITEM_2;
203
204 end;
205
206 '\' ,'/' :
207 begin
208 str:=fn[fcb ];
209 itm:=ITEM_3;
210
211 end;
212
213 else
214 break;
215
216 end;
217
218 ITEM_2 :
219 case fn[fcb ] of
220 ':' :
221 begin
222 str:=str + fn[fcb ];
223 itm:=ITEM_F;
224
225 break;
226
227 end;
228
229 else
230 break;
231
232 end;
233
234 ITEM_3 :
235 case fn[fcb ] of
236 '\' ,'/' :
237 begin
238 str:=str + fn[fcb ];
239 itm:=ITEM_4;
240
241 end;
242
243 else
244 break;
245
246 end;
247
248 ITEM_4 :
249 case fn[fcb ] of
250 '\' ,'/' ,':' ,'<' ,'>' ,'.' ,'"' ,'|' ,#0..#31 :
251 break;
252
253 else
254 begin
255 str:=str + fn[fcb ];
256 itm:=ITEM_F;
257
258 end;
259
260 end;
261
262 ITEM_F :
263 case fn[fcb ] of
264 '\' ,'/' :
265 break;
266
267 else
268 str:=str + fn[fcb ];
269
270 end;
271
272 end;
273
274 if itm = ITEM_F then
275 result:=str
276 else
277 result:='';
278
279 end;
280
281 { STR_PATH }
str_pathnull282 function str_path;
283 var
284 fcb : byte;
285 pth ,
286 str : shortstring;
287 itm : tITEM;
288
289 begin
290 pth:='';
291 str:='';
292 itm:=ITEM_1;
293
294 if length(fn ) > 0 then
295 for fcb:=1 to length(fn ) do
296 case itm of
297 ITEM_1 :
298 case fn[fcb ] of
299 '\' ,'/' :
300 begin
301 str:=fn[fcb ];
302 itm:=ITEM_2;
303
304 end;
305
306 else
307 begin
308 str:=fn[fcb ];
309 itm:=ITEM_3;
310
311 end;
312
313 end;
314
315 ITEM_2 :
316 case fn[fcb ] of
317 '\' ,'/' :
318 begin
319 str:=str + fn[fcb ];
320 itm:=ITEM_3;
321
322 end;
323
324 else
325 begin
326 pth:=str;
327 str:=fn[fcb ];
328 itm:=ITEM_A;
329
330 end;
331
332 end;
333
334 ITEM_3 :
335 case fn[fcb ] of
336 '\' ,'/' :
337 begin
338 pth:=fn[fcb ];
339 str:='';
340 itm:=ITEM_A;
341
342 end;
343
344 else
345 str:=str + fn[fcb ];
346
347 end;
348
349 ITEM_A :
350 case fn[fcb ] of
351 '\' ,'/' :
352 begin
353 pth:=pth + str + fn[fcb ];
354 str:='';
355
356 end;
357
358 else
359 str:=str + fn[fcb ];
360
361 end;
362
363 end;
364
365 result:=pth;
366
367 end;
368
369 { STR_NAME }
str_namenull370 function str_name;
371 var
372 fcb : byte;
373 str ,
374 ext : shortstring;
375 itm : tITEM;
376
377 begin
378 str:='';
379 ext:='';
380 itm:=ITEM_1;
381
382 if length(fn ) > 0 then
383 for fcb:=1 to length(fn ) do
384 case itm of
385 ITEM_1 :
386 case fn[fcb ] of
387 '\' ,'/' :
388 itm:=ITEM_2;
389
390 'a'..'z' ,'A'..'Z' :
391 begin
392 ext:=fn[fcb ];
393 itm:=ITEM_4;
394
395 end;
396
397 '.' :
398 begin
399 str:='';
400 ext:=fn[fcb ];
401 itm:=ITEM_B;
402
403 end;
404
405 else
406 begin
407 str:=fn[fcb ];
408 itm:=ITEM_A;
409
410 end;
411
412 end;
413
414 ITEM_2 :
415 case fn[fcb ] of
416 '\' ,'/' :
417 itm:=ITEM_3;
418
419 '.' :
420 begin
421 str:='';
422 ext:=fn[fcb ];
423 itm:=ITEM_B;
424
425 end;
426
427 else
428 begin
429 str:=fn[fcb ];
430 itm:=ITEM_A;
431
432 end;
433
434 end;
435
436 ITEM_3 :
437 case fn[fcb ] of
438 '\' ,'/' :
439 begin
440 str:='';
441 itm:=ITEM_A;
442
443 end;
444
445 end;
446
447 ITEM_4 :
448 case fn[fcb ] of
449 '\' ,'/' :
450 begin
451 str:='';
452 itm:=ITEM_A;
453
454 end;
455
456 ':' :
457 itm:=ITEM_5;
458
459 '.' :
460 begin
461 str:=ext;
462 ext:=fn[fcb ];
463 itm:=ITEM_B;
464
465 end;
466
467 else
468 begin
469 str:=ext + fn[fcb ];
470 ext:='';
471 itm:=ITEM_A;
472
473 end;
474
475 end;
476
477 ITEM_5 :
478 case fn[fcb ] of
479 '\' ,'/' :
480 begin
481 str:='';
482 itm:=ITEM_A;
483
484 end;
485
486 '.' :
487 begin
488 str:='';
489 ext:=fn[fcb ];
490 itm:=ITEM_B;
491
492 end;
493
494 else
495 begin
496 str:=fn[fcb ];
497 itm:=ITEM_A;
498
499 end;
500
501 end;
502
503 ITEM_A :
504 case fn[fcb ] of
505 '\' ,'/' :
506 begin
507 str:='';
508 ext:='';
509
510 end;
511
512 '.' :
513 begin
514 ext:=fn[fcb ];
515 itm:=ITEM_B;
516
517 end;
518
519 else
520 str:=str + fn[fcb ];
521
522 end;
523
524 ITEM_B :
525 case fn[fcb ] of
526 '\' ,'/' :
527 begin
528 str:='';
529 ext:='';
530 itm:=ITEM_A;
531
532 end;
533
534 '.' :
535 begin
536 str:=str + ext;
537 ext:=fn[fcb ];
538
539 end;
540
541 end;
542
543 end;
544
545 result:=str;
546
547 end;
548
549 { STR_EXT }
str_extnull550 function str_ext;
551 var
552 fcb : byte;
553 ext : shortstring;
554 itm : tITEM;
555
556 begin
557 ext:='';
558 itm:=ITEM_1;
559
560 if length(fn ) > 0 then
561 for fcb:=1 to length(fn ) do
562 case itm of
563 ITEM_1 :
564 case fn[fcb ] of
565 '\' ,'/' :
566 itm:=ITEM_2;
567
568 '.' :
569 begin
570 ext:=fn[fcb ];
571 itm:=ITEM_B;
572
573 end;
574
575 else
576 itm:=ITEM_A;
577
578 end;
579
580 ITEM_2 :
581 case fn[fcb ] of
582 '\' ,'/' :
583 itm:=ITEM_3;
584
585 '.' :
586 begin
587 ext:=fn[fcb ];
588 itm:=ITEM_B;
589
590 end;
591
592 else
593 itm:=ITEM_A;
594
595 end;
596
597 ITEM_3 :
598 case fn[fcb ] of
599 '\' ,'/' :
600 itm:=ITEM_A;
601
602 end;
603
604 ITEM_A :
605 case fn[fcb ] of
606 '.' :
607 begin
608 ext:=fn[fcb ];
609 itm:=ITEM_B;
610
611 end;
612
613 end;
614
615 ITEM_B :
616 case fn[fcb ] of
617 '\' ,'/' :
618 begin
619 ext:='';
620 itm:=ITEM_A;
621
622 end;
623
624 '.' :
625 ext:=fn[fcb ];
626
627 else
628 ext:=ext + fn[fcb ];
629
630 end;
631
632 end;
633
634 result:=cut_str(ext );
635
636 if result = '.' then
637 result:='';
638
639 end;
640
641 { FOLD_NAME }
fold_namenull642 function fold_name;
643 var
644 dsk ,
645 nme ,
646 pth ,
647 ext : shortstring;
648
649 begin
650 dsk:=str_disk(p );
651 pth:=str_dir (str_path(p ) );
652 nme:=str_name(n );
653 ext:=str_ext (x );
654
655 result:=dsk + pth + nme + ext;
656
657 end;
658
659 { SPREAD_NAME }
660 procedure spread_name;
661 begin
662 p:=str_disk(fn ) + str_dir(str_path(fn ) );
663 n:=str_name(fn );
664 x:=str_ext (fn );
665
666 end;
667
668 { FILE_EXISTS }
file_existsnull669 function file_exists;
670 var
671 f : file;
672
673 begin
674 AssignFile(f ,fn );
675 reset (f );
676
677 if IOResult = 0 then
678 begin
679 close(f );
680
681 result:=true;
682
683 end
684 else
685 result:=false;
686
687 end;
688
689 { API_OPEN_FILE }
api_open_filenull690 function api_open_file;
691 begin
692 result:=false;
693
694 fillchar(af ,sizeof(api_file ) ,0 );
695
696 af.fileName:=fname;
697 af.isOpened:=false;
698
699 IOResult;
700
701 AssignFile(af.df ,fname );
702 reset (af.df ,1 );
703
704 if IOResult = 0 then
705 begin
706 af.isOpened:=true;
707
708 af.fSize:=filesize(af.df );
709 af.fRead:=0;
710
711 end;
712
713 result:=af.isOpened;
714
715 end;
716
717 { API_READ_FILE }
api_read_filenull718 function api_read_file;
719 begin
720 result:=false;
721 read :=0;
722
723 if af.isOpened then
724 begin
725 if aloc > af.fSize - af.fRead then
726 aloc:=af.fSize - af.fRead;
727
728 blockread(af.df ,buff^ ,aloc ,read );
729
730 if aloc = read then
731 begin
732 inc(af.fRead ,read );
733
734 result:=true;
735
736 end
737 else
738 read:=0;
739
740 end;
741
742 end;
743
744 { API_CLOSE_FILE }
api_close_filenull745 function api_close_file;
746 begin
747 result:=false;
748
749 if af.isOpened then
750 begin
751 system.close(af.df );
752
753 af.isOpened:=false;
754
755 result:=true;
756
757 end;
758
759 end;
760
761 { PARAM_COUNT }
param_countnull762 function param_count;
763 begin
764 result:=ParamCount;
765
766 end;
767
768 { PARAM_STR }
param_strnull769 function param_str;
770 begin
771 result:=ParamStr(i );
772
773 end;
774
775 END.
776
777