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