home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / bbs / disp5.arc / DISPATCH.INC < prev   
Text File  |  1990-09-20  |  6KB  |  269 lines
  1. {----- DISPATCH.INC include file ------}
  2.  
  3. function open(fname: str14): boolean;
  4. { Open an existing text file. }
  5. begin
  6.   assign(tfil, fname);
  7.   {$I-}
  8.   reset(tfil);
  9.   {$I+}
  10.   open:= IOresult = 0;
  11. end; {open}
  12.  
  13. procedure opennew(fname: str14);
  14. { Create a new text file. }
  15. begin
  16.   assign(tfil, fname);
  17.   {$I-}
  18.   rewrite(tfil);
  19.   {$I+}
  20. end; {opennew}
  21.  
  22. function exists(name: str14): boolean;
  23. { If file (untyped) exists, close it. }
  24. var
  25.   OK: boolean;
  26. begin
  27.   assign(fil, name);
  28.   {$I-}
  29.   reset(fil);
  30.   OK:= (IOresult = 0);
  31.   if OK then
  32.     close(fil);
  33.   {$I+}
  34.   exists:= OK and (IOresult = 0);
  35. end; {exists}
  36.  
  37. function exists1(name: str14): boolean;
  38. { If file (untyped) exists, leave open. }
  39. begin
  40.   assign(fil, name);
  41.   {$I-}
  42.   reset(fil);
  43.   {$I+}
  44.   exists1:= (IOresult = 0);
  45. end; {exists1}
  46.  
  47. function open_log: integer;
  48. { Open the Tabby MAIL.LOG file. }
  49. var
  50.   OK: boolean;
  51.   int: integer;
  52. begin
  53.   int:= 0;
  54.   OK:= exists1('MAIL.LOG');
  55.   if OK then
  56.     int:= 2
  57.   else begin
  58.     {$I-}
  59.     rewrite(fil);
  60.     {$I+}
  61.     OK:= (IOresult = 0);
  62.     if OK then int:= 1;
  63.   end;
  64.   open_log:= int;
  65. end; {open_log}
  66.  
  67. function opensub: boolean;
  68. { Open $$$.SUB file. Clear it if file exists. }
  69. var
  70.   OK: boolean;
  71. begin
  72.   assign(sub, 'A:$$$.SUB');
  73.   {$I-}
  74.   rewrite(sub);
  75.   {$I+}
  76.   OK:= (IOresult = 0);
  77.   if OK then writeln('Submit file is open.')
  78.   else
  79.     writeln('++ Cannot open Submit, process aborted ++');
  80.   opensub:= OK;
  81. end; {opensub}
  82.  
  83. procedure submit(st: str60);
  84. { Save st to submit file record. }
  85. { Ignore null and commented lines. }
  86. var
  87.   len, I: byte;
  88.   buffer: array[1..128] of byte;
  89. begin
  90.   if (length(st) = 0) or (st[1] = ';')
  91.     or (st[1] = ' ') then exit;
  92.   len:= length(st);
  93.   buffer[1]:= len;
  94.   for I:= 1 to len do
  95.     buffer[I + 1]:= ord(st[I]);
  96.   buffer[len + 2]:= 0;
  97.   buffer[len + 3]:= ord('$');
  98.   for I:= len + 4 to 128 do
  99.     buffer[I]:= 0;
  100.   blockWrite(sub, buffer, 1);
  101. end; {submit}
  102.  
  103. procedure kill(name: str14);
  104. { Kill a file if it exists. }
  105. begin
  106.   if not exists(name) then exit;
  107.   assign(fil, name);
  108.   {$I-}
  109.   erase(fil);
  110.   {$I+}
  111. end; {kill}
  112.  
  113. procedure do_rename(name, name1: str14);
  114. { Rename a file. }
  115. begin
  116.   kill(name);
  117.   assign(tfil, name1);
  118.   {$I-}
  119.   rename(tfil, name);
  120.   {$I+}
  121. end; {do_rename}
  122.  
  123. procedure update_log(OK: boolean);
  124. { Updates Tabby MAIL.LOG file. }
  125. { If OK is false, an error is logged. }
  126. { Other information passed in from globals. }
  127. var
  128.   blank_string, log_line: str64;
  129.   st: string[40];
  130.   st1: string[7];
  131.   numb: string[5];
  132.   stime: string[14];
  133.   i, int, code: integer;
  134.   buffer: array[1..128] of byte;
  135. begin
  136. {st:= 'Revent   01/31/89 01:00 Beginning event Z'
  137.  st:= 'Dispatch 01/31/89 01:00 Forcing event '
  138.  st:= 'Dispatch 01/31/89 01:00 Running event '
  139.  st:= 'Dispatch 01/31/89 01:00 Error - event '}
  140.  
  141.   blank_string:= '';
  142.   for i:= 1 to 62 do
  143.     blank_string:= blank_string + ' ';
  144.   blank_string:= blank_string + CR + LF;
  145.  
  146.   if OK then
  147.   begin
  148.     if force_event then st1:= 'Forcing' else st1:= 'Running';
  149.   end
  150.   else st1:= 'Error -'; {not OK}
  151.   stime:= gsysdate + ' ' + gsystime;
  152.   st:= 'Dispatch ' + stime + ' ' + st1 + ' ' + tag;
  153.   log_line:= blank_string;
  154.   for i:= 1 to length(st) do
  155.     log_line[i]:= st[i];
  156.  
  157.   int:= open_log;
  158.   case int of
  159.     0: {bad file}
  160.        writeln('++ Error reading MAIL.LOG ++');
  161.     1: {new file}
  162.        begin
  163.          for i:= 1 to 64 do
  164.            buffer[i]:= ord(blank_string[i]);
  165.          for i:= 1 to 64 do
  166.          buffer[i + 64]:= ord(log_line[i]);
  167.        end;
  168.     2: {old file}
  169.        begin
  170.          blockread(fil, buffer, 1);
  171.          seek(fil, 0);
  172.          numb:= '';
  173.          for i:= 1 to 5 do
  174.            numb:= numb + chr(buffer[i + 1]);
  175.          numb:= copy(numb, 1, pos(chr(0), numb) - 2);
  176.          val(numb, int, code);
  177.          if code > 0 then int:= 0;
  178.        end;
  179.   end; {case}
  180.  
  181.   if (int > 0) then {update pointer}
  182.   begin
  183.     int:= int + 1;
  184.     str(int, numb);
  185.     numb:= numb + ' ' + chr(0);
  186.     for i:= 1 to length(numb) do
  187.       buffer[i + 1]:= ord(numb[i]);
  188.     blockwrite(fil, buffer, 1);
  189.   end;
  190.  
  191.   if (int > 1) then  {add to old file}
  192.   begin
  193.     if odd(int) then
  194.     begin
  195.       seek(fil, filesize(fil));
  196.       for i:= 1 to 64 do
  197.         buffer[i]:= ord(log_line[i]);
  198.       for i:= 1 to 64 do
  199.         buffer[i + 64]:= ord(blank_string[i]);
  200.     end
  201.     else begin {even}
  202.       seek(fil, filesize(fil) - 1);
  203.       blockread(fil, buffer, 1);
  204.       seek(fil, filesize(fil) - 1);
  205.       for i:= 1 to 64 do
  206.         buffer[i + 64]:= ord(log_line[i]);
  207.     end;
  208.  
  209.     blockwrite(fil, buffer, 1);
  210.   end;
  211.   if (int > 0) then close(fil);
  212. end; {update_log}
  213.  
  214. procedure set_default_drive;
  215. { Sets drive/user to value of default_drive constant. }
  216. var
  217.   ch: string[1];
  218.   d, u: byte;
  219.   int, code: integer;
  220. begin
  221.   if (length(default_drive) = 0) then exit;
  222.   ch:= upCase(default_drive[1]);
  223.   d:= ord(ch) - $41;
  224.   val(copy(default_drive, 2, 2), int, code);
  225.   if (code > 0) then exit;
  226.   if (d < 0) or (d > 15) then exit;
  227.   u:= lo(int);
  228.   if (u < 0) or (u > 15) then exit;
  229.   bdos(14, d);
  230.   bdos(32, u);
  231. end; {set_default_drive}
  232.  
  233. function bt2st(bt: byte): str2;
  234. { Convert byte to 2 character string. }
  235. { Add leading zero if needed. }
  236. var
  237.   st: str2;
  238.   i: integer;
  239. begin
  240.   str(bt, st);
  241.   if (length(st) = 1) then
  242.     st:= '0'  + st;
  243.   bt2st:= st;
  244. end; {bt2st}
  245.  
  246. procedure go_to_program(st: str60);
  247. { Execute a program via the MCLB. }
  248. { Based on PutOnCommandLine by Cyrus Patel (LUP.PAS). }
  249. var
  250.   I: integer;
  251.   addr: integer;
  252. begin
  253.   addr:= MCLB + 4; {allow page boundaries}
  254.   mem[MCLB]     := lo(addr);
  255.   mem[MCLB + 1] := hi(addr);
  256.   mem[MCLB + 2] := 80;
  257.   mem[MCLB + 3] := length(st);
  258.   for I := 1 to length(st) do
  259.     mem[MCLB + I + 3] := ord(st[I]);
  260.   mem[MCLB + length(st) + 4] := $00;
  261.   mem[MCLB + length(st) + 5] := $00;
  262.   mem[$5D]:= $20; { Clear possible garbage from command line. }
  263.   halt;
  264. end; {go_to_program}
  265.  
  266.  
  267. { ------------ end of include file -----------}
  268.  
  269.