[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]