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

{
>This should do the job, but actually I'm interested in letting the text
>appear in a seperate window, like dizman or something like that..... So
>if you know anything about that, please respond.....

Try something like this:
}

{ Thanks to DJ, TeeCee, Charles Falconer, Mike Copeland, et al. for their help
on this echo over the years ...... }
{$A-,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X-,Y+}
{$M 16384,0,0}

uses
  crt,
  dos;

function FileExists(name : string):boolean;
{ may not work with subdirs }
var f : searchrec;
begin
  findfirst(name, anyfile, f);
  FileExists:= (DOSerror = 0);
end;

procedure Compress(filespec : string);
const
  stderr = 2;
  compressor : pathstr = 'lha.exe';
var
  outfilename : pathstr;
  outfile : text;
  OldStdErr : word;
     procedure DOSclose(handle : word);
     var regs : registers;
     begin
       with regs do
         begin
           bx:= handle;
           ah:= $3e;
           MsDos(regs);
           if (flags and fcarry) <> 0 then
             writeln('Error ',ax,'. Closing DOS handle ', handle);
         end;
     end;
     procedure dup_handle(oldhandle : word; var newhandle : word);
     var regs : registers;
     begin
       newhandle:= 0;
       with regs do
         begin
           bx:= oldhandle;
           ah:= $45;
           MsDos(regs);
           if (flags and fcarry) <> 0 then
             writeln('Error ',ax,'. Dup''ing DOS handle ', oldhandle)
           else newhandle:= ax;
         end;
     end;
     procedure force_dup(existing, second:word);
     var regs : registers;
     begin
       with regs do
         begin
           ah := $46;  bx := existing; cx := second;
           msdos(regs);
           if (flags and fcarry) <> 0 then
             writeln('Error ',ax,'. Changing DOS handle ',
                      existing,' to ', second);
         end;
     end;
begin
  if not FileExists(compressor) then
    compressor:= FSearch(compressor, getenv('path'));
  if not FileExists(compressor) then
    begin
      write('File compressor not found.  Press Enter to acknowledge...');
      readln;
      halt;
    end;
  outfilename:= 'lha.log';
  assign(outfile, outfilename);
  rewrite(outfile);
  dup_handle(StdErr, OldStdErr);
  { redirect stderr to outfile }
  force_dup(textrec(outfile).handle, stderr);
  swapvectors;
  exec(compressor, 'a squished '+ filespec);
  swapvectors;
  flush(outfile);

  if (DOSerror<>0) or (DOSexitcode<>0) then
    begin
      writeln('DOSerror=', DOSerror);
      writeln('DOSexitcode=',DOSexitcode);
    end;

  { restore stderr }
  force_dup(OldStdErr, stderr);
  DosClose(OldStdErr);
  close(outfile);
end;


begin
  clrscr;
  write(' File Archiving by:  LHA version 2.13   Copyright (c) Yoshi 1988-1991.');
  Compress('dowwndw.pas');
  Readln;
end.

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