我有一个带有RFTT服务的RFID阅读器。我启动了该服务,并尝试使用TidTCPClient访问它,但是尝试连接时会遇到访问冲突。读取地址00000000 只要单击“连接”,我就会收到消息。
unit UClient;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdThreadComponent;
type
TFClient = class(TForm)
Label1 : TLabel;
Label2 : TLabel;
messageToSend : TMemo;
messagesLog : TMemo;
btn_connect : TButton;
btn_disconnect: TButton;
btn_send : TButton;
procedure FormShow(Sender: TObject);
procedure btn_connectClick(Sender: TObject);
procedure btn_disconnectClick(Sender: TObject);
procedure btn_sendClick(Sender: TObject);
procedure IdTCPClientConnected(Sender: TObject);
procedure IdTCPClientDisconnected(Sender: TObject);
procedure IdThreadComponentRun(Sender: TIdThreadComponent);
procedure Display(p_sender: String; p_message: string);
function GetNow():String;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
// ... listening port : GUEST CLIENT
const GUEST_PORT = 5733;
var
FClient : TFClient;
// ... TIdTCPClient
idTCPClient : TIdTCPClient;
// ... TIdThreadComponent
idThreadComponent : TIdThreadComponent;
implementation
{$R *.dfm}
procedure TFClient.FormCreate(Sender: TObject);
begin
// ... create TIdTCPClient
idTCPClient := TIdTCPClient.Create();
// ... set properties
idTCPClient.Host := 'localhost';
idTCPClient.Port := GUEST_PORT;
idTCPClient.ConnectTimeout := 5000;
// ... etc..
// ... callback functions
idTCPClient.OnConnected := IdTCPClientConnected;
idTCPClient.OnDisconnected := IdTCPClientDisconnected;
// ... etc..
// ... create TIdThreadComponent
idThreadComponent := TIdThreadComponent.Create();
// ... callback functions
idThreadComponent.OnRun := IdThreadComponentRun;
// ... etc..
end;
procedure TFClient.FormShow(Sender: TObject);
begin
// ... INITAILIZE
// ... message to send
messageToSend.Clear;
messageToSend.Enabled := False;
// ... clear log
messagesLog.Clear;
// ... buttons
btn_connect.Enabled := True;
btn_disconnect.Enabled := False;
btn_send.Enabled := False;
end;
procedure TFClient.btn_connectClick(Sender: TObject);
begin
// ... disable connect button
btn_connect.Enabled := False;
// ... try to connect to Server
try
IdTCPClient.Connect;
except
on E: Exception do begin
Display('CLIENT', 'CONNECTION ERROR! ' + E.Message);
btn_connect.Enabled := True;
end;
end;
end;
procedure TFClient.btn_disconnectClick(Sender: TObject);
begin
// ... is connected?
if IdTCPClient.Connected then begin
// ... disconnect from Server
IdTCPClient.Disconnect;
// ... set buttons
btn_connect.Enabled := True;
btn_disconnect.Enabled := False;
btn_send.Enabled := False;
messageToSend.Enabled := False;
end;
end;
procedure TFClient.IdTCPClientConnected(Sender: TObject);
begin
// ... messages log
Display('CLIENT', 'CONNECTED!');
// ... after connection is ok, run the Thread ... waiting messages from server
IdThreadComponent.Active := True;
// ... set buttons
btn_connect.Enabled := False;
btn_disconnect.Enabled := True;
btn_send.Enabled := True;
// ... enable message to send
messageToSend.Enabled := True;
end;
procedure TFClient.IdTCPClientDisconnected(Sender: TObject);
begin
// ... message log
Display('CLIENT', 'DISCONNECTED!');
end;
procedure TFClient.IdThreadComponentRun(Sender: TIdThreadComponent);
var
msgFromServer : string;
begin
// ... read message from server
msgFromServer := IdTCPClient.IOHandler.ReadLn();
// ... messages log
Display('SERVER', msgFromServer);
end;
procedure TFClient.Display(p_sender : String; p_message : string);
begin
TThread.Queue(nil, procedure
begin
MessagesLog.Lines.Add('[' + p_sender + '] - '
+ GetNow() + ': ' + p_message);
end
);
end;
function TFClient.getNow() : String;
begin
Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) + ': ';
end;
end.
不幸的是,这是整个程序,我必须把所有这些文本放进去,因为它不会让我发布没有更详细的文本。
感谢您的帮助, KimHJ
答案 0 :(得分:0)
正如雷米(Remy)所建议的那样,将组件拖放到表单上之后,一切取而代之,一切正常。