[inherit('sys$library:starlet','lib$spawn','smgdefs','smg$repaint_line',
'BB.PEN')]
module extract;

[global] 
procedure extract;

{Procedure writes selected messages to a file in the current directory
 if the user has wirte access in the current directory.}

var
  date_string : packed array [1..20] of char;
  filename : string;
  message_date : timetype;
  pos : integer;

begin
  m_menu := false;

  repeat
    find_message;
    if found then
      begin
        write_menu('','File name <CR> | <CR> for previous menu: ');
        readstr(filename);
        if (length(filename) > 0) and (filename <> key_exit) then
          begin
            open(ofile,filename,history:=new,error:=continue);
            if (status(ofile) = 0) then
              begin
                write_menu('','Writing message to file...');
                rewrite(ofile);
                findk(bbfile,1,dir_curr^.topic+dir_curr^.date,eql,
                      error:=continue);
                if not ufb(bbfile) then
                  begin
                    read(bbfile,current_record,error:=continue);
                    with current_record do
                      begin
                        $asctim(timbuf:=date_string,timadr:=invert(date));
                        writeln(ofile,'Date:      ',date_string,error:=continue);
                        writeln(ofile,'Posted by: ',poster,error:=continue);
                        writeln(ofile,'Topic:     ',topic,error:=continue);
                        writeln(ofile,'Subject:   ',subject,error:=continue);
                        writeln(ofile,error:=continue);
                        message_date := date;

                        {Write message text into ofile.}
                        while (date = message_date) and (status(bbfile) <= 0) do
                          begin
                            repeat
                              pos := index(data,key_cr);
                              if (pos = 0) then pos := length(data) + 1;
                              if (pos > 1) then
                                line := substr(data,1,pos-1)
                              else
                                line := '';
                              if (pos < (length(data) - 1)) then
                                data := substr(data,pos+2,length(data)-pos-1)
                              else
                                data := ''; 
                              writeln(ofile,line,error:=continue);
                            until (length(data)=0);
                            read(bbfile,current_record,error:=continue);
                          end;

                      end;
                  end;

                close(ofile,error:=continue);

              end
            else
              write_error('Unable to open output file.');
          end;
      end;
  until out_of_bounds or (actual_message_count < 2);
end;

end.