home *** CD-ROM | disk | FTP | other *** search
/ Action Games (2008) / akcnihry1.iso / AT-Robots 2.10 / FILELIB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-04-27  |  6.3 KB  |  273 lines
  1. (*
  2. Copyright (c) 1999, Ed T. Toton III. All rights reserved.
  3.  
  4. Redistribution and use in source and binary forms, with or without
  5. modification, are permitted provided that the following conditions
  6. are met:
  7.  
  8.    Redistributions of source code must retain the above copyright notice,
  9.    this list of conditions and the following disclaimer.
  10.  
  11.    Redistributions in binary form must reproduce the above copyright notice, 
  12.    this list of conditions and the following disclaimer in the documentation
  13.    and/or other materials provided with the distribution.
  14.  
  15.    All advertising materials mentioning features or use of this software
  16.    must display the following acknowledgement:
  17.  
  18.         This product includes software developed by Ed T. Toton III &
  19.         NecroBones Enterprises.
  20.  
  21.    No modified or derivative copies or software may be distributed in the
  22.    guise of official or original releases/versions of this software. Such
  23.    works must contain acknowledgement that it is modified from the original.
  24.  
  25.    Neither the name of the author nor the name of the business or
  26.    contributers may be used to endorse or promote products derived
  27.    from this software without specific prior written permission.
  28.  
  29. THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY 
  30. EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 
  31. WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  32. DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY
  33. DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  34. (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  35. LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  36. ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  37. (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  38. THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  39. *)
  40.  
  41. { This unit contains functions useful for dealing with filenames. }
  42.  
  43. {$G+}{$N+}{$E+}{$X+}{$D-}{$S-}{$V-}
  44. Unit fileLib;
  45.  
  46. INTERFACE
  47.  
  48. Uses
  49.   Dos;
  50.  
  51.  
  52.   Function EXIST(thisfile : pathstr) : boolean;
  53.   Function VALID(thisfile : pathstr) : boolean;
  54.   Function name_form(name:string):string;
  55.   function exten(name:string):string;
  56.   function base_name(name:string):string;
  57.   Function attribs(b:byte):string;
  58.   function path(fn:string):string;
  59.   function no_path(fn:string):string;
  60.   function file_length(fn:string):longint;
  61.  
  62. IMPLEMENTATION
  63.  
  64. Const
  65.   null  = #0;
  66.   bell  = #7;
  67.   esc   = #27;
  68.   f10   = #$44; {scan code}
  69.   basex : byte = 1;
  70.   basey : byte = 1;
  71.   tempx : byte = 1;
  72.   tempy : byte = 1;
  73.   endx  : byte = 24;
  74.   endy  : byte = 80;
  75.  
  76. Var
  77.   regs        : registers;
  78.   textattr    : word;
  79.   workstr     : string;
  80.  
  81.  
  82. Function addfront(b:string;l:integer): string;
  83. Begin
  84.   while length(b)< l do
  85.     b := ' '+b;
  86.   addfront := b;
  87. End;
  88.  
  89. Function addrear(b:string;l:integer): string;
  90. Begin
  91.   while length(b)< l do
  92.     b := b+' ';
  93.   addrear := b;
  94. End;
  95.  
  96. function lstr(s1:string; l:integer):string;
  97. begin
  98.  if length(s1)<=l then lstr:=s1
  99.  else lstr:=copy(s1,1,l);
  100. end;
  101.  
  102. function rstr(s1:string; l:integer):string;
  103. begin
  104.  if length(s1)<=l then rstr:=s1
  105.  else rstr:=copy(s1,length(s1)-l+1,l);
  106. end;
  107.  
  108.  
  109. Function EXIST(thisfile : pathstr) : boolean;
  110.   var
  111.     afile : file;
  112.     iocode : word;
  113.  
  114.   begin {* fExist *}
  115.     assign(afile,thisfile);
  116.     {$I-}
  117.     reset(afile);
  118.     iocode := ioresult;
  119.     {$I+}
  120.     Exist := (iocode = 0);
  121.     if iocode = 0 then close(afile);
  122.   end;  {* fExist *}
  123.  
  124. Function VALID(thisfile : pathstr) : boolean;
  125.   Var
  126.     afile : file;
  127.     check : boolean;
  128.     iocode : word;
  129.  
  130.   begin {* fValid *}
  131.     if not Exist(thisfile) then
  132.       begin
  133.         assign(afile,thisfile);
  134.         {$I-}
  135.         rewrite(afile);
  136.         close(afile);
  137.         erase(afile);
  138.         {$I+}
  139.         iocode := ioresult;
  140.         Valid := (iocode = 0)
  141.       end
  142.     else Valid := true
  143.   end;  {* fValid *}
  144.  
  145. Function name_form(name:string):string;
  146. var
  147.  i,j,k,l:integer;
  148.  s1,s2,s3:string;
  149. begin
  150.  s1:=''; s2:='';
  151.  k:=1;
  152.  if (name='.') or (name='..') then
  153.   begin
  154.    name_form:=addrear(name,12);
  155.    exit;
  156.   end;
  157.  while (k<=length(name)) and (name[k]<>'.') do
  158.   begin
  159.    s1:=s1+name[k];
  160.    inc(k);
  161.   end;
  162.  if k<length(name) then
  163.   begin
  164.    inc(k);
  165.    while (k<=length(name)) and (name[k]<>'.') do
  166.     begin
  167.      s2:=s2+name[k];
  168.      inc(k);
  169.     end;
  170.   end;
  171.  name_form:=addrear(s1,9)+addrear(s2,3);
  172. end;
  173.  
  174. function exten(name:string):string;
  175. var
  176.  i,j,k,l:integer;
  177.  s1,s2,s3:string;
  178. begin
  179.  s1:=''; s2:='';
  180.  k:=1;
  181.  while (k<=length(name)) and (name[k]<>'.') do
  182.   begin
  183.    s1:=s1+name[k];
  184.    inc(k);
  185.   end;
  186.  if k<length(name) then
  187.   begin
  188.    inc(k);
  189.    while (k<=length(name)) and (name[k]<>'.') do
  190.     begin
  191.      s2:=s2+name[k];
  192.      inc(k);
  193.     end;
  194.   end;
  195.  exten:=addrear(s2,3);
  196. end;
  197.  
  198.  
  199. function base_name(name:string):string;
  200. var
  201.  i,j,k,l:integer;
  202.  s1,s2,s3:string;
  203. begin
  204.  s1:=''; s2:='';
  205.  k:=1;
  206.  while (k<=length(name)) and (name[k]<>'.') do
  207.   begin
  208.    s1:=s1+name[k];
  209.    inc(k);
  210.   end;
  211.  base_name:=s1;
  212. end;
  213.  
  214. Function attribs(b:byte):string;
  215. {const
  216.    ReadOnly = $01;
  217.    Hidden   = $02;
  218.    SysFile  = $04;
  219.    VolumeID = $08;
  220.    Directory= $10;
  221.    Archive  = $20;
  222.    AnyFile  = $3F;}
  223. var
  224. s1:string[8];
  225. begin
  226.  s1:=' ';
  227.  if (b and readonly)<>0  then s1:=s1+'R' else s1:=s1+'.';
  228.  if (b and hidden  )<>0  then s1:=s1+'H' else s1:=s1+'.';
  229.  if (b and sysfile )<>0  then s1:=s1+'S' else s1:=s1+'.';
  230.  if (b and archive )<>0  then s1:=s1+'A' else s1:=s1+'.';
  231.  attribs:=s1;
  232. end;
  233.  
  234. function path(fn:string):string;
  235. var
  236.  i,k:integer;
  237. begin
  238.  k:=0;
  239.  for i:=length(fn) downto 1 do
  240.   begin
  241.    if ((fn[i]='\') or (fn[i]=':')) and (k<i) then k:=i;
  242.   end;
  243.  if k<>0 then
  244.    path:=lstr(fn,k)
  245.   else
  246.    path:='';
  247. end;
  248.  
  249. function no_path(fn:string):string;
  250. var
  251.  i,k:integer;
  252. begin
  253.  k:=0;
  254.  for i:=length(fn) downto 1 do
  255.   begin
  256.    if ((fn[i]='\') or (fn[i]=':')) and (k<i) then k:=i;
  257.   end;
  258.  if k<>0 then
  259.    no_path:=rstr(fn,length(fn)-k)
  260.   else
  261.    no_path:=fn;
  262. end;
  263.  
  264. function file_length(fn:string):longint;
  265. var
  266.  sr:searchrec;
  267. begin
  268.  findfirst(fn,archive,sr);
  269.  if doserror=0 then file_length:=sr.size
  270.                else file_length:=0;
  271. end;
  272.  
  273. end. Unit