home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PROT100.ZIP / MEGALS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-13  |  3.1 KB  |  98 lines
  1. {
  2.    MEGALS.PAS
  3.    MegaLink protocol for Pascal.  UNTESTED.  Had no docs.
  4.    Written: 05-16-90
  5.    Copyright (c)1990, Eric J. Givler, All Rights Reserved.
  6. }
  7. PROCEDURE SendMEGALink;
  8. (*  Paul Meiners *)
  9. { receive an initial C 00 FF as opening NAK }
  10.  
  11. CONST  EM  = ^Y;             { MegaLink Block Id }
  12.        RS  = #$1E;           { Request Status    }
  13.        SYN = ^V;             { Synchronize       }
  14.        DLE = ^P;             { Data Link Escape  }
  15.      { SUB = ^Z;               CP/M EOF (CPMEOF) }
  16.  
  17. VAR cs : ARRAY512;
  18.     i,
  19.     j  : integer;
  20.     temp : string[5];
  21.  
  22.    PROCEDURE MakeMegaHeader(var sector : blocktype);
  23.    { Name of transmitting program, as a null terminated string
  24.      starts at 25 for 15 }
  25.    var size : longint;
  26.           i : integer;
  27.        host : String[15];
  28.    begin
  29.       host := 'NBBS';
  30.       FillChar(sector,SizeOf(sector),CHR(0));
  31.       size := FileSize(WorkFile);
  32.       Move(size,sector,SizeOf(size));
  33.       GetFtime(WorkFile,size);
  34.       Move(size,sector[4],SizeOf(size));
  35.       for i := 1 to length(filename) do sector[7+i] := byte(filename[i]);
  36.       for i := 1 to length(host) do sector[24+i] := ord(host[i]);
  37.    end;
  38.  
  39. BEGIN (* SendMEGALink *)
  40.    Assign(WorkFile,filename);
  41.    {$I-} Reset(WorkFile,1); {$I+}
  42.    If IOResult <> 0 Then Exit;
  43.    MakeMegaHeader(sector);
  44.    blocknum := 0;
  45.    repeat
  46.       Send(SOH);
  47.       Send(CHR(blocknum));
  48.       Send(CHR(blocknum XOR 255));
  49.       FOR i := 0 to lastbyte DO Send(CHR(sector[i]));
  50.       crc := 0;
  51.       crca( sector, SizeOf(sector), crc);
  52.       Send(CHR(Hi(crc)));
  53.       Send(CHR(Lo(crc)));
  54.       PurgeLine;
  55.    until (readline(10) = ORD(ACK));
  56.    PurgeLine;                          (* actually receive ACK 00 FF *)
  57.    
  58.    blocknum := 1;
  59.    str((FileSize(WorkFile) DIV 512):5,temp);
  60.    WriteLn('File open: ' + temp + ' MEGALink blocks.');
  61.    cs.Len := 512;
  62.    repeat
  63.       counter := 0;
  64.       FillChar(cs.longstring, SizeOf(cs.longstring),CPMEOF);
  65.       {$I-} BlockRead(WorkFile,cs.longstring,Sizeof(cs.longstring),result); {$I+}
  66.       IF IOResult <> 0 then begin
  67.          WriteLn('Error reading File: CANCELLED');
  68.          Send(CAN); Send(CAN);
  69.          Close(WorkFile);
  70.          Exit;
  71.       end;
  72.       repeat
  73.          Write(cr,'Sending block: ',blocknum);
  74.          Send(EM);
  75.          Send(CHR(blocknum));
  76.          Send(CHR(blocknum XOR 255));
  77.          FOR j := 1 to 512 do begin
  78.             IF (cs.LongString[j] = XON) then begin
  79.                Send(CHR(byte(DLE) XOR 64));
  80.                Send(CHR(byte(XON) XOR 64));
  81.             end else if (cs.LongString[i] = XOFF) then begin
  82.                Send(CHR(byte(DLE) XOR 64));
  83.                Send(CHR(byte(XON) XOR 64));
  84.             end else Send(cs.LongString[i]);
  85.          end;
  86.          calc_crc32(cs);
  87.          Send(CHR(Hi(crc_reg_hi)));
  88.          Send(CHR(Lo(crc_reg_hi)));
  89.          Send(CHR(Hi(crc_reg_lo)));
  90.          Send(CHR(Lo(crc_reg_lo)));
  91.          PurgeLine;
  92.          inc(counter);
  93.       UNTIL (readline(10) = ORD(ACK)) OR (counter = retrymax);
  94.       PurgeLine;
  95.       inc(blocknum);
  96.     UNTIL EOF(WorkFile) OR (counter = retrymax) OR (NOT Carrier);
  97.  
  98. end;