如何IdTCPClient使用?

snowhj 2003-11-18 10:32:34
我想用delphi中的IdTCPClient控件与VC++所编写的SERVER程序进行通讯,但我刚学会DELPHI,很多控件不会用。请问如何才能通过此控件与VC++所编写的SERVER程序通讯。
vc++所编写的SERVER程序如下:
#import "C:\Program Files\Common Files\System\ado\msado15.dll" no_namespace rename("EOF", "adoEOF")
HRESULT hr;

void CServersocketDlg::OnListen()
{
if(!strsetup)
setup();
strsetup=1;
if(m_sock!=NULL)
{
closesocket(m_sock);
m_sock=NULL;
}
UpdateData(TRUE);
m_sock = socket(AF_INET,SOCK_STREAM,0);
if (m_sock == INVALID_SOCKET)
{
errnum=WSAGetLastError();
MessageBox("socket() failed", "Error", MB_OK);
closesocket(sock);
return;
}

local_sin.sin_family = AF_INET;
local_sin.sin_addr.S_un.S_addr = INADDR_ANY;
local_sin.sin_port= m_port;

if (bind(m_sock, (struct sockaddr FAR *) &local_sin, sizeof(local_sin)) == SOCKET_ERROR)
{
errnum=WSAGetLastError();
UpdateData(FALSE);
return;
}
if (listen(m_sock,1) < 0)
{
sprintf(szBuff, "%d is the error", WSAGetLastError());
MessageBox(szBuff, "listen(m_sock) failed", MB_OK);
return;
}
else
{
SetTimer(1,2000,NULL);
}
}
void CServersocketDlg::OnTimer(UINT nIDEvent)
{
char rev[20];
int status;
int strmsg=0;
int flag;

status = recv( sock, rev, 20, 0 );
if (status == SOCKET_ERROR)
{
//wsprintf(rev, "Error %d", WSAGetLastError());
//MessageBox(rev, "Error with recv()", MB_OK);
}
rev[status] = '\0';
m_rev=rev;
UpdateData(FALSE);

acc_sin_len = sizeof(acc_sin);
sock = accept(m_sock,(struct sockaddr FAR *) &acc_sin,(int FAR *) &acc_sin_len );
if (sock < 0)
{
sprintf(szBuff, "%d is the error", WSAGetLastError());
MessageBox(szBuff, "accept(sock) failed", MB_OK);
return;
}

CDialog::OnTimer(nIDEvent);
}
...全文
800 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
aiirii 2004-03-12
  • 打赏
  • 举报
回复
http://www.ccw.com.cn/applic/prog/htm2003/20031126_14CLP_2.asp
http://www.csdn.net/Develop/article/15%5C15592.shtm
Indy Client / Server 程序示例
by Mats Asplund 翻译:菩提葡萄
re-printed with permission of the author
original source from http://go.to/masdp


简介
这是一个使用Indy控件实现的Client/Server应用示例,分为客户/服务器两个程序。

当一个客户端连接到服务端程序时,服务端程序将返回一个0-9的标识符给客户端,并用一个小方块表示客户端程序的工作状态,而客户端程序每5秒钟改变一次工作状态(”工作/空闲“"working / idle")。当客户端断开时相应的方块将不可见,它的ID号也将释放并会分配给下一个连接上来的客户端程序。如果连接的客户端超过十个,服务器将返回一个”Full“标识给新连接上来的客户端。

Indy 组件是一套开放源代码的Blocking模式Socket组件,可以从这里免费下载:
www.nevrona.com/indy.

本示例程序可在这里下载



{----------------------------------------------------------------------
Unit Name: sUnit
Author: Mats Asplund, 2001-11-09
Purpose: Indy client/server示例, 服务器部分
----------------------------------------------------------------------}

unit sUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPServer,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
Timer1: TTimer;
Memo1: TMemo;
Label2: TLabel;
Edit1: TEdit;
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
procedure FormActivate(Sender: TObject);
private
ClientList: TStringList;
ClientStatus: array[0..9] of TShape;
procedure ShowClientStatus;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses IdTCPConnection;

{$R *.dfm}

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
ClientMsg: string;
begin
with AThread.Connection do
begin
// 读信息
ClientMsg := ReadLn('', -2);
// 如果客户端断开连接,则从ClintList中删除之
if Pos('disconnecting...', ClientMsg) > 1 then
begin
ClientList.Delete(ClientList.IndexOf(Copy(ClientMsg, 7, 1)));
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Visible := false;
end
else
// 否则按客户端状态更新图块
if Pos('working', ClientMsg) > 1 then
begin
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Visible := true;
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Brush.Color := clLime;
end
else
begin
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Visible := true;
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Brush.Color := clRed;
end;
Edit1.Text := ClientMsg;
end;
ShowClientStatus;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClientList := TStringList.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
n: integer;
begin
ClientList.Free;
for n := 0 to 9 do
ClientStatus[n].Free;
end;

procedure TForm1.ShowClientStatus;
begin
Memo1.Lines.Text := ClientList.Text;
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
n: integer;
Full: boolean;
begin
with AThread.Connection do
begin
Full:= true;
for n := 0 to 9 do
// 取第一个空闲的标识
if (ClientList.IndexOf(IntToStr(n)) = -1) then
begin
ClientList.Add(IntToStr(n));
// 将标识返回到客户端
WriteLn(IntToStr(n));
Full:= false;
Break;
end;
if Full then WriteLn('Server full');
end;
ShowClientStatus;
end;

procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin
ShowClientStatus;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
n: integer;
begin
// 建立十个不可见的块图
for n := 0 to 9 do
begin
ClientStatus[n] := TShape.Create(Self);
ClientStatus[n].Parent := Form1;
ClientStatus[n].Height := 10;
ClientStatus[n].Width := 10;
ClientStatus[n].Shape := stRectangle;
ClientStatus[n].Top := 35;
ClientStatus[n].Left := 8 + (15 * n);
ClientStatus[n].Visible := false;
end;
end;

end.

{----------------------------------------------------------------------
Unit Name: cUnit
Author: Mats Asplund, 2001-11-09
Purpose: Indy client/server示例, 客户端部分
----------------------------------------------------------------------}

unit cUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Timer1: TTimer;
IdTCPClient1: TIdTCPClient;
Label1: TLabel;
Shape1: TShape;
Edit1: TEdit;
Label2: TLabel;
Button1: TButton;
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
ServerDown, Idle: Boolean;
ClientNo: string;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
try
with IdTCPClient1 do
begin
Timer1.Interval:= 5000;
// Turn off timer in case of server going down.
Timer1.Enabled:= false;
Idle:= not Idle;
if Idle then
begin
Writeln('Client' + ClientNo + ' idle...');
Shape1.Brush.Color:= clRed;
// Turn it on again
Timer1.Enabled:= true;
end
else
begin
Writeln('Client' + ClientNo + ' working...');
Shape1.Brush.Color:= clLime;
// Turn it on again
Timer1.Enabled:= true;
end;
end;
except
on E: Exception do
begin
MessageDlg('The server is down.' + #13#10 +
'Restart the client some other time.', mtError, [mbOK], 0);
LAbel1.Caption:= 'No contact with server..';
ServerDown:= true;
end;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not ServerDown then
with IdTCPClient1 do
begin
Writeln('Client' + ClientNo + ' disconnecting...');
Disconnect;
end;
Action:= caFree;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
try
Timer1.Interval:= 1000;
Timer1.Enabled:= true;
// 连接到服务器
with IdTCPClient1 do
begin
Host:= Edit1.Text;
Connect;
// 读服务器返回的标识
ClientNo:= Readln('', 5000); // Timeout 5 secs
if ClientNo = 'Server full' then
begin
MessageDlg('There''s already ten clients connected. ' + #13#10 +
'Try connecting some other time !', mtWarning, [mbOK], 0);
end
else
if ClientNo = '' then
begin
Label1.Caption:= 'Client' + ClientNo + ' connection refused...';
end
else
begin
// Connection accepted by server.
ServerDown:= false;
Caption:= 'Client' + ClientNo;
Button1.Enabled:= false;
Label1.Caption:= 'Client' + ClientNo + ' connection accepted...';
end;
end;
except
on E: Exception do
begin
Label1.Caption:= 'Client' + ClientNo + ' connection refused...';
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerDown:= true;
end;

end.
xiaoqlj 2004-03-12
  • 打赏
  • 举报
回复
http://www.513soft.net:83/qlj/trans.rar

5,392

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧