ICSTCP控件的使用

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OverbyteIcsWndControl, OverbyteIcsWSocket,
OverbyteIcsWSocketS;
type
TForm1 = class(TForm)
WSocketServer1: TWSocketServer;
WSocket1: TWSocket;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure WSocketServer1ClientConnect(Sender: TObject;
Client: TWSocketClient; Error: Word);
procedure WSocketServer1ClientDisconnect(Sender: TObject;
Client: TWSocketClient; Error: Word);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure WSocketServer1DataAvailable(Sender: TObject; ErrCode: Word);
procedure WSocketServer1ChangeState(Sender: TObject; OldState,
NewState: TSocketState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
//start listen...
try
WSocketServer1.Close;
WSocketServer1.Addr :='127.0.0.1';
WSocketServer1.Port :='6000';
//WSocketServer1.Banner:='';
//WSocketServer1.BannerTooBusy:='';
//WSocketServer1.ClientClass := TWSocketClient;
WSocketServer1.Listen;
except

end;
end;

procedure TForm1.WSocketServer1ClientConnect(Sender: TObject;
Client: TWSocketClient; Error: Word);
begin

//注意:ICS TCP SERVER收到客户端连接进,必须要将数据处理事件方法入口委托到给客户端Client的处理方法入口,否则无法响应收数据的事件。
Client.OnDataAvailable := WSocketServer1DataAvailable;

Memo1.Lines.Add( Format('Client [%s:%s] Connected..',[ Client.GetPeerAddr,client.GetPeerPort]));
end;

procedure TForm1.WSocketServer1ClientDisconnect(Sender: TObject;
Client: TWSocketClient; Error: Word);
begin
Memo1.Lines.Add( Format('Client [%s:%s] disConnected..',[ Client.GetPeerAddr,client.GetPeerPort]));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
try
WSocket1.Addr :='127.0.0.1';
WSocket1.Port :='6000';
WSocket1.Connect;
except

end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
WSocket1.Close;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
WSocketServer1.Close;
end;

procedure TForm1.Button5Click(Sender: TObject);
var i,sendlen:Integer; sendbuff:array[0..32] of byte; data:Pointer; str:string;
begin
if WSocket1.State = wsConnected then
begin
FillChar(sendbuff,33,0);
str:='';
for i:=0 to 31 do
begin
sendbuff[i] := Random(256) ;
str := str +' '+inttohex( sendbuff[i] ,2);
end;
sendlen := 32;
data := @sendbuff;
WSocket1.Send( data, sendlen );
Memo1.Lines.Add( Format('==>[%s:%s];Sendlen=%d; data:"%s"',
[WSocket1.Addr,WSocket1.Port, sendlen, str]));
end;
end;

procedure TForm1.WSocketServer1DataAvailable(Sender: TObject;
ErrCode: Word);
var
buffer:array [0..1023] of Byte;
recvLen:Integer;
str,
strData:string;i:Integer;
client:TWSocketClient;
readBuffer:Pointer;
begin
client := TWSocketClient(Sender);
if Assigned( client ) then
begin
FillChar(buffer,1024,0);
recvLen := client.RcvdCount;
readBuffer := @buffer;
recvLen := client.Receive( readBuffer, recvLen );
//str := client.ReceiveStr;
strData :='';str:='';
for i:=0 to recvLen-1 do begin
strData:=strdata+' '+inttohex( buffer[i], 2);
str:=str+char( buffer[i] )
end;
Memo1.Lines.Add( Format('<==[%s:%s];RecvLen=%d; hex:"%s";data:"%s";',
[client.GetPeerAddr,client.GetPeerPort,recvLen,trim(strdata),str]) );
end;
end;

procedure TForm1.WSocketServer1ChangeState(Sender: TObject; OldState,
NewState: TSocketState);
begin
case NewState of
wsListening:
begin
Memo1.Lines.Add('TCP Server Start listening...')
end;
end;
end;
end.

  • 2
    点赞
  • 4
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
最新版的ics支持d7-xe10.1,还支持OpenSSL-Win32 主要控件请见OverbyteIcsReg.pas uses {$IFDEF FMX} FMX.Types, Ics.Fmx.OverbyteIcsWndControl, Ics.Fmx.OverbyteIcsWSocket, Ics.Fmx.OverbyteIcsDnsQuery, Ics.Fmx.OverbyteIcsFtpCli, Ics.Fmx.OverbyteIcsFtpSrv, Ics.Fmx.OverbyteIcsMultipartFtpDownloader, Ics.Fmx.OverbyteIcsHttpProt, Ics.Fmx.OverbyteIcsHttpSrv, Ics.Fmx.OverbyteIcsMultipartHttpDownloader, Ics.Fmx.OverbyteIcsHttpAppServer, Ics.Fmx.OverbyteIcsCharsetComboBox, Ics.Fmx.OverbyteIcsPop3Prot, Ics.Fmx.OverbyteIcsSmtpProt, Ics.Fmx.OverbyteIcsNntpCli, Ics.Fmx.OverbyteIcsFingCli, Ics.Fmx.OverbyteIcsPing, {$IFDEF USE_SSL} Ics.Fmx.OverbyteIcsSslSessionCache, Ics.Fmx.OverbyteIcsSslThrdLock, {$ENDIF} Ics.Fmx.OverbyteIcsWSocketE, Ics.Fmx.OverbyteIcsWSocketS, {$ENDIF FMX} {$IFDEF VCL} Controls, OverbyteIcsWndControl, OverbyteIcsWSocket, OverbyteIcsDnsQuery, OverbyteIcsFtpCli, OverbyteIcsFtpSrv, OverbyteIcsMultipartFtpDownloader, OverbyteIcsHttpProt, OverbyteIcsHttpSrv, OverbyteIcsMultipartHttpDownloader, OverbyteIcsHttpAppServer, OverbyteIcsCharsetComboBox, OverbyteIcsPop3Prot, OverbyteIcsSmtpProt, OverbyteIcsNntpCli, OverbyteIcsFingCli, OverbyteIcsPing, {$IFDEF USE_SSL} OverbyteIcsSslSessionCache, OverbyteIcsSslThrdLock, {$ENDIF} OverbyteIcsWSocketE, OverbyteIcsWSocketS, OverbyteIcsSysLogClient, OverbyteIcsSysLogServer, OverbyteIcsSnmpCli, OverbyteIcsSmtpSrv, // VCL only OverbyteIcsMultiProgressBar, OverbyteIcsEmulVT, OverbyteIcsTnCnx, OverbyteIcsTnEmulVT, OverbyteIcsTnScript, {$IFNDEF BCB} OverbyteIcsWSocketTS, {$ENDIF} {$ENDIF VCL} {$IFDEF ICS_COMMON} OverbyteIcsMimeDec, OverbyteIcsMimeUtils, OverbyteIcsTimeList, OverbyteIcsLogger, {$IFNDEF BCB} OverbyteIcsCookies, {$ENDIF !BCB} {$ENDIF} {$IFDEF RTL_NAMESPACES}System.SysUtils{$ELSE}SysUtils{$ENDIF}, {$IFDEF RTL_NAMESPACES}System.Classes{$ELSE}Classes{$ENDIF}; procedure Register; implementation
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

ljklxlj

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值