Troubleshooting Netware Systems/CSTRIAL0196.BIN/attach/pcc/v08n03/netwrk.exe/FAXBAT13.ZIP/FAXBATCH.PAS

Pascal/Delphi Source File | 1994-05-27 | 5KB | 206 lines

{$A+,B-,D+,E-,F-,I-,L-,N-,O-,R+,S+,V-}
{$M 16384,0,655360}

program faxbatch;

{
  A utility to mail files to a fax gateway by Peter Summers
  <[e-mail]>

  Uses code from a variety of sources.

  Free distributable.
}

uses dos,novell;

const   delflag : boolean = false;
        faxacc  : string  = '';
        faxdir  : string  = '';

var     infilename  : pathstr;
        outfilename : pathstr;
        batfilename : pathstr;
        path        : dirstr;
        name        : namestr;
        extn        : extstr;
        version     : string;
        infile      : file;
        outfile     : file;
        batfile     : text;
        station     : integer;
        sender      : string;
        faxid       : string;
        retcode     : integer;
        number      : string;
        i           : integer;
        numread     : word;
        block       : array[1..2048] of byte;
        argument    : string;


function nextarg:string;     {retrieves the next argument from command line}

  const param : integer = 1;         {used for parsing command line}
  var   arg   : string;
        i     : byte;

  begin
    if param>paramcount then
      nextarg:=''
    else
      begin
        arg := paramstr(param);
        for i := 1 to length(arg) do arg[i] := upcase(arg[i]);
        param := param + 1;
        nextarg := arg;
      end;
  end;


begin { program faxbatch }

  if (paramcount = 0) or (paramstr(1) = '/?') then
    begin
      writeln('Simple FAX-Batching program v1.3. - Peter Summers, 25 May 94');
      writeln('SYNTAX: FAXBATCH <file> [<number>] [/DEL] [/FAX <user>] [/DIR <faxdir>]');
      halt(1);
    end;

  infilename := nextarg;

  assign(infile,infilename);
  reset(infile,1);
  if IOResult<>0 then
    begin
      writeln('Can''t open file '+infilename+'.');
      halt(2);
    end;

  argument := nextarg;

  while argument<>'' do
    begin
      if argument = '/DEL' then
        delflag := true
      else if argument = '/ACC' then
        faxacc := nextarg
      else if argument = '/DIR' then
        faxdir := nextarg+'\'
      else if argument[1]='/' then
        begin
          writeln(argument+' is not a valid switch.');
          halt(11);
        end
      else number := number + argument;
      argument := nextarg;
    end;

  if (faxdir='') and (faxacc='') then faxdir := getenv('fbdir');

  if faxdir='' then
    begin
      get_server_version(version);
      if version='' then
        begin
          writeln('You MUST be logged in to a Novell server or specify a directory.');
          halt(1);
        end;
      if faxacc='' then faxacc := getenv('fbacc');
      if faxacc='' then faxacc := 'FAX';
      gethexid(faxacc,faxid,retcode);
      if retcode<>0 then
        begin
          writeln('Can''t get id for user '+faxacc+'.');
          halt(3);
        end;
      faxdir:='SYS:MAIL\'+faxid+'\';
    end;

  if number='' then
    begin
      write('FAX Number .. ');
      readln(number);
    end;

  i:=1;
  while i <= length(number) do
    if not (number[i] in ['0','1','2','3','4','5','6','7','8','9']) then
      delete(number,i,1)
    else
      i:=i+1;

  if number='' then
    begin
      writeln('No number given, fax not sent.');
      halt(10);
    end;

  fsplit(infilename,path,name,extn);

  randomize;
  name:='';
  for i:=1 to 8 do
    name:=name+chr(ord('A')+random(26));

  if extn = '.BAT' then extn := '.BA&';

  outfilename:=faxdir+name+extn;
  batfilename:=faxdir+name+'.BAT';

  assign(outfile,outfilename);
  rewrite(outfile,1);
  if IOresult<>0 then
    begin
      writeln('Can''t open file '+outfilename);
      halt(5);
    end;

  while not eof(infile) do
    begin
      blockread(infile,block[1],sizeof(block),numread);
      if (IOresult<>0) and not eof(infile) then
        begin
          writeln('Can''t read from file '+infilename);
          halt(6);
        end;
      blockwrite(outfile,block[1],numread);
      if IOresult<>0 then
        begin
          writeln('Can''t write to file '+outfilename);
          halt(7);
        end;
    end;

  close(infile);
  close(outfile);

  assign(batfile,batfilename);
  rewrite(batfile);
  if IOresult<>0 then
    begin
      writeln('Can''t open file '+outfilename);
      halt(8);
    end;

  delete(extn,1,1);

  getstation(station,retcode);
  getuser(station,sender,retcode);
  getserverinfo;

  writeln(batfile,'sendafax '+name+' '+extn+' '+number+' '
    +serverinfo.name+'/'+sender);

  if IOresult<>0 then
    begin
      writeln('Can''t open file '+batfilename);
      halt(9);
    end;

  close(batfile);

  if delflag then erase(infile);

end.