TIDTCPClient EAccessViolation

时间:2019-05-28 17:24:31

标签: indy delphi-xe6

我有一个带有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

1 个答案:

答案 0 :(得分:0)

正如雷米(Remy)所建议的那样,将组件拖放到表单上之后,一切取而代之,一切正常。