PPP
{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.
