/tags/Beta_3_70_2/ObjCOM/octwin.inc
# · Pascal · 218 lines · 116 code · 57 blank · 45 comment · 8 complexity · 9d97b11693d27de3b81f7c84b623aec6 MD5 · raw file
- (*
- ** ObjCOM tcp communication implementation include file
- **
- ** Written by M.Kiesel 2000
- *)
- Const WriteTimeout = 20000; { Wait max. 20 secs }
- ReadTimeOut = 20000; { General event, 20 secs max }
- Const TelnetCarrier : Boolean = true;
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- constructor TTelnetObj.Init;
- begin
- SOpened:=False; Dontclose:=False; InBuffer.Init(8192); IgnoreCD:=True;
- inherited Init;
- end; { constructor Init }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- destructor TTelnetObj.Done;
- begin
- InBuffer.Done;
- inherited done;
- end; { destructor Done }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.GetHandle: Longint;
- begin
- GetHandle:=SHandle;
- end; { func. GetHandle }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.OpenQuick(Handle: Longint);
- begin
- end; { proc. TTelnetObj.OpenQuick }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.OpenKeep(Comport: Byte): Boolean;
- begin
- OpenKeep:=False;
- end; { func. OpenKeep }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.ProcIncoming;
- var C: Char;
- begin
- while not eof(SIn)do
- begin Read(SIn,C); InBuffer.Put(C,SizeOf(C))end;
- end;
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.Connect(Dest: String): Boolean;
- const isocket: TInetSockAddr= (Family:AF_INET;Port:$274E;Addr:$0100A8C0);
- begin
- Connect:=False;
- SHandle:=Socket(AF_INET,SOCK_STREAM,0);
- if SocketError<>0 then begin ErrorStr:='Error opening socket'; exit end;
- if not Sockets.Connect(SHandle,isocket,SIn,SOut)then begin ErrorStr:='Error connecting socket'; exit end;
- ReWrite(sout); Reset(sin); SOpened:=True; Connect:=True;
- end; { func. TTelnetObj.OpenCom }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
- begin
- // Duhhh ;)
- end; { proc. TTelnetObj.SetLine }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.Close;
- begin
- if DontClose then EXIT;
- shutdown(SHandle,2); System.Close(SIn); System.Close(SOut); SOpened:=False;
- end; { func. TTelnetObj.CloseCom }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.SendChar(C: Char): Boolean;
- begin
- write(SOut,C); SendChar:=True;
- end; { proc. TTelnetObj.SendChar }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.GetChar: Char;
- var R: Char;
- begin
- ProcIncoming; InBuffer.Get(R,SizeOf(R),True); GetChar:=R;
- end; { func. TTelnetObj.GetChar }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- type CBuffer= array[1..65000]of Char;
- procedure TTelnetObj.SendBlock(var Block; BlockLen: Longint; var Written: Longint);
- var i: Longint;
- begin
- for i:=1 to BlockLen do write(SOut,CBuffer(Block)[i]);
- Written:=BlockLen;
- end; { proc. TTelnetObj.SendBlock }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
- begin
- repeat ProcIncoming until CharCount>=BlockLen;
- InBuffer.Get(Block,Blocklen,True);
- Reads:=BlockLen;
- end; { proc. TTelnetObj.ReadBlock }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.CharAvail: Boolean;
- begin
- ProcIncoming; CharAvail:=InBuffer.BufUsed>0;
- end; { func. TTelnetObj.CharAvail }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.CharCount: Integer;
- begin
- ProcIncoming; CharCount:=InBuffer.BufUsed;
- end; { func. TTelnetObj.CharAvail }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.Carrier: Boolean;
- begin
- Carrier:=SOpened;
- end; { func. TTelnetObj.Carrier }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.GetModemStatus(var LineStatus, ModemStatus: Byte);
- begin
- LineStatus := 00;
- ModemStatus := 08;
- if Carrier then ModemStatus := ModemStatus OR (1 SHL 7);
- end; { proc. TTelnetObj.GetModemStatus }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.SetDtr(State: Boolean);
- begin
- if NOT State then Close;
- end; { proc. TTelnetObj.SetDtr }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.GetBpsRate: Longint;
- begin
- GetBpsRate := 115200;
- end; { func. TTelnetObj.GetBpsRate }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
- begin
- InFree:=InBuffer.BufRoom; OutFree:=65000; InUsed:=InBuffer.BufRoom; OutUsed:=0;
- end; { proc. TTelnetObj.GetBufferStatus }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.PurgeInBuffer;
- begin
- InBuffer.Clear;
- end; { proc. TTelnetObj.PurgeInBuffer }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.PurgeOutBuffer;
- begin
- end; { proc. TTelnetObj.PurgeInBuffer }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- function TTelnetObj.ReadyToSend(BlockLen: Longint): Boolean;
- begin
- ReadyToSend := True;
- end; { func. ReadyToSend }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.PauseCom(CloseCom: Boolean);
- begin
- end; { proc. PauseCom }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- procedure TTelnetObj.ResumeCom(OpenCom: Boolean);
- begin
- end; { proc. ResumeCom }
- (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
- {
- $Log: octwin.inc,v $
- Revision 1.3 2000/09/29 23:21:15 ma
- - SendChar result := true
- Revision 1.2 2000/09/11 23:00:13 ma
- - provisional outgoing TCP support added
- Revision 1.1 2000/06/22 17:30:02 mk
- - initial release
- - please keep comments in English
- }