indy - TIDTCPClient EAccessViolation
问题描述
我有一个带有 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
解决方案
正如 Remy 在将组件放在表单上并改为我们后建议的那样,一切正常。
推荐阅读
- javascript - 如何访问 /usr/share/javascript/jquery/ 文件?
- python - 在 Python 子类中使用 *args **kwargs 时如何保留参数建议
- google-analytics - 将数据从 Google Analytics 迁移到 AWS Athena
- r - R中的不同高度金字塔图
- python - 使用新对象更新记录
- php - AWS Beanstalk 上的 PHP 日志异常
- r - 如何使用R中的for循环成对显示数字
- python - 如何在 PyCharm 中自动竞争参数?
- postgresql - PostgreSQL 中的 ULID 本机支持
- azure-devops - 通过 DevOps Rest API 向 Azure DevOps 管道用户添加 SSH 密钥