home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / BBS / ROVER12A.ARC / IMPORT.INC < prev    next >
Text File  |  1991-08-11  |  5KB  |  229 lines
  1. {** IMPORT.INC **}
  2.  
  3. procedure import_menu;
  4. var
  5.   ch: char;
  6. begin
  7.   folder:= 0;
  8.   deleted:= 0;
  9.   public:= 0;
  10.   writeln('IMPORT MENU:');
  11.   writeln('(control C aborts)');
  12.   writeln;
  13.   write('Select folder number ([1]-9): ');
  14.   ch:= readKeyETX;
  15.   if ch in ['1'..'9'] then folder:= ord(ch) - $30
  16.     else folder:= 1;
  17.   writeln;
  18.   write('Select [P]ublic or p<R>ivate: ');
  19.   case upcase(readKeyETX) of
  20.     'P': public:= 0;
  21.     'R': public:= 1;
  22.     else public:= 0;
  23.   end;
  24.   writeln;
  25.   writeln;
  26. end; {import_menu}
  27.  
  28. procedure addline(buf: bufftype);
  29. var
  30.   I: byte;
  31.   msglin: msgtype;
  32. begin
  33.   for I:= 1 to 64 do
  34.     msglin[I]:= buf[I];
  35.   wrtmsg(msglin, nextrecord);
  36.   nextrecord:= nextrecord + 1;
  37.   for I:= 1 to 64 do
  38.     msglin[I]:= buf[I + 64];
  39.   wrtmsg(msglin, nextrecord);
  40.   nextrecord:= nextrecord + 1;
  41.   msgindex.num_of_recs:= msgindex.num_of_recs + 2;
  42. end; {addline}
  43.  
  44. procedure addstring(st: str64);
  45. var
  46.   I, L: byte;
  47.   msglin: msgtype;
  48. begin
  49.   L:= length(st);
  50.   if L> 0 then
  51.   for I:= 1 to L do
  52.     msglin[I]:= ord(st[I]);
  53.   if L< 64 then
  54.  
  55.   msglin[L+1]:= $0D;
  56.   msglin[L+2]:= 0;
  57.  
  58.   for I:= L+3 {1} to 64 do
  59.     msglin[I]:= 1; {0;}
  60.   wrtmsg(msglin, nextrecord);
  61.   nextrecord:= nextrecord + 1;
  62.   msgindex.num_of_recs:= msgindex.num_of_recs + 1;
  63. end; {addstring}
  64.  
  65. procedure form_header;
  66. var
  67.   I: byte;
  68.   st, st1: str16;
  69.   msglin: msgtype;
  70. begin
  71.   st:= fillstr16(SOH);
  72.   sender:= allcaps(sender);
  73.   sender1:= copy(sender, 11, 29);
  74.   receiver:= allcaps(receiver);
  75.   receiver1:= copy(receiver, 17, 29);
  76.   line1[1]:= 'Left  ' + time + ', ';
  77.   line1[2]:= date + '.' + CR + 'For   ';
  78.   line1[3]:= receiver + st;
  79.   st1:= receiver1 + st;
  80.     st1[15]:= CR;
  81.     line1[4]:= st1;
  82.   line1[5]:= 'From  ' + sender;
  83.   line1[6]:= sender1 + st;
  84.   st1:= st;
  85.     st1[5]:= CR;
  86.     st1[6]:= CR;
  87.   line1[7]:= st1;
  88.   line1[8]:= st;
  89.  
  90.     msgindex.num_of_recs:= 0;
  91.     transfertobuffer;
  92.     addline(filebuffer);
  93. end; {form_header}
  94.  
  95. procedure get_body;
  96. var
  97.   len, spr: byte;
  98. begin
  99.   while not EOF(snapfil) do
  100.   begin
  101.     readln(snapfil, line);
  102.     if (length(line) = 0) then line:= CR;
  103.     line:= ' ' + line;
  104.     linebuffer:= '';
  105.     len:= length(line);
  106.     spr:= length(sparebuffer);
  107.     if (spr = 0) then
  108.     begin
  109.       if (len = 64) then linebuffer:= line;
  110.       if (len > 64) then
  111.       begin
  112.         linebuffer:= line;
  113.         sparebuffer:= copy(line, 65, 20);
  114.       end;
  115.       if (len < 64 ) then sparebuffer:= line;
  116.     end
  117.     else {sparebuffer > 0}
  118.     begin
  119.       linebuffer:= sparebuffer + line;
  120.       if ((len + spr) = 64) then
  121.         sparebuffer:= '';
  122.       if ((len + spr) < 64) then
  123.       begin
  124.         linebuffer:= '';
  125.         sparebuffer:= sparebuffer + line;
  126.       end;
  127.       if ((len + spr) > 64) then
  128.         sparebuffer:= copy(line, 64 - spr +1, 90);
  129.     end;
  130.     if (length(linebuffer) > 0) then addstring(linebuffer);
  131.     if (length(sparebuffer) > 64) then
  132.     begin
  133.       linebuffer:= sparebuffer;
  134.       sparebuffer:= copy(sparebuffer, 65, 90);
  135.       addstring(linebuffer);
  136.     end;
  137.   end;
  138. end; {get_body}
  139.  
  140. procedure writemessage;
  141. begin
  142.   form_header;
  143.   get_body;
  144. end; {writemessage}
  145.  
  146. function readsnapfile: boolean;
  147. var
  148.   test: boolean;
  149. begin
  150.   count:= 1;
  151.   {
  152.   time:= '04:58:54';
  153.   date:= '08/19/88';
  154.   sender:= 'Roy Prickett';
  155.   receiver:= 'Phil Hansford';
  156.   }
  157.  
  158.   snapfilename:= 'TEST';
  159.   test:= opensnapfile(K);
  160.   if test then
  161.   begin
  162.     while (count < 5) and not EOF(snapfil) do
  163.     begin
  164.       readln(snapfil, line);
  165.       case count of
  166.         1: if (pos('Date: ', line) = 1) then
  167.             begin
  168.               date:= copy(line, 7, 8);
  169.               time:= copy(line, 16, 8);
  170.             end else write(^G);
  171.         2:  if (pos('From: ', line) = 1 ) then
  172.               sender:= copy(line, 7, 40);
  173.         3:  if (pos('To:   ', line) = 1) then
  174.                receiver:= copy(line, 7, 40);
  175.         4:  if (pos('SEE ALSO', line) =1) or (pos('REPLY TO', line) = 1)
  176.                then count:= count -1
  177.                else if (pos('Subj: ', line) = 1) then
  178.                  subject:= copy(line, 7, 40);
  179.       end; {case}
  180.  
  181. {
  182. ============================
  183. Date: 06/23/88 19:24:20
  184. From: Craig Derouen
  185. To:   All (on 1068/1)
  186. SEE ALSO #3
  187. Subj: Welcome!
  188. ===============================
  189. }
  190.       count:= count + 1;
  191.     end;
  192.     count:= 1;
  193.     k:= k + 1;
  194.     sparebuffer:= '';
  195.   end;
  196.   readsnapfile:= test;
  197. end; {readsnapfile}
  198.  
  199. procedure do_import;
  200. var
  201.   st: str64;
  202. begin
  203.   if not import then exit;
  204.   writeln('IMPORT FILES:');
  205.   writeln;
  206.   writeln('working...');
  207.   writeln;
  208.   {index previously read}
  209.   msgindexrec:= index.last_msgindex_rec;
  210.   if not readmsgindex then finis(2);
  211.   msgindex.public:= public; {set from menu}
  212.   msgindex.folder:= folder;
  213.   k:= 1; {snapfile number}
  214.   while readsnapfile do
  215.    begin
  216.     writemessage;
  217.     if (length(sparebuffer) > 0) then
  218.     begin
  219.       st:= sparebuffer;
  220.       addstring(st);
  221.     end;
  222.     update_msgindexrec;
  223.     writemsgindex;
  224.     update_indexrec;
  225.   end;
  226.   saveindex;
  227. end; {do_import}
  228.  
  229.