[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

{
 After looking around through some of my routines, I found a few that were
 generic enough that they might be of use to the rest of ya.

 My only request is that if you modify them and make them any cooler than
 they already are -- send me back a copy.  Oh -- yeah -- and if you use
 them in your programs give me credit, or at least a registered copy. :)

 Here's a brief rundown of these routines:

 proc SeqRen -        renames a file, keep a certain number of backups.
                      EG: When you download a file, and one already exists,
                      it renames them. Only thing is, that this keeps them
                      in age order. :)

 func Filetype -      determines the type of a file.  Right now, it only
                      knows about ZIP, ARJ, LHA, EXE and GIF files.  If you
                      can expand on this, feel free - and make sure you
                      mail me back a copy of the new ones!  :)

 func FileExistWild - takes a wildcard filename and determines if any files
                      matching that spec are present.  (Eg: *.EXE)  The
                      filename doesn't even have to be a wildcard, so you
                      could use this as a generic function to see if a file
                      exists or not.

 func SizeFile -      takes a filename as input, and if the file exists, it
                      returns the size of the file.  Returns -1 if file
                      does not exist.

 funct SwtVal -       returns the value of a command line switch.  For
                      example, on a 'comms' (I hate that) program you might
                      want to be able to specify an alternate COM: port on
                      the command line. With this routine you could do that
                      easily, just check for SwtVal('/COM:').  If the
                      result is anything other than an empty string, then
                      that is the value.  You can specify multiple words
                      per command line parameter by replacing the spaces
                      with underscores ('_').

 func StatusBar -     You've all seen those programs which display those
                      nifty progress bars as they do things.  Now you can
                      do it too! Simply call this with the total number of
                      items (eg: the file size say 10 records for example)
                      and the current item (eg: record 4 out of 10 records)
                      and StatusBar will return a demi-hi-res progress bar
                      as a string. :)

 func EraseFiles -    Erases all the files in with a filespec matching the
                      one it is passed.  Example: EraseFiles('*.BAK') would
                      delete all files with the .BAK extension in the
                      current directory.
}

procedure SeqRen(Fn : string; Max : byte);
{ Sequentially rename file Fn, keeping Max number of files }
var idx, rn : byte;
    sfn, efn, ofn : string;
    Rend, whole : boolean;
    f : file;

  function Merge(st:string; ln:longint):string;
  var tmp : string;
  begin
    tmp:=Long2Str(ln);
    if length(tmp)>1 then
    begin
      st[length(st)-1]:=tmp[1];
      st[length(st)]:=tmp[2];
    end
      else
    st[length(st)]:=tmp[1];
    Merge:=St;
  end;

begin
  Rend:=false;whole:=false;idx:=0;    { Set up variables             }

  If pos('.',fn)>0 then               { Disect the filename          }
  begin
    sfn:=copy(fn,1,pos('.',fn)-1);
    efn:=copy(fn,pos('.',fn)+1,length(fn));
  end
    ELSE
  whole:=true;
  repeat
    Inc(idx);
    if not ExistFile(sfn+'.'+Merge(efn, idx)) then rend:=true;
  until (idx=max) or Rend;

  if (idx=max) and (rend=false) then      { Nope?  Okay, no problem.     }
  begin
    Assign(f,sfn+'.'+Merge(efn, max));    { Rename all oldies and make   }
    Erase(f);                             { room for it as number 1      }
    for idx:=(max-1) downto 1 do
    begin
      Assign(f,sfn+'.'+Merge(efn, idx));
      Rename(f,sfn+'.'+Merge(efn, idx+1));
    end;
    rn:=1;
  end;

  if rend then rn:=idx;

  Assign(f,fn);                       { Rename the requested file!   }
  Rename(f,sfn+'.'+Merge(efn, rn));
end;

Type FileIDType = (fEXE, fZIP, fARJ, fLHA, fGIF87);

function FileType(Filename : string) : FileIDType;
{ This function attempts to identify what type of a file Filename is }
var Infile : file;
    IdBytes : Array[1..10] of char;
    SubId : string;
begin
  FileType := fUnknown;
  If NOT ExistFile(FileName) then Exit;
  Assign(Infile, FileName);
  Reset(Infile, 1);
  If (FileSize(Infile) = 0) then
  begin
    Close(Infile);
    Exit;
  end;
  BlockRead(Infile, IDBytes, 10);
  Close(Infile);
  SubId := Copy(IDBytes, 1, 2);
  If (SubID = 'MZ') then FileType := fEXE
    ELSE
  If (SubID = 'PK') then FileType := fZIP
    ELSE
  if (SubID = #96 + #234) then FileType := fARJ
    ELSE
  If (Copy(IDBytes, 3, 5) = '-lh5-') then FileType := fLHA
    ELSE
  If (Copy(IDBytes, 3, 5) = '-lh1-') then FileType := fLHA
    ELSE
  if (Copy(IDbytes, 1, 5) = 'GIF89a') then FileType := fGIF87;
end;

function  FileExistWild(Mask : string) : boolean;      { Does X*.* exist? :) }
var sr : SearchRec;
begin
  FindFirst(Mask, AnyFile, SR);
  If DosError<>18 then
    FileExistWild := TRUE
      ELSE
    FileExistWild := FALSE;
end;

Function SizeFile(Fname : string) : longint;
var  sr : SearchRec;
     idx : integer;
begin
  SizeFile := 0;
  Findfirst(Fname, Anyfile, SR);
  If DosError = 0 then SizeFile := SR.Size ELSE SizeFile := -1;
end;

function SwtVal(Swt : string) : string;
{ Returns the value of a command line switch. Eg: for /COM:2, call
  SwtVal('/COM2:') and it will return 2. }
var ndx, found : byte;
    st : string;
begin
  Found := 0;
  For ndx := 1 to ParamCount do
  begin
    if StUpCase(copy(paramstr(ndx), 1, length(swt))) = StUpCase(swt) then
    begin
      Found := ndx;
      Break;
    end;
  end;
  if (Found = 0) then
  begin
    swtval := '';
    Exit;
  end;
  st := '';
  st := StUpCase(Copy(ParamStr(Found), Length(Swt) + 1,
                 Length(ParamStr(Found)) - Length(Swt)));
  For ndx := 1 to Length(St) do
    if (St[ndx] = '_') then St[ndx] := #32;
  SwtVal := st;
end;

Function StatusBar(total, amt : longint) : string;
Const BarLength = 40;
var a, b, c, d : longint;
    percent : real;
    st : string;
begin
  If (total = 0) OR (amt = 0) then
  begin
    StatusBar := '';
    Exit;
  end;
  if (Amt > Total) then amt := total;
  Percent := Amt / Total * (Barlength * 10);
  a := trunc(percent);
  b := a div 10;
  c := 1;
  percent := amt / total * 100;
  d := trunc(percent);
  st := ' (' + int_to_str(d) + '%)';
  StatusBar := CharStr(b * c, #219) + CharStr(Barlength - (b * c), #176) + st;
end;

function EraseFiles(Path, Mask : string) : integer;
var S : SearchRec;
begin
  FindFirst(Path + Mask, Anyfile - Directory, s);      { Find the first file }
  If (DosError = 18) then exit;                          { No files to erase }
  KillFile(Path + s.name);                            { Erase the first file }
  repeat
    Findnext(s);                                        { Find the next file }
    If NOT (DOSError=18) then KillFile(Path + s.name);      { Erase the file }
  until Doserror=18;                                         { no more files }
  EraseFiles := IOResult;                             { Return the IO result }
end;

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]