~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/aggpas/src/platform/win/file_utils_.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
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 }
31
 
 function  cut_str(s : shortstring ) : shortstring;
32
 
 function  up_str (s : shortstring ) : shortstring;
33
 
 function  cmp_str(s : shortstring ) : shortstring;
34
 
 
35
 
 function  str_dir(s : shortstring ) : shortstring;
36
 
 function  dir_str(s : shortstring ) : shortstring;
37
 
 
38
 
 function  str_disk(fn : shortstring ) : shortstring;
39
 
 function  str_path(fn : shortstring ) : shortstring;
40
 
 function  str_name(fn : shortstring ) : shortstring;
41
 
 function  str_ext (fn : shortstring ) : shortstring;
42
 
 
43
 
 function  fold_name  (p ,n ,x : shortstring ) : shortstring;
44
 
 procedure spread_name(fn : shortstring; var p ,n ,x : shortstring );
45
 
 
46
 
 function  file_exists(fn : shortstring ) : boolean;
47
 
 
48
 
 function  api_open_file (var af : api_file; fname : shortstring ) : boolean;
49
 
 function  api_read_file (var af : api_file; buff : pointer; aloc : int; var read : int ) : boolean;
50
 
 function  api_close_file(var af : api_file ) : boolean;
51
 
 
52
 
 function  param_count : int;
53
 
 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 }
102
 
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 }
136
 
function cmp_str;
137
 
begin
138
 
 cmp_str:=up_str(cut_str(s ) );
139
 
 
140
 
end;
141
 
 
142
 
{ UP_STR }
143
 
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 }
158
 
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 }
171
 
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 }
184
 
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 }
282
 
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 }
370
 
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 }
550
 
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 }
642
 
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 }
669
 
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 }
690
 
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 }
718
 
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 }
745
 
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 }
762
 
function param_count;
763
 
begin
764
 
 result:=ParamCount;
765
 
 
766
 
end;
767
 
 
768
 
{ PARAM_STR }
769
 
function param_str;
770
 
begin
771
 
 result:=ParamStr(i );
772
 
 
773
 
end;
774
 
 
775
 
END.
776