home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / misc.swg / 0039_Various Cool Routines.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-25  |  7.5 KB  |  223 lines
  1. {
  2.  After looking around through some of my routines, I found a few that were
  3.  generic enough that they might be of use to the rest of ya.
  4.  
  5.  My only request is that if you modify them and make them any cooler than
  6.  they already are -- send me back a copy.  Oh -- yeah -- and if you use
  7.  them in your programs give me credit, or at least a registered copy. :)
  8.  
  9.  Here's a brief rundown of these routines:
  10.  
  11.  proc SeqRen -        renames a file, keep a certain number of backups.
  12.                       EG: When you download a file, and one already exists,
  13.                       it renames them. Only thing is, that this keeps them
  14.                       in age order. :)
  15.  
  16.  func Filetype -      determines the type of a file.  Right now, it only
  17.                       knows about ZIP, ARJ, LHA, EXE and GIF files.  If you
  18.                       can expand on this, feel free - and make sure you
  19.                       mail me back a copy of the new ones!  :)
  20.  
  21.  func FileExistWild - takes a wildcard filename and determines if any files
  22.                       matching that spec are present.  (Eg: *.EXE)  The
  23.                       filename doesn't even have to be a wildcard, so you
  24.                       could use this as a generic function to see if a file
  25.                       exists or not.
  26.  
  27.  func SizeFile -      takes a filename as input, and if the file exists, it
  28.                       returns the size of the file.  Returns -1 if file
  29.                       does not exist.
  30.  
  31.  funct SwtVal -       returns the value of a command line switch.  For
  32.                       example, on a 'comms' (I hate that) program you might
  33.                       want to be able to specify an alternate COM: port on
  34.                       the command line. With this routine you could do that
  35.                       easily, just check for SwtVal('/COM:').  If the
  36.                       result is anything other than an empty string, then
  37.                       that is the value.  You can specify multiple words
  38.                       per command line parameter by replacing the spaces
  39.                       with underscores ('_').
  40.  
  41.  func StatusBar -     You've all seen those programs which display those
  42.                       nifty progress bars as they do things.  Now you can
  43.                       do it too! Simply call this with the total number of
  44.                       items (eg: the file size say 10 records for example)
  45.                       and the current item (eg: record 4 out of 10 records)
  46.                       and StatusBar will return a demi-hi-res progress bar
  47.                       as a string. :)
  48.  
  49.  func EraseFiles -    Erases all the files in with a filespec matching the
  50.                       one it is passed.  Example: EraseFiles('*.BAK') would
  51.                       delete all files with the .BAK extension in the
  52.                       current directory.
  53. }
  54.  
  55. procedure SeqRen(Fn : string; Max : byte);
  56. { Sequentially rename file Fn, keeping Max number of files }
  57. var idx, rn : byte;
  58.     sfn, efn, ofn : string;
  59.     Rend, whole : boolean;
  60.     f : file;
  61.  
  62.   function Merge(st:string; ln:longint):string;
  63.   var tmp : string;
  64.   begin
  65.     tmp:=Long2Str(ln);
  66.     if length(tmp)>1 then
  67.     begin
  68.       st[length(st)-1]:=tmp[1];
  69.       st[length(st)]:=tmp[2];
  70.     end
  71.       else
  72.     st[length(st)]:=tmp[1];
  73.     Merge:=St;
  74.   end;
  75.  
  76. begin
  77.   Rend:=false;whole:=false;idx:=0;    { Set up variables             }
  78.  
  79.   If pos('.',fn)>0 then               { Disect the filename          }
  80.   begin
  81.     sfn:=copy(fn,1,pos('.',fn)-1);
  82.     efn:=copy(fn,pos('.',fn)+1,length(fn));
  83.   end
  84.     ELSE
  85.   whole:=true;
  86.   repeat
  87.     Inc(idx);
  88.     if not ExistFile(sfn+'.'+Merge(efn, idx)) then rend:=true;
  89.   until (idx=max) or Rend;
  90.  
  91.   if (idx=max) and (rend=false) then      { Nope?  Okay, no problem.     }
  92.   begin
  93.     Assign(f,sfn+'.'+Merge(efn, max));    { Rename all oldies and make   }
  94.     Erase(f);                             { room for it as number 1      }
  95.     for idx:=(max-1) downto 1 do
  96.     begin
  97.       Assign(f,sfn+'.'+Merge(efn, idx));
  98.       Rename(f,sfn+'.'+Merge(efn, idx+1));
  99.     end;
  100.     rn:=1;
  101.   end;
  102.  
  103.   if rend then rn:=idx;
  104.  
  105.   Assign(f,fn);                       { Rename the requested file!   }
  106.   Rename(f,sfn+'.'+Merge(efn, rn));
  107. end;
  108.  
  109. Type FileIDType = (fEXE, fZIP, fARJ, fLHA, fGIF87);
  110.  
  111. function FileType(Filename : string) : FileIDType;
  112. { This function attempts to identify what type of a file Filename is }
  113. var Infile : file;
  114.     IdBytes : Array[1..10] of char;
  115.     SubId : string;
  116. begin
  117.   FileType := fUnknown;
  118.   If NOT ExistFile(FileName) then Exit;
  119.   Assign(Infile, FileName);
  120.   Reset(Infile, 1);
  121.   If (FileSize(Infile) = 0) then
  122.   begin
  123.     Close(Infile);
  124.     Exit;
  125.   end;
  126.   BlockRead(Infile, IDBytes, 10);
  127.   Close(Infile);
  128.   SubId := Copy(IDBytes, 1, 2);
  129.   If (SubID = 'MZ') then FileType := fEXE
  130.     ELSE
  131.   If (SubID = 'PK') then FileType := fZIP
  132.     ELSE
  133.   if (SubID = #96 + #234) then FileType := fARJ
  134.     ELSE
  135.   If (Copy(IDBytes, 3, 5) = '-lh5-') then FileType := fLHA
  136.     ELSE
  137.   If (Copy(IDBytes, 3, 5) = '-lh1-') then FileType := fLHA
  138.     ELSE
  139.   if (Copy(IDbytes, 1, 5) = 'GIF89a') then FileType := fGIF87;
  140. end;
  141.  
  142. function  FileExistWild(Mask : string) : boolean;      { Does X*.* exist? :) }
  143. var sr : SearchRec;
  144. begin
  145.   FindFirst(Mask, AnyFile, SR);
  146.   If DosError<>18 then
  147.     FileExistWild := TRUE
  148.       ELSE
  149.     FileExistWild := FALSE;
  150. end;
  151.  
  152. Function SizeFile(Fname : string) : longint;
  153. var  sr : SearchRec;
  154.      idx : integer;
  155. begin
  156.   SizeFile := 0;
  157.   Findfirst(Fname, Anyfile, SR);
  158.   If DosError = 0 then SizeFile := SR.Size ELSE SizeFile := -1;
  159. end;
  160.  
  161. function SwtVal(Swt : string) : string;
  162. { Returns the value of a command line switch. Eg: for /COM:2, call
  163.   SwtVal('/COM2:') and it will return 2. }
  164. var ndx, found : byte;
  165.     st : string;
  166. begin
  167.   Found := 0;
  168.   For ndx := 1 to ParamCount do
  169.   begin
  170.     if StUpCase(copy(paramstr(ndx), 1, length(swt))) = StUpCase(swt) then
  171.     begin
  172.       Found := ndx;
  173.       Break;
  174.     end;
  175.   end;
  176.   if (Found = 0) then
  177.   begin
  178.     swtval := '';
  179.     Exit;
  180.   end;
  181.   st := '';
  182.   st := StUpCase(Copy(ParamStr(Found), Length(Swt) + 1,
  183.                  Length(ParamStr(Found)) - Length(Swt)));
  184.   For ndx := 1 to Length(St) do
  185.     if (St[ndx] = '_') then St[ndx] := #32;
  186.   SwtVal := st;
  187. end;
  188.  
  189. Function StatusBar(total, amt : longint) : string;
  190. Const BarLength = 40;
  191. var a, b, c, d : longint;
  192.     percent : real;
  193.     st : string;
  194. begin
  195.   If (total = 0) OR (amt = 0) then
  196.   begin
  197.     StatusBar := '';
  198.     Exit;
  199.   end;
  200.   if (Amt > Total) then amt := total;
  201.   Percent := Amt / Total * (Barlength * 10);
  202.   a := trunc(percent);
  203.   b := a div 10;
  204.   c := 1;
  205.   percent := amt / total * 100;
  206.   d := trunc(percent);
  207.   st := ' (' + int_to_str(d) + '%)';
  208.   StatusBar := CharStr(b * c, #219) + CharStr(Barlength - (b * c), #176) + st;
  209. end;
  210.  
  211. function EraseFiles(Path, Mask : string) : integer;
  212. var S : SearchRec;
  213. begin
  214.   FindFirst(Path + Mask, Anyfile - Directory, s);      { Find the first file }
  215.   If (DosError = 18) then exit;                          { No files to erase }
  216.   KillFile(Path + s.name);                            { Erase the first file }
  217.   repeat
  218.     Findnext(s);                                        { Find the next file }
  219.     If NOT (DOSError=18) then KillFile(Path + s.name);      { Erase the file }
  220.   until Doserror=18;                                         { no more files }
  221.   EraseFiles := IOResult;                             { Return the IO result }
  222. end;
  223.