{DEFINE DEBUG}
{DEFINE SHOWINFO}
{DEFINE IPDEBUG}
{DEFINE IP2DEBUG}
{DEFINE TERMINAL}

Unit PPP;

Interface

Const
   SEND    = 0;
   RECEIVE = 1;

   _dead    = 0;
   _lcp     = 1;
   _ncd     = 2;
   _open    = 3;

   DEFAULT_PROTOCOL_OFFSET = 3; {I wouldn't change this :)}

   IP_Protocol  = $0021;  {IP Datagram}
   LCD_Protocol = $C021;  {Link Control Data  - ref: LCP}
   NCD_Protocol = $8021;  {Network Control Data}

   Configure_Request = 1; {Packet Codes}
   Configure_ACK     = 2;
   Configure_NAK     = 3;
   Configure_Reject  = 4;
   Terminate_Request = 5;
   Terminate_ACK     = 6;
   Code_Reject       = 7;
   Protocol_Reject   = 8;
   Echo_Request      = 9;
   Echo_Reply        = 10;
   Discard_Request   = 11;

   Complement = $7D; {next character after Complement nc := nc XOR $32}
   Flag       = $7E; {Start of PPP Packet, End of PPP Packet}
   Address    = $FF; {Address field of PPP packet}
   Control    = $03; {Control field of PPP packet}

   Maximum_Receive_Unit              = 1;  {LCP Configuration Options}
   Authentication_Protocol           = 3;
   Quality_Protocol                  = 4;
   Magic_Number                      = 5;
   Protocol_Field_Compression        = 7;
   Address_Control_Field_Compression = 8;

   Max_Frame_Size     = 16000;
   Default_Frame_Size = 1500;

Type
   IPTYPE = array[1..4] of byte;
   pbyte      = ^byte;
   proc       = procedure;

   pFrame     = ^PPP_Frame;
   PPP_FRAME  = Record
                  Frame_Data : pbyte;
                  Frame_Ptr  : pbyte;
                  Frame_Size : word;
                  Frame_Complete : Boolean;
                  Frame_Type     : word;
                  Frame_Length   : longint;
                  Comp       : boolean;
                  Prev,Next  : pFrame;
                end;


   pLCPFrame  = ^LCP_Frame;
   LCP_Frame  = Record
                  Code       : Byte;
                  Identifier : Byte;
                  Length     : Word;
                  Data       : pbyte;
                  data_ptr   : pbyte;
                  datasize   : longint;
                  sendorreceive : byte; {send = 0/receive = 1}
                  prev,next  : pLCPFrame;
                end;

   pNCDFrame  = ^NCD_Frame;
   NCD_Frame  = Record
                  Code       : Byte;
                  Identifier : Byte;
                  Length     : Word;
                  Data       : pbyte;
                  data_ptr   : pbyte;
                  datasize   : longint;
                  sendorreceive : byte; {send = 0/receive = 1}
                  prev,next  : pNCDFrame;
                end;
   pIPFrame  = ^IP_Frame;
   IP_Frame  = Record
                 Data       : pbyte;
                 data_ptr   : pbyte;
                 datasize   : longint;
                 sendorreceive : byte; {send = 0/receive = 1}
                 prev,next  : pIPFrame;
               end;

   PPP_Object = Object
                 Private
                  PIP : Boolean;  {Packet in Progress?}
                  r_packetcrc : word;

                  phase : byte; {0 - dead, 1 - LCP, 2 - NCD, 3 - Open}

                  vj_hdrc : boolean;
                  maxslotid,
                  compslotid : byte;
                  ipcp : word;

                  userinit : boolean;
                  initfunc : proc;
                  First_Frame,
                  Last_Frame,
                  Cur_Frame  : pFrame;

                  First_LCP_Frame,
                  Last_LCP_Frame,
                  Cur_LCP_Frame : pLCPFrame;

                  First_NCD_Frame,
                  Last_NCD_Frame,
                  Cur_NCD_Frame : pNCDFrame;

                  First_IP_Frame,
                  Last_IP_Frame,
                  Cur_IP_Frame : pIPFrame;

                  NumIPFrames  : word;
                  NumLCPFrames : word;
                  NumNCDFrames : word;

                  Function B(var frame:pbyte):byte;
                  Function GetChar(var frame:pbyte):char;
                  Function GetByte(var frame:pbyte):byte;
                  Function GetInteger(var frame:pbyte):Integer;
                  Function GetWord(var frame:pbyte):Word;
                  {Function GetLongint(var frame:pbyte):Longint;}

                  {Procedure   NewIPFrame(frame:pFrame);}
                  Procedure   DisposeIPFrame(frame:pIPFrame);
                  Function    GetIPFrame:pIPFrame;

                  Procedure   NewLCPFrame(frame:pFrame);
                  Procedure   DisposeLCPFrame(frame:pLCPFrame);
                  Function    GetLCPFrame:pLCPFrame;

                  Procedure   NewNCDFrame(frame:pFrame);
                  Procedure   DisposeNCDFrame(frame:pNCDFrame);
                  Function    GetNCDFrame:pNCDFrame;

                  Procedure   Request_MRU(var frame:pLCPFrame);
                  Procedure   Set_MRU(var frame:pLCPFrame);
                  Procedure   Request_PFC(var frame:pLCPFrame);

                  Procedure   ProcessLCPFrame(frame:pLCPFrame);
                  Procedure   SendLCPFrame(Code:byte;Identifier:byte;
                                           datalength:word;data:pLCPframe);
                  Procedure   HandleLCPFrames;

                  Procedure   SendIPFrame(datalength:word;data:pIPframe);
                  Procedure   HandleIPFrames;

                  Procedure   Set_IP(var frame:pNCDFrame);
                  Procedure   Set_VJ_hdrc(var frame:pNCDFrame);

                  Procedure   ProcessNCDFrame(frame:pNCDFrame);
                  Procedure   SendNCDFrame(Code:byte;Identifier:byte;
                                           datalength:word;data:pNCDframe);
                  Procedure   HandleNCDFrames;

                  Procedure   NewFrame;
                  Procedure   AddtoFrame(bte:byte);
                  Procedure   EndFrame;
                  Procedure   DisposeFrame(frame:pFrame);
                  Procedure   SendPPP(protocol:word;data:pointer);
                  Procedure   HandleIncoming;

                  Public
                    use_PFC : boolean;
                    use_ADFC : boolean;
                    IPADDR   : IPTYPE;     {32-bit int form of Client IP}
                    IPSTRING : string[16];  {000.000.000.000 form of Client IP}
                    Terminate_OK : boolean; {OK to terminate PPP session?}
                    Frame_Size : word;      {IP Datagram MAXIMUM Size}
                    protocol_ofs : byte;

                    Function GetLongint(var frame:pbyte):Longint;

                    Function  MakePtr(var variable):pbyte;
                    Procedure SendLCP(Code:byte;
                                      Identifier:byte;
                                      datalength:longint;data:pbyte);

                    Procedure SendNCD(Code:byte;
                                      Identifier:byte;
                                      datalength:longint;data:pbyte);

                    Procedure SendIP(datalength:longint;data:pbyte);
                    Function  Carrier:boolean;
                    Constructor Init(comport:byte;baudrate:longint;ifunc:proc); {Initializes PPP Packet Driver}
                    Destructor  Done;  {Destroys PPP Packet Driver}
                    Procedure   Terminal;
                    Procedure   Dial(username,password,phone,scriptfile:string);
                    Procedure   Packet_Driver;
                    Procedure   FormatIP (b1,b2,b3,b4:byte; var ipt:iptype);
                    Function    IPstr    (ip:iptype):string;
                    Function    ValidIP  (s:string):boolean;
                    Function    StoIP(s:string;var IP:iptype):boolean;
                    Function    CanWrite:Boolean;
                end;

Var
  oPPP : PPP_Object;

Implementation

Uses MODEM, {Interface to Modem}
     CRT,   {used for arbitrary delays}
     CRC16, {calculates 16-bit CRC's (cyclic redundancy check's)}
     IP
     {$IFDEF TERMINAL},vesa,win,global{$ENDIF};

{$IFDEF TERMINAL}
var
  modem_win : longint;

Procedure Modem_Window;
var
 x1,y1,x2,y2 : integer;
 s : string;
Begin
  if get_handle_dialog(modem_win)<>nil then exit;
  x1 := maxx shr 1 - 240;
  y1 := maxy shr 1 - 180;
  x2 := x1 + 480;
  y2 := y1 + 360;

  modem_win := unique_id;
  Create_Dialog(modem_win,'Modem Dialog',x1,y1,x2,y2,standard_dialog,
                close_button+help_button+moveable+modal+minimize_button+maximize_button+sizeable,
                0,0,0,0,0,0,0,0,0);
  Add_ListBox(modem_win,cur_dialog,'',-2,-1,(x2-x1)-4,(y2-y1)-22,unique_id,unique_id,0,nil,0);
  setactive(modem_win);
end;

Procedure MODEMWIN(s:string);
var
 hlb : handle_listbox;
Begin
  if get_handle_listbox(modem_win)=nil then exit;
  Add_Listbox_Item(get_handle_listbox(modem_win),s,80,0);
  if cur_dialog=get_handle_dialog(modem_win) then
     Begin
       hlb := get_handle_listbox(modem_win);
       if (hlb^.numitems>hlb^.vert_sb^.curpos+22) then
         Begin
           inc(hlb^.vert_sb^.curpos,1);
           draw_listbox(cur_dialog,hlb,true);
         end else draw_listbox(cur_dialog,hlb,false);
     end;
end;

Procedure MODEMWIN2(s:string);
Begin
  if get_handle_listbox(modem_win)=nil then exit;
  Add_Listbox_Item(get_handle_listbox(modem_win),s,80,0);
end;

Procedure MODEMWINC(c:char);
var
 s : string;
 hlb : handle_listbox;
Begin
 hlb := get_handle_listbox(modem_win);
 if hlb=nil then exit;
 if c=#10 then exit;
 if c=#13 then MODEMWIN('') else
  Begin
    s := hlb^.last_item^.data.pstr;
    s := s + c;
    delete_listbox_item(hlb,hlb^.last_item,false);
    MODEMWIN2(s);
  end;
end;
{$ENDIF}


Function itos(s:byte):string;
var
 t : string;
Begin
 str(s,t);
 itos := t;
end;

Constructor PPP_Object.Init;
Begin
  InitializeAsync;
  Setparam(comport,baudrate,FALSE,TRUE); {com baud parity 8n1}
  PIP          := false;  {Packet in Progress?}
  vj_hdrc := false;
  terminate_ok := false;
  initfunc := ifunc;
  userinit := false;
  phase := _dead;
  use_PFC      := false;       {use Protocol Field Compression?}
  use_ADFC     := false;       {use Address Control Field Compression}
  fillchar(ipaddr,sizeof(ipaddr),0);
  ipstring := '';
  Frame_Size   := Default_Frame_Size;
  NumIPFrames  := 0;
  NumLCPFrames := 0;
  NumNCDFrames := 0;
  protocol_ofs := DEFAULT_PROTOCOL_OFFSET;

  First_Frame     := nil; Last_Frame      := nil; Cur_Frame       := nil;
  First_LCP_Frame := nil; Last_LCP_Frame  := nil; Cur_LCP_Frame   := nil;
  First_NCD_Frame := nil; Last_NCD_Frame  := nil; Cur_NCD_Frame   := nil;
  First_IP_Frame := nil;  Last_IP_Frame  := nil;  Cur_IP_Frame   := nil;

  if carrier then
   Begin
     SendInit('+++');
     delay(1000);
     sendinit('ATH0'#13);
     delay(1000);
   end;
end;

Destructor PPP_Object.Done;
Begin
  repeat
    SendInit('+++');
    delay(1000);
    sendinit('ATH0'#13);
    delay(1000);
  until not(carrier) or keypressed;
  Closeport;
  while (first_lcp_frame<>nil) do disposelcpframe(first_lcp_frame);
  while (first_ncd_frame<>nil) do disposencdframe(first_ncd_frame);
  while (first_ip_frame<>nil) do disposeipframe(first_ip_frame);
  while (first_frame<>nil) do disposeframe(first_frame)
end;

Function PPP_Object.B(var frame:pbyte):byte;
Begin
  if frame<>nil then
  Begin
    b := frame^;
    inc(frame);
  end else b := 255;
end;

Function PPP_Object.GetChar(var frame:pbyte):char;
Begin
  GetChar := chr(b(frame));
end;

Function PPP_Object.GetByte(var frame:pbyte):byte;
Begin
  GetByte := b(frame);
end;

Function PPP_Object.GetInteger(var frame:pbyte):Integer;
var
 i : integer;
Begin
  i := b(frame) shl 8;
  i := i + b(frame);
  GetInteger := i;
end;

Function PPP_Object.GetWord(var frame:pbyte):Word;
var
 i : word;
Begin
  i := b(frame) shl 8;
  i := i+b(frame);
  GetWord := i;
end;

Function PPP_Object.GetLongint(var frame:pbyte):Longint;
var
 l : longint;
Begin
  l := (getword(frame)*65536)+getword(frame);
  GetLongint := l;
end;

{$I TIMETICK.INC}
Function stor(s:string):real;
var
 r : real;
 e : integer;
Procedure strip(var s:string;c:char);
begin
  while pos(c,s)>0 do delete(s,pos(c,s),1);
end;
Begin
  strip(s,' ');
  strip(s,'$');
  val(s,r,e);
  stor := r;
end;


Function Waitfor(s:string;t:real) : Boolean;
var
 buf : string;
 c : char;
Begin
  buf := '';
  starttiming;
  repeat
    if numchars>0 then
      Begin
        c := getchar;
        buf := buf + c;
        write(buf[length(buf)]);
        if length(buf)>length(s) then
         Begin
           move(buf[2],buf[1],240);
           buf[0] := chr(length(s));
         end;
      end;
    stoptiming;
    if stor(elapsed)>t then
     Begin
       waitfor := false;
       exit;
     end;
   {$IFDEF TERMINAL}dialogmouseroutine;{$ENDIF}
  until (pos(s,buf)>0);
end;


Procedure PPP_Object.Dial(username,password,phone,scriptfile:string);
Begin
  clearreceivebuffer;
  cleartransmitbuffer;
  sendinit('AT&F1'#13);
  delay(250);
  sendinit('ATM0'#13);
  delay(250);

  sendinit('ATDT'+phone+#13);
{  repeat handlemouse; until (carrier) or (keypressed);
  sendinit(#13);
  waitfor('name>',10);sendinit(username+#13);
  waitfor('word>',10);sendinit(password+#13);
  waitfor('Dialz>>>>',10);sendinit('c ppp'#13);
  waitfor('session',10);}
end;

Function PPP_Object.Carrier:boolean;
Begin
  if modem.carrier then carrier := true else carrier := false;
end;

Procedure PPP_Object.Terminal;
Const
  PFC        : Array[1..4] of byte = (7,2,8,2);
var
 ch : char;
Begin
 {$IFDEF TERMINAL}
    MODEM_WINDOW;
    MODEMWIN('Internet Access Port Opened');
    MODEMWIN('');
 {$ENDIF}

  ch := ' ';
  repeat
    while numchars>0 do
      Begin
        ch := modem.getchar;
        {if ch in ['a'..'z','A'..'Z','0'..'9',#32,'-','+','!','@','#','$','%','^','&','*','(',')',')','|','\','/','[',']',
                  #10,#13] then write(ch);}
        {$IFDEF TERMINAL} MODEMWINC(ch);{$ENDIF}
        ch := ' ';
      end;
    if keypressed then
      Begin
        ch := readkey;
        if ch>=#0 then sendchar(ch);
      end;
    {$IFDEF TERMINAL}dialogmouseroutine;{$ENDIF}
  until (ch=#27);
 phase := _LCP;
 sendlcp(1,random(256),4,makeptr(PFC));
 {$IFDEF TERMINAL} standard_close(true);{close_dialog(get_handle_dialog(modem_win));}{$ENDIF}
end;

Procedure PPP_Object.DisposeFrame;
Begin;
  if frame=nil then exit;
  if frame=first_frame then first_frame := first_frame^.next;
  if frame=last_frame then last_frame := last_frame^.prev;
  if frame=cur_frame then cur_frame := cur_frame^.next;
  if cur_frame=nil then cur_frame := first_frame;

  if frame^.prev<>nil then frame^.prev^.next := frame^.next;
  if frame^.next<>nil then frame^.next^.prev := frame^.prev;

  if (frame^.frame_type = IP_Protocol) then dec(NumIPFrames) else
  if (frame^.frame_type = LCD_Protocol) then dec(NumLCPFrames) else
  if (frame^.frame_type = NCD_Protocol) then dec(NumNCDFrames);

  freemem(frame^.frame_data,frame^.frame_size);
  dispose(frame);
end;

Procedure PPP_Object.SendIPFrame(datalength:word;data:pIPFrame);
var
 lframe : pIPFrame;
Begin
  if datalength=0 then exit;
  new(lframe);
  lframe^.sendorreceive := send;
  if datalength>0 then getmem(lframe^.data,datalength) else lframe^.data := nil;
  lframe^.datasize := datalength;
  lframe^.data_ptr := lframe^.data;
  if datalength>0 then move(data^.data_ptr^,lframe^.data_ptr^,datalength);
  lframe^.data_ptr := lframe^.data;
  lframe^.prev := last_IP_frame;
  cur_ip_frame := lframe;
  last_ip_frame := lframe;
  lframe^.next := nil;
  if first_ip_frame=nil then first_ip_frame := lframe;
  if lframe^.prev<>nil then lframe^.prev^.next := lframe;
end;

Procedure PPP_Object.SendLCPFrame(Code:byte;Identifier:byte;
                                  datalength:word;data:pLCPFrame);
var
 lframe : pLCPFrame;
Begin
  new(lframe);
  lframe^.code       := code;
  lframe^.identifier := identifier;
  lframe^.length     := datalength+4;
  lframe^.sendorreceive := send;
  if datalength>0 then getmem(lframe^.data,datalength) else lframe^.data := nil;
  lframe^.datasize := datalength;
  lframe^.data_ptr := lframe^.data;
  if datalength>0 then move(data^.data_ptr^,lframe^.data_ptr^,datalength);
  lframe^.data_ptr := lframe^.data;
  lframe^.prev := last_LCP_frame;
  cur_lcp_frame := lframe;
  last_lcp_frame := lframe;
  lframe^.next := nil;
  if first_lcp_frame=nil then first_lcp_frame := lframe;
  if lframe^.prev<>nil then lframe^.prev^.next := lframe;
end;

Procedure PPP_Object.SendNCDFrame(Code:byte;Identifier:byte;
                                  datalength:word;data:pNCDFrame);
var
 lframe : pNCDFrame;
Begin
  new(lframe);
  lframe^.code       := code;
  lframe^.identifier := identifier;
  lframe^.length     := datalength+4;
  lframe^.sendorreceive := send;
  if datalength>0 then getmem(lframe^.data,datalength) else lframe^.data := nil;
  lframe^.datasize := datalength;
  lframe^.data_ptr := lframe^.data;
  if datalength>0 then move(data^.data_ptr^,lframe^.data^,datalength);
  lframe^.prev := last_NCD_frame;
  cur_NCD_frame := lframe;
  last_NCD_frame := lframe;
  lframe^.next := nil;
  if first_NCD_frame=nil then first_NCD_frame := lframe;
  if lframe^.prev<>nil then lframe^.prev^.next := lframe;
  {$IFDEF SHOWINFO}
     writeln('---------------[NCD FRAME]-------------');
     writeln('Code       : ',lframe^.code);
     writeln('Identifier : ',lframe^.identifier);
     writeln('Length     : ',lframe^.length);
     writeln('Datasize   : ',lframe^.datasize);
     writeln('-------------[END NCD FRAME]-----------');
  {$ENDIF}
end;

Procedure PPP_Object.Request_MRU(var frame:pLCPFrame);
var
 fs : word;
 data : pbyte;
begin
  {$IFDEF DEBUG} writeln('Configure_Request MRU');{$ENDIF}
  fs := getword(frame^.data_ptr);
  frame^.data_ptr := frame^.data;

  {if (fs<=max_frame_size) then
    Begin}
      Frame_Size := fs;
      {$IFDEF DEBUG} {writeln('MRU : ',frame_size);}{$ENDIF}
      {SendLCPFrame(Configure_Ack,
      frame^.identifier,
      frame^.datasize,frame);}
    (*end else
    Begin
      {$IFDEF DEBUG} writeln('MRU : <NAK>');{$ENDIF}
      SendLCPFrame(Configure_Nak,
      frame^.identifier,
      frame^.datasize,frame);
    end;*)
end;

Procedure PPP_Object.Set_MRU(var frame:pLCPFrame);
var
 fs : word;
 data : pbyte;
begin
  {$IFDEF DEBUG} writeln('Set MRU ');{$ENDIF}
  fs := getword(frame^.data_ptr);
  {frame^.data_ptr := frame^.data;}
  if (fs<=max_frame_size) then
    Begin
      Frame_Size := fs;
      {$IFDEF DEBUG} writeln('MRU : ',frame_size);{$ENDIF}
    end;
end;

Procedure PPP_Object.Request_PFC(var frame:pLCPFrame);
var
 data : pbyte;
Begin
  frame^.data_ptr := frame^.data;
  {$IFDEF DEBUG} writeln('Configure_Request PFC : <ACK>');{$ENDIF}
  SendLCPFrame(Configure_ACK,
               frame^.identifier,
               frame^.datasize,
               frame);
  use_pfc := true;
end;

(*Procedure PPP_Object.ProcessLCPFrame(frame:pLCPFrame);
var
  LCP : Record
          _type   : byte;
          _length : byte;
        end;
Begin
  if frame=nil then exit;
  if (frame^.datasize>=2) then
   Begin
     lcp._type := getbyte(frame^.data_ptr);
     lcp._length := getbyte(frame^.data_ptr);
   end else fillchar(lcp,2,0);
  {$IFDEF DEBUG}
       writeln('ProcessLCPFrame');
       writeln('Type   : ',lcp._type);
       writeln('Length : ',lcp._length); {$ENDIF}
  case (frame^.code) of
    Configure_Request : case lcp._type of
                                0 : Begin
                                      SendLCPFrame(Configure_Ack,frame^.identifier,frame^.datasize,frame);
                                      if not(userinit) then
                                      if (addr(initfunc)<>nil) then
                                        Begin
                                          initfunc;
                                          userinit := true;
                                        end;
                                      phase := _ncd;
                                    end;
                                Maximum_Receive_Unit              : Request_MRU(frame);
                                {Authentication_Protocol          : writeln('Configure_Request Authentication');
                                Quality_Protocol                  : writeln('Configure_Request Quality');
                                Magic_Number                      : writeln('Configure_Request Magic Number');}
                                Protocol_Field_Compression        : Request_PFC(frame);
                                {Address_Control_Field_Compression : writeln('Configure_Request Control Field Compression');}
                            else
                            Begin
                              {$IFDEF DEBUG} writeln('LCP_Configure_Reject : ',lcp._type); {$ENDIF}
                              frame^.data_ptr := frame^.data;
                              SendLCPFrame(Configure_Reject,
                                           frame^.identifier,
                                           frame^.datasize,frame);
                            end;
                            end;
   Configure_Ack      : case lcp._type of
                          {0 : SendLCPFrame(Configure_ACK,frame^.identifier,0,frame);}
                          Protocol_Field_Compression : use_pfc := true;
                          Maximum_Receive_Unit : Set_MRU(frame);
                        end;
   {Configure_NAK      : ;
   Configure_Reject   : ;}
   Terminate_Request  : Begin
                          Terminate_ok := true;
                          phase := _lcp;
                          SendLCPFrame(Terminate_ACK,
                                       frame^.identifier,
                                       frame^.datasize,frame);
                          {$IFDEF DEBUG} writeln ('Terminate Request Received'); {$ENDIF}
                        end;
   Terminate_ACK      : Begin
                          phase := _lcp;
                          Terminate_ok := true;
                          {$IFDEF DEBUG} writeln('Terminate ACK Received'); {$ENDIF}
                            end;
   Code_Reject        : ;
   Protocol_Reject    : ;
   Echo_Request       : ;
   Echo_Reply         : ;
   Discard_Request    : ;
   else SendLCPFrame(CODE_REJECT,
                     frame^.identifier,
                     frame^.datasize,frame);
  end;
if not(userinit) then
  if (addr(initfunc)<>nil) then
    Begin
      initfunc;
      userinit := true;
    end;
end;
*)

Procedure PPP_Object.ProcesslcpFrame(frame:plcpFrame);
Const
  CIP : Array[1..6] of byte = (3,6,0,0,0,0);
var
  cr : byte;
  LCP: Record
          _type   : byte;
          _length : byte;
        end;
  lcp_nak : pbyte;
  lcp_ptr : pbyte;
  pos2 : word;
  lcp_pos : word;
  x : word;
  pl : word;
Begin
  if frame=nil then exit;
  getmem(lcp_nak,1024);
  lcp_ptr := lcp_nak;
  lcp_pos := 0;
  pos2 :=3;
  {$IFDEF DEBUG} writeln('lcp Code : ',frame^.code); {$ENDIF}

pl := frame^.length-4;
while (pl>0) do
 Begin
  {while (frame^.length-2>=pos2) do
   Begin}
     {$IFDEF DEBUG} writeln('Packet Length : ',frame^.length); {$ENDIF}
     lcp._type := getbyte(frame^.data_ptr);
     lcp._length := getbyte(frame^.data_ptr);
     dec(pl,2);
  {$IFDEF DEBUG} writeln('lcp Type   : ',lcp._type);
                 writeln('    Length : ',lcp._length); {$ENDIF}
  case (frame^.code) of
    Configure_ACK,
    Configure_Request  : case (lcp._type) of
                            Maximum_Receive_Unit :
                                 Begin
                                   Request_MRU(frame);
                                   dec(pl,2);
                                 end;
                            Protocol_Field_Compression :
                                 Begin
                                   use_pfc := true;
                                   {inc(pos2,);}
                                   {$IFDEF DEBUG} writeln ('[ACK PFC]'); {$ENDIF}
                                 end;
                            Address_Control_Field_Compression :
                                 Begin
                                   use_adfc := true;
                                   protocol_ofs := 1;
                                   {$IFDEF DEBUG} writeln ('[ACK ADFC]');{$ENDIF}
                                   {inc(pos2,2);}
                                 end;
                           else
                             Begin
                               lcp_ptr^ := lcp._type; inc(lcp_ptr); inc(lcp_pos);
                               lcp_ptr^ := lcp._length; inc(lcp_ptr); inc(lcp_pos);
                               if lcp._length-2>0 then
                                for x := 1 to (lcp._length-2) do
                                  Begin
                                    lcp_ptr^ := getbyte(frame^.data_ptr);
                                    inc(lcp_ptr); inc(lcp_pos); dec(pl);{inc(pos2);}
                                  end;
                              end;
                          end;
   Configure_NAK,
   Configure_Reject   : Begin
                          Sendlcp(CONFIGURE_REQUEST,random(256),0,nil);
                          freemem(lcp_nak,1024);
                          exit;
                        end;
   Terminate_ACK : Begin
                     freemem(lcp_nak,1024);
                     terminate_ok := true;
                     exit;
                   end;
   Terminate_REQUEST : Begin
                     freemem(lcp_nak,1024);
                     terminate_ok := true;
                     sendlcpframe(Terminate_ack,frame^.identifier,frame^.datasize,frame);
                     exit;
                   end;

   Echo_Request : Begin
                    freemem(lcp_nak,1024);
                    sendlcpframe(Echo_Reply,frame^.identifier,frame^.datasize,frame);
                    exit;
                  end;
   Echo_Reply   : Begin
                    freemem(lcp_nak,1024);
                    exit;
                  end;
   Protocol_Reject : Begin
                       {$IFDEF DEBUG} writeln('Protocol Reject!!!!!!'); {$ENDIF}
                       freemem(lcp_nak,1024);
                       exit;
                     end;
   Code_Reject : Begin
                   {$IFDEF DEBUG} writeln('CODE Reject!!!!!!'); {$ENDIF}
                   freemem(lcp_nak,1024);
                   exit;
                 end;
   Discard_Request : Begin
                       freemem(lcp_nak,1024);
                       exit;
                     end;
  else
    Begin
      SendlcpFrame(CODE_REJECT,
                   frame^.identifier,
                   frame^.datasize,frame);
      freemem(lcp_nak,1024);
      exit;
    end;
  end;
end;

frame^.data_ptr := frame^.data;
if (lcp_pos>0) then
  Begin
    freemem(frame^.data,frame^.datasize);
    getmem(frame^.data,lcp_pos);
    frame^.datasize := lcp_pos;
    frame^.data_ptr := frame^.data;
    lcp_ptr := lcp_nak;
    for x := 1 to lcp_pos do
      Begin
        frame^.data_ptr^ := lcp_ptr^;
        inc(frame^.data_ptr);
        inc(lcp_ptr);
      end;
    frame^.data_ptr := frame^.data;
    {$IFDEF DEBUG}
    writeln('Configure NAK : ',frame^.datasize); {$ENDIF}
    if frame^.code=CONFIGURE_REQUEST then
    SendlcpFrame(Configure_NAK,
                 frame^.identifier,
                 frame^.datasize,
                 frame);
  end else
    Begin
      if frame^.code=Configure_REQUEST then
      Begin
        {$IFDEF DEBUG} writeln('Configure ACK : ',frame^.datasize); {$ENDIF}
          sendlcpFrame(Configure_ACK,
                       frame^.identifier,
                       frame^.datasize,frame);
      end else
      if frame^.code=Configure_Ack then
      Begin
        phase := _NCD;
        sendncd(Configure_Request,random(256),4,makeptr(CIP));
        freemem(lcp_nak,1024);
        exit;
      end;
    end;

freemem(lcp_nak,1024);
end;

Function PPP_Object.GetLCPFrame:pLCPFrame;
var
 frame : pFrame;
Begin
  GetLCPFrame := nil;
  if NumLCPFrames=0 then exit;
  frame := First_Frame;
  while frame<>nil do
    Begin
      if (frame^.frame_complete) and (frame^.frame_type=LCD_Protocol) then
       Begin
         newLCPFrame(frame);
         disposeframe(frame);
         GetLCPFrame := cur_LCP_Frame;
         exit;
       end;
      frame := frame^.next;
    end;
end;

Procedure PPP_Object.Set_IP(var frame:pNCDFrame);
var
 x : byte;
 data : string[16];
begin
  {$IFDEF DEBUG} writeln('Set IP ');{$ENDIF}
  for x := 1 to 4 do ipaddr[x] := getbyte(frame^.data_ptr);
  {frame^.data_ptr := frame^.data;}
  ipstring := itos(ipaddr[1])+'.'+itos(ipaddr[2])+'.'+itos(ipaddr[3])+'.'+itos(ipaddr[4]);
  {$IFDEF DEBUG} writeln('IP Address : ',ipstring); {$ENDIF}
end;

Procedure PPP_Object.Set_VJ_hdrc(var frame:pNCDFrame);
var
 x : byte;
 data : string[16];
begin
  {$IFDEF DEBUG} writeln('Van Jacobson TCP/IP Header Compression <ACK>');{$ENDIF}
  vj_hdrc := true;
  ipcp      := getword(frame^.data_ptr);
  maxslotid := getbyte(frame^.data_ptr);
  compslotid := getbyte(frame^.data_ptr);
end;

Procedure PPP_Object.ProcessNCDFrame(frame:pNCDFrame);
Const
  CIP : Array[1..6] of byte = (3,6,0,0,0,0);
var
  NCD : Record
          _type   : byte;
          _length : byte;
        end;
  ncd_nak : pbyte;
  ncd_ptr : pbyte;
  ncd_pos : word;
  x : word;
  pl : word;
Begin
 { if (phase>_NCD) then phase := _NCD;}
  {if (phase<_NCD) then exit;}
  if frame=nil then exit;
  getmem(ncd_nak,1024);
  ncd_ptr := ncd_nak;
  ncd_pos := 0;
  {$IFDEF DEBUG} writeln('NCD Code : ',frame^.code); {$ENDIF}
  pl := frame^.length-4;
while (pl>0) do
 Begin
     {$IFDEF DEBUG} writeln('Packet Length : ',frame^.length); {$ENDIF}
     NCD._type := getbyte(frame^.data_ptr);
     NCD._length := getbyte(frame^.data_ptr);
     dec(pl,2);
  {$IFDEF DEBUG} writeln('NCD Type   : ',NCD._type);
                 writeln('    Length : ',NCD._length); {$ENDIF}
     case (frame^.code) of
    Configure_ACK,
    Configure_Request  : case (ncd._type) of
                            {2 : Begin
                                  Set_VJ_hdrc(frame);
                                  dec(pl,4);
                                end;}
                            3 : Begin
                                  Set_IP(frame);
                                  dec(pl,4);
                                end;
                           else
                             Begin
                               ncd_ptr^ := ncd._type; inc(ncd_ptr); inc(ncd_pos);
                               ncd_ptr^ := ncd._length; inc(ncd_ptr); inc(ncd_pos);
                               if ncd._length-2>0 then
                                for x := 1 to (ncd._length-2) do
                                  Begin
                                    ncd_ptr^ := getbyte(frame^.data_ptr);
                                    inc(ncd_ptr); inc(ncd_pos); dec(pl);
                                  end;
                              end;
                          end;
   Configure_NAK : case (ncd._type) of
                          3 : Begin
                                Set_IP(frame);
                                dec(pl,4);
                                cip[3] := ipAddr[1];
                                cip[4] := ipAddr[2];
                                cip[5] := ipAddr[3];
                                cip[6] := ipAddr[4];
                                SendNCD(CONFIGURE_REQUEST,random(256),6,makeptr(CIP));
                                freemem(ncd_nak,1024);
                                exit;
                              end;
                   end;
   Configure_Reject   : Begin
                          phase := _NCD;
                          SendNCD(CONFIGURE_REQUEST,random(256),0,nil);
                          freemem(ncd_nak,1024);
                          exit;
                        end;
  else
    Begin
      SendNCDFrame(CODE_REJECT,
                   frame^.identifier,
                   frame^.datasize,frame);
      freemem(ncd_nak,1024);
      exit;
    end;
  end;
end;

frame^.data_ptr := frame^.data;
if (ncd_pos>0) then
  Begin
    freemem(frame^.data,frame^.datasize);
    getmem(frame^.data,ncd_pos);
    frame^.datasize := ncd_pos;
    frame^.data_ptr := frame^.data;
    ncd_ptr := ncd_nak;
    for x := 1 to ncd_pos do
      Begin
        frame^.data_ptr^ := ncd_ptr^;
        inc(frame^.data_ptr);
        inc(ncd_ptr);
      end;
    frame^.data_ptr := frame^.data;
    {$IFDEF DEBUG}
    writeln('Configure NAK : ',frame^.datasize); {$ENDIF}
    phase := _NCD;
    {if frame^.code=CONFIGURE_REQUEST then}
    SendNCDFrame(Configure_NAK,
                 frame^.identifier,
                 frame^.datasize,
                 frame);
  end else
    Begin
      if (frame^.code=Configure_REQUEST) {or (frame^.code=CONFIGURE_NAK)} then
      Begin
        {$IFDEF DEBUG} writeln('NCD Configure ACK : ',frame^.datasize,' ',frame^.code); {$ENDIF}
        phase := _OPEN;
        sendNCDFrame(Configure_ACK,
                     frame^.identifier,
                     frame^.datasize,frame);
      end;
    end;

freemem(ncd_nak,1024);
end;

Function PPP_Object.GetNCDFrame:pNCDFrame;
var
 frame : pFrame;
Begin
  GetNCDFrame := nil;
  if NumNCDFrames=0 then exit;
  frame := First_Frame;
  while frame<>nil do
    Begin
      if (frame^.frame_complete) and (frame^.frame_type=NCD_Protocol) then
       Begin
         newNCDFrame(frame);
         disposeframe(frame);
         GetNCDFrame := cur_NCD_Frame;
         exit;
       end;
      frame := frame^.next;
    end;
end;

Function PPP_Object.GetIPFrame:pIPFrame;
var
 frame : pFrame;
Begin
  GetIPFrame := nil;
  if NumIPFrames=0 then exit;
  frame := First_Frame;
  while frame<>nil do
    Begin
      if (frame^.frame_complete) and (frame^.frame_type=IP_Protocol) then
       Begin
         oIP.AddIPFrame(frame);
         {$IFDEF SHOWINFO} delay(1000); {$ENDIF}
         disposeframe(frame);
         GetIPFrame := cur_IP_Frame;
         exit;
       end;
      frame := frame^.next;
    end;
end;

Procedure PPP_Object.AddtoFrame;
Begin
  if cur_frame=nil then
    Begin
      {$IFDEF DEBUG}
         writeln('[Attemting to Write to a NIL FRAME!]');
      {$ENDIF}
      PIP := false;
      exit;
    end;
  if (bte=complement) and not(cur_frame^.comp) then
   cur_frame^.comp := true else
   Begin
     inc(cur_frame^.frame_ptr);
     if cur_frame^.comp then
       Begin
         bte := bte xor $20;
         cur_frame^.comp := false;
       end;
      cur_frame^.frame_ptr^ := bte;
      inc(cur_frame^.frame_length);
      r_packetcrc := updatecrc(r_packetcrc,bte);
      {$IFDEF SHOWINFO} write(bte:3,'/'); {$ENDIF}
   end;
end;

Procedure PPP_Object.DisposeLCPFrame(frame:pLCPFrame);
Begin
  if frame=nil then exit;

  if frame=first_lcp_frame then first_lcp_frame := first_lcp_frame^.next;
  if frame=last_lcp_frame then last_lcp_frame := last_lcp_frame^.prev;
  if frame=cur_lcp_frame then cur_lcp_frame := cur_lcp_frame^.next;

  if frame^.prev<>nil then frame^.prev^.next := frame^.next;
  if frame^.next<>nil then frame^.next^.prev := frame^.prev;

  if frame^.datasize>0 then freemem(frame^.data,frame^.datasize);
  dispose(frame);
end;

Procedure PPP_Object.DisposeNCDFrame(frame:pNCDFrame);
Begin
  if frame=nil then exit;

  if frame=first_ncd_frame then first_ncd_frame := first_ncd_frame^.next;
  if frame=last_ncd_frame then last_ncd_frame := last_ncd_frame^.prev;
  if frame=cur_ncd_frame then cur_ncd_frame := cur_ncd_frame^.next;

  if frame^.prev<>nil then frame^.prev^.next := frame^.next;
  if frame^.next<>nil then frame^.next^.prev := frame^.prev;

  if frame^.datasize>0 then freemem(frame^.data,frame^.datasize);
  dispose(frame);
end;

Procedure PPP_Object.DisposeIPFrame(frame:pIPFrame);
Begin
  if frame=nil then exit;

  if frame=first_ip_frame then first_ip_frame := first_ip_frame^.next;
  if frame=last_ip_frame then last_ip_frame := last_ip_frame^.prev;
  if frame=cur_ip_frame then cur_ip_frame := cur_ip_frame^.next;

  if frame^.prev<>nil then frame^.prev^.next := frame^.next;
  if frame^.next<>nil then frame^.next^.prev := frame^.prev;

  if frame^.datasize>0 then freemem(frame^.data,frame^.datasize);
  dispose(frame);
end;

Procedure PPP_Object.NewLCPFrame(frame:Pframe);
var
 lframe : pLCPFrame;
Begin
  new(lframe);
  lframe^.code       := getbyte(frame^.frame_ptr);
  lframe^.identifier := getbyte(frame^.frame_ptr);
  lframe^.length     := getword(frame^.frame_ptr);
  lframe^.sendorreceive := receive;
  lframe^.data := nil;
  if (lframe^.length-4)>0 then
    Begin
      getmem(lframe^.data,lframe^.length-4);
      move(frame^.frame_ptr^,lframe^.data^,lframe^.length-4);
    end;
  lframe^.datasize := lframe^.length-4;
  lframe^.data_ptr := lframe^.data;
  lframe^.prev := last_LCP_frame;
  last_lcp_frame := lframe;
  cur_lcp_frame := lframe;
  lframe^.next := nil;
  if first_lcp_frame=nil then first_lcp_frame := lframe;
  if lframe^.prev<>nil then lframe^.prev^.next := lframe;
  cur_lcp_frame := lframe;
end;

{Procedure PPP_Object.NewIPFrame(frame:Pframe);
var
 lframe : pIPFrame;
Begin
  if frame^.frame_length-(Protocol_ofs+4)<1 then exit;
  new(lframe);
  lframe^.datasize := frame^.frame_length-(Protocol_Ofs+4);
  lframe^.sendorreceive := receive;
  lframe^.data := nil;
  getmem(lframe^.data,lframe^.datasize);
  move(frame^.frame_ptr^,lframe^.data^,lframe^.datasize);
  lframe^.data_ptr := lframe^.data;
  lframe^.prev := last_IP_frame;
  last_ip_frame := lframe;
  cur_ip_frame := lframe;
  lframe^.next := nil;
  if first_ip_frame=nil then first_ip_frame := lframe;
  if lframe^.prev<>nil then lframe^.prev^.next := lframe;
  cur_ip_frame := lframe;
end;
}

Procedure PPP_Object.NewNCDFrame(frame:Pframe);
var
 lframe : pNCDFrame;
Begin
  new(lframe);
  {if phase<_NCD then phase := _NCD;}
  lframe^.code       := getbyte(frame^.frame_ptr);
  lframe^.identifier := getbyte(frame^.frame_ptr);
  lframe^.length     := getword(frame^.frame_ptr);
  lframe^.sendorreceive := receive;
  lframe^.data := nil;
  if (lframe^.length-4)>0 then
    Begin
      getmem(lframe^.data,lframe^.length-4);
      move(frame^.frame_ptr^,lframe^.data^,lframe^.length-4);
    end;
  lframe^.datasize := lframe^.length-4;
  lframe^.data_ptr := lframe^.data;
  lframe^.prev := last_NCD_frame;
  last_ncd_frame := lframe;
  cur_ncd_frame := lframe;
  lframe^.next := nil;
  if first_ncd_frame=nil then first_ncd_frame := lframe;
  if lframe^.prev<>nil then lframe^.prev^.next := lframe;
  cur_ncd_frame := lframe;
end;

Procedure PPP_Object.HandleLCPFrames;
var
 frame : pLCPFrame;
 x : word;
Begin
 {if (phase<_LCP) then exit;}
 frame := First_LCP_Frame;
 while (frame<>nil) do
   Begin
     if (frame^.sendorreceive=send) then
      Begin
        SendPPP(LCD_Protocol,frame);
        DisposeLCPFrame(frame);
        exit;
      end else
      Begin
        ProcessLCPFrame(frame);
        DisposeLCPFrame(frame);
        exit;
      end;
     frame := frame^.next;
   end;
end;

Procedure PPP_Object.HandleIPFrames;
var
 frame : pIPFrame;
 x : word;
Begin
 {if (phase<_OPEN) then exit;}
 frame := First_IP_Frame;
 while (frame<>nil) do
   Begin
     if (frame^.sendorreceive=send) then
      Begin
        SendPPP(IP_Protocol,frame);
        DisposeIPFrame(frame);
        exit;
      end;
     frame := frame^.next;
   end;
end;

Procedure PPP_Object.HandleNCDFrames;
var
 frame : pNCDFrame;
 x : word;
Begin
 {if (phase<_NCD) then exit;}
 frame := First_NCD_Frame;
 while (frame<>nil) do
   Begin
     if (frame^.sendorreceive=send) then
       Begin
         SendPPP(NCD_Protocol,frame);
         DisposeNCDFrame(frame);
         exit;
      end else
      Begin
        ProcessNCDFrame(frame);
        DisposeNCDFrame(frame);
        exit;
      end;
     frame := frame^.next;
   end;
end;

Procedure PPP_Object.NewFrame;
var
 frame : pFrame;
Begin
  pip := true;
  r_packetcrc := $ffff;
  new(frame);
  frame^.frame_complete := false;
  frame^.frame_size := Frame_Size;
  frame^.frame_type := 0;
  frame^.frame_length := 0;
  frame^.comp := false;
  getmem(frame^.frame_data,frame^.frame_size);
  frame^.frame_ptr := frame^.frame_data;
  frame^.frame_ptr^ := Flag;
  frame^.prev := last_frame;
  last_frame := frame;
  cur_frame := frame;
  frame^.next := nil;
  if first_frame=nil then first_frame := frame;
  if cur_frame=nil then cur_frame := frame;
  if frame^.prev<>nil then frame^.prev^.next := frame;
  {$IFDEF SHOWINFO} writeln;writeln('[FRAME]'); {$ENDIF}
end;

Procedure PPP_Object.EndFrame;
var
 pfc : word;
 b1,b2 : byte;

Begin
  pip := false;
  inc(Cur_Frame^.frame_ptr);
  Cur_frame^.frame_ptr^ := Flag;
  cur_frame^.frame_complete := true;
  {$IFDEF SHOWINFO} writeln;{$ENDIF}

  if not(r_packetcrc=$f0b8) then
   Begin
     disposeframe(cur_frame);
     {$IFDEF DEBUG} writeln('Invalid CRC in Packet!'); {$ENDIF}
   end else
   Begin
     cur_frame^.frame_ptr := cur_frame^.frame_data;
     inc(cur_frame^.frame_ptr,protocol_ofs);
     if (use_pfc) then
      Begin
        b1 := getbyte(cur_frame^.frame_ptr);
        b2 := getbyte(cur_frame^.frame_ptr);
        if (b1=address) and (b2=control) then
          Begin
            b1 := getbyte(cur_frame^.frame_ptr);
            b2 := getbyte(cur_frame^.frame_ptr);
          end;
         if (b1 and 1)=1 then
          Begin
            {$IFDEF SHOWINFO} writeln('[CPF Frame Received!]');{$ENDIF}
            cur_frame^.frame_type := b1;
            dec(cur_frame^.frame_ptr);
          end else cur_frame^.frame_type := b1 shl 8 + b2;
      end else
        Begin
          cur_frame^.frame_type := getword(cur_frame^.frame_ptr);
          if cur_frame^.frame_Type = address shl 8 + control then
          cur_frame^.frame_type := getword(cur_frame^.frame_ptr);
        end;
     {$IFDEF SHOWINFO} writeln('Frame Type : ',cur_frame^.frame_type); {$ENDIF}
     if (cur_frame^.frame_type = IP_Protocol)  then inc(NumIPFrames) else
     if (cur_frame^.frame_type = LCD_Protocol) then inc(NumLCPFrames) else
     if (cur_frame^.frame_type = NCD_Protocol) then inc(NumNCDFrames);
   end;
  {$IFDEF SHOWINFO} {sound(500); delay(5); nosound;} writeln;writeln('[FRAME END]');{$ENDIF}
end;

Procedure PPP_Object.SendPPP;
var
 lcp_frame : pLCPFrame;
 ncd_frame : pNCDFRAME;
 ip_frame : pIPFrame;
 packetcrc : word;
 pc : word;
 x : word;
Begin
  packetcrc := $ffff;
  {$IFDEF SHOWINFO2}
    writeln;
    writeln('----------------- [ Send Packet ] -------------------');
    writeln('PFC : ',use_pfc,' ADFC : ',use_adfc,'  VANJ : ',vj_hdrc);
    writeln;
    case protocol of
      IP_Protocol : Writeln('IP Datagram');
      NCD_Protocol : Writeln('NCD Packet');
      LCD_Protocol : Writeln('LCP Packet');
      else writeln('*INVALID PROTOCOL*');
    end;
  {$ENDIF}

  sendchar(chr(flag));  {PPP Header Flag}
  if ((use_adfc) and (not(protocol=IP_PROTOCOL))) or
      (not(use_adfc)) then
   Begin
     sendbyte(address); packetcrc := updatecrc(packetcrc,address);
     sendbyte(control); packetcrc := updatecrc(packetcrc,control);
   end;

  if protocol=LCD_Protocol then
    Begin
      {$IFDEF DEBUG} writeln('Sending LCP Frame'); {$ENDIF}
      lcp_frame := pLCPFrame(data);
      lcp_frame^.data_ptr := lcp_frame^.data;

      sendword(lcd_protocol);
      packetcrc := updatecrc(packetcrc,lcd_protocol shr 8);
      packetcrc := updatecrc(packetcrc,lcd_protocol and $00ff);

      sendbyte(lcp_frame^.code);
      packetcrc := updatecrc(packetcrc,lcp_frame^.code);

      sendbyte(lcp_frame^.identifier);
      packetcrc := updatecrc(packetcrc,lcp_frame^.identifier);

      sendword(lcp_frame^.length);
      packetcrc := updatecrc(packetcrc,lcp_frame^.length shr 8);
      packetcrc := updatecrc(packetcrc,lcp_frame^.length and $00ff);

      for x := 1 to lcp_frame^.datasize do
        Begin
          packetcrc := updatecrc(packetcrc,lcp_frame^.data_ptr^);
          sendbyte(lcp_frame^.data_ptr^);
          {$IFDEF DEBUG} write (lcp_frame^.data_ptr^,'/'); {$ENDIF}
          inc(lcp_frame^.data_ptr);
        end;
      lcp_frame^.data_ptr := lcp_frame^.data;
    end else

  if protocol=NCD_Protocol then
    Begin
      {$IFDEF DEBUG} writeln('Sending NCD Frame'); {$ENDIF}
      ncd_frame := pNCDFrame(data);
      ncd_frame^.data_ptr := ncd_frame^.data;

      sendword(ncd_protocol);
      packetcrc := updatecrc(packetcrc,ncd_protocol shr 8);
      packetcrc := updatecrc(packetcrc,ncd_protocol and $00ff);

      sendbyte(ncd_frame^.code);
      packetcrc := updatecrc(packetcrc,ncd_frame^.code);

      sendbyte(ncd_frame^.identifier);
      packetcrc := updatecrc(packetcrc,ncd_frame^.identifier);

      sendword(ncd_frame^.length);
      packetcrc := updatecrc(packetcrc,ncd_frame^.length shr 8);
      packetcrc := updatecrc(packetcrc,ncd_frame^.length and $00ff);

      for x := 1 to ncd_frame^.datasize do
        Begin
          sendbyte(ncd_frame^.data_ptr^);
          packetcrc := updatecrc(packetcrc,ncd_frame^.data_ptr^);
          {$IFDEF DEBUG} write('[',ncd_frame^.data_ptr^,']');{$ENDIF}
          inc(ncd_frame^.data_ptr);
        end;
      ncd_frame^.data_ptr := ncd_frame^.data;
    end else

  if protocol=IP_Protocol then
    Begin
      {$IFDEF DEBUG} writeln; writeln('[Sending IP Frame]'); {$ENDIF}
      ip_frame := pIPFrame(data);
      ip_frame^.data_ptr := ip_frame^.data;


      if not(use_pfc) then
       Begin
         sendword(ip_protocol);
         packetcrc := updatecrc(packetcrc,ip_protocol shr 8);
         packetcrc := updatecrc(packetcrc,ip_protocol and $00ff);
       end else
       Begin
         sendbyte(ip_protocol and $00ff);
         packetcrc := updatecrc(packetcrc,ip_protocol and $00ff);
       end;


      for x := 1 to ip_frame^.datasize do
        Begin
          sendbyte(ip_frame^.data_ptr^);
          packetcrc := updatecrc(packetcrc,ip_frame^.data_ptr^);
          {$IFDEF IP2DEBUG} write(ip_frame^.data_ptr^,'³');{$ENDIF}
          inc(ip_frame^.data_ptr);
        end;
      ip_frame^.data_ptr := ip_frame^.data;
    end;

  packetcrc := finalcrc(packetcrc);
  sendword(packetcrc);
  sendchar(chr(flag));
end;

Procedure PPP_Object.HandleIncoming;
var
 bte : byte;
Begin
  while numchars>0 do
    Begin
      bte := ord(modem.getchar);
      case bte of
        Flag : If (PIP) then
                   Begin
                     if (cur_frame^.frame_ptr<>cur_frame^.frame_data) then EndFrame
                   end else NewFrame;
        else AddtoFrame(bte);
      end;
    end;
end;

Procedure PPP_Object.Packet_Driver;
Begin
  HandleIncoming; {Handles ALL Incoming Data}

  GetLCPFrame;     {Loads LCP Frames into pLCPFRAME}

  GetNCDFrame;     {Loads NCD Frames into pNCDFRAME}

  GetIPFrame;      {Loads IP Frames into pIPFRAME}

  HandleLCPFrames; {Processes all LCP Frames}
  HandleNCDFrames; {Processes all NCD Frames}

  if (transmitbufferused<defaultbuffersize-2048) then HandleIPFrames; {Processes all OUTGOING IP Frames}
  oIP.ProcessIPFrames; {Processes IP Packets}
end;

Function  PPP_Object.MakePtr(var variable):pbyte;
Begin
  Makeptr := addr(variable){ptr(seg(variable),ofs(variable))};
end;

Procedure PPP_Object.SendLCP(Code:byte;
                            Identifier:byte;
                            datalength:longint;data:pbyte);
var
 lframe : pLCPFrame;
 x : byte;
Begin
 new(lframe);
 lframe^.code          := code;
 lframe^.identifier    := identifier;
 lframe^.length        := datalength+4;
 lframe^.sendorreceive := send;
 if datalength>0 then getmem(lframe^.data,datalength) else
                      lframe^.data := nil;
 lframe^.datasize := datalength;
 lframe^.data_ptr := lframe^.data;
 if datalength>0 then move(data^,lframe^.data_ptr^,datalength);
 lframe^.prev := last_LCP_frame;
 cur_lcp_frame := lframe;
 last_lcp_frame := lframe;
 lframe^.next := nil;
 if first_lcp_frame=nil then first_lcp_frame := lframe;
 if lframe^.prev<>nil then lframe^.prev^.next := lframe;
end;

Procedure PPP_Object.SendNCD(Code:byte;
                             Identifier:byte;
                             datalength:longint;data:pbyte);
var
 lframe : pNCDFrame;
 x : byte;
Begin
 new(lframe);
 lframe^.code          := code;
 lframe^.identifier    := identifier;
 lframe^.length        := datalength+4;
 lframe^.sendorreceive := send;
 if datalength>0 then getmem(lframe^.data,datalength) else lframe^.data := nil;
 lframe^.datasize := datalength;
 lframe^.data_ptr := lframe^.data;
 if (datalength>0) then move(data^,lframe^.data_ptr^,datalength);
 lframe^.prev := last_NCD_frame;
 cur_ncd_frame := lframe;
 last_ncd_frame := lframe;
 lframe^.next := nil;
 if first_ncd_frame=nil then first_ncd_frame := lframe;
 if lframe^.prev<>nil then lframe^.prev^.next := lframe;
end;

Procedure PPP_Object.SendIP(datalength:longint;data:pbyte);
var
 lframe : pIPFrame;
 x : byte;
Begin
 if datalength=0 then exit;
 new(lframe);
 lframe^.sendorreceive := send;
 if datalength>0 then getmem(lframe^.data,datalength) else lframe^.data := nil;
 lframe^.datasize := datalength;
 lframe^.data_ptr := lframe^.data;
 if (datalength>0) then move(data^,lframe^.data_ptr^,datalength);
 lframe^.prev := last_IP_frame;
 cur_IP_frame := lframe;
 last_IP_frame := lframe;
 lframe^.next := nil;
 if first_IP_frame=nil then first_IP_frame := lframe;
 if lframe^.prev<>nil then lframe^.prev^.next := lframe;
end;

Procedure PPP_Object.FormatIP (b1,b2,b3,b4:byte; var ipt:iptype);
Begin
  ipt[1] := b1;
  ipt[2] := b2;
  ipt[3] := b3;
  ipt[4] := b4;
end;

Function  PPP_Object.IPstr (ip:iptype):string;
var
 s : string;
 x : integer;
Begin
 s := '';
 for x := 1 to 4 do
   Begin
     s := s + itos(ip[x]);
     if x<4 then s := s +'.';
   end;
ipstr := s;
end;

Function PPP_Object.ValidIP  (s:string):boolean;
var
 z : byte;
Begin
 validIP := false;
 z := 0;
 while (pos('.',s)>0) do
   Begin
     inc(z);
     s[pos('.',s)] := ' ';
   end;
 if z=3 then ValidIP := true;
end;

Function PPP_Object.StoIP(s:string;var IP:iptype):boolean;
var
 x,y : byte;
 ts : string;
Function stoi(s:string):byte;
var
 x : byte;
 e : integer;
Begin
 val(s,x,e);
 stoi := x;
end;
Begin
  stoip := false;
  if not(validip(s)) then exit;

for y := 1 to 4 do
 Begin
  ts := '';
  for x := 1 to pos('.',s)-1 do ts := ts + s[x];
  ip[y] := stoi(ts);
  delete(s,1,pos('.',s));
 end;
stoip := true;
end;

Function  PPP_Object.CanWrite:Boolean;
Begin
  CanWrite := TransmitBufferUsed=0;
end;

end.


Published in: Pascal
Download

Related snippets