I have a RFID reader that comes with a RFTT service. I start the service and try to access it with TidTCPClient, but I get an access violation as soon I try to connect. Read of Address 00000000
As soon it click connect I get the message.
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.
This is the whole program unfortunately I have to put all this text because it will not let me post with out more detailed text.
Thanks for any help,
KimHJ
As Remy suggested after dropping the component on the form and us those instead, everything worked fine.
The program freezes as usual. how to do in the flow ?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdCookieManager, IdIOHandler, IdIOHandlerSocket,
IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, ExtCtrls, Unit2;
type
TForm1 = class(TForm)
IdHTTP1: TIdHTTP;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
IdCookieManager1: TIdCookieManager;
Button1: TButton;
Memo1: TMemo;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
private
my:myth;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
my:=myth.Create(true);
my.Priority:=tpNormal;
my.FreeOnTerminate:=True;
my.Resume;
end;
end.
FLOW
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdCookieManager, IdIOHandler, IdIOHandlerSocket,
IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, ExtCtrls;
type
myth = class(TThread)
IdHTTP1: TIdHTTP;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
IdCookieManager1: TIdCookieManager;
Button1: TButton;
Memo1: TMemo;
Timer1: TTimer;
private
{ Private declarations }
protected
procedure Execute; override;
procedure meme;
public
end;
implementation
uses Unit1;
procedure myth.Execute;
begin
Synchronize(meme);
end;
procedure myth.meme;
var
s: string;
list, lista: TStringList;
resul: string;
begin
list := TStringList.Create;
Form1.Memo1.Clear;
list.Add('...');
list.Add('...');
list.Add('...');
list.Add('...');
s := IdHTTP1.Post('https://,list);
list.Free;
(LOGIN)
resul := idHTTP1.Get('...');
while Pos('tdn',resul) > 0 do begin //PRESS ON BUTTON
lista := TStringList.Create;
lista.Add('...');
IdHTTP1.Post('https:...,lista);
lista.Free;
end;
end;
end.
You are creating a worker thread just to Synchronize() all of its work back to the main UI thread. Don't do that! Only synchronize the pieces that actually need it. Have the thread call meme() directly without Synchronize(), and then have meme() use Synchronize() to access Form1.Memo1 and anything else that touches the UI. Your TStringList and TIdHTTP operations themselves don't need to be synchronized since they are local to meme() (if you create your IdHTTP1, IdSSLIOHandlerSocketOpenSSL1, and IdCookieManager1 objects dynamically in the thread, instead of on the Form at design-time).
Try something more like this instead:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Unit2;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
private
my: myth;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
my := myth.Create;
end;
end.
FLOW
unit Unit2;
interface
uses
Classes, IdCookieManager, IdSSLOpenSSL, IdHTTP;
type
myth = class(TThread)
IdHTTP: TIdHTTP;
IdSSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
IdCookieManager: TIdCookieManager;
private
{ Private declarations }
procedure meme;
protected
procedure Execute; override;
public
constructor Create; reintroduce;
destructor Destroy; override;
end;
implementation
uses Unit1;
constructor myth.Create;
begin
inherited Create(False);
Priority := tpNormal;
FreeOnTerminate := True;
IdHTTP := TIdHTTP.Create(nil);
IdSSLIOHandlerSocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP);
// configure as needed...
IdHTTP.IOHandler := IdSSLIOHandlerSocketOpenSSL;
IdCookieManager := TIdCookieManager.Create(IdHTTP);
// configure as needed...
IdHTTP.CookieManager := IdCookieManager;
end;
destructor myth.Destroy;
begin
IdHTTP.Free;
inherited;
end;
procedure myth.Execute;
begin
meme;
end;
procedure myth.meme;
var
list: TStringList;
resul: string;
begin
list := TStringList.Create;
try
Synchronize(ClearMemo);
list.Add('...');
list.Add('...');
list.Add('...');
list.Add('...');
s := IdHTTP1.Post('https://...', list);
list.Clear;
...
resul := IdHTTP1.Get('...');
while Pos('tdn', resul) > 0 do begin
list.Clear;
list.Add('...');
IdHTTP1.Post('https://...', list);
list.Clear;
end;
finally
list.Free;
end;
end;
procedure myth.ClearMemo;
begin
Form1.Memo1.Clear;
end;
end.
While implementing my own observer framework I got a problem: I can't execute procedures of object when they are returned in getter. I have here an example program for Lazarus. What should I do to see "TRUE" in console? (Now program returns false). It's a complete program, you can just copy-paste it.
program project1;
{$mode objfpc}
uses
SysUtils,
Classes;
type
TEvent = procedure of object;
{ IInterface }
IInterface = interface
function GetEvent: TEvent;
procedure SetEvent(AValue: TEvent);
property Event: TEvent read GetEvent write SetEvent;
end;
{ TMYClass }
TMYClass = class(TInterfacedObject, IInterface)
private
FEvent: TEvent;
public
function GetEvent: TEvent;
procedure SetEvent(AValue: TEvent);
property Event: TEvent read GetEvent write SetEvent;
end;
{ TAnotherClass }
TAnotherClass = class
FVariable: boolean;
constructor Create;
procedure Handler;
end;
{ TAnotherClass }
constructor TAnotherClass.Create;
begin
FVariable := False;
end;
procedure TAnotherClass.Handler;
begin
FVariable := True;
end;
function TMYClass.GetEvent: TEvent;
begin
Result := FEvent;
end;
procedure TMYClass.SetEvent(AValue: TEvent);
begin
FEvent := AValue;
end;
var
LInterface: IInterface;
LAnother: TAnotherClass;
begin
LInterface := TMYClass.Create;
LAnother := TAnotherClass.Create;
LInterface.Event:=#LAnother.Handler;
LInterface.Event;
WriteLn(LAnother.FVariable);
ReadLn();
end.
When I debug this, it looks as if Result isn't assigned in TMYClass.GetEvent. Do you know, what is my problem?
I have to make project in Delphi. I made an array of buttons and an array of images. I want to show Image[i] when I click button[i].
Can somebody help please?
How about using the button's tag property to store a pointer to the correlating image. I'm unsure of your Array structure but here's a code snippet to demonstrate.
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Button2: TButton;
Image2: TImage;
procedure FormCreate(Sender: TObject);
private
FMyCurrentImage : TImage; //Keeps track of the current image
procedure MyButtonClick(Sender: TObject);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyCurrentImage := nil;
Button1.Tag := Integer(Image1);
Button1.OnClick := MyButtonClick;
Image1.Hide;
Button2.Tag := Integer(Image2);
Button2.OnClick := MyButtonClick;
Image2.Hide;
end;
procedure TForm1.MyButtonClick(Sender: TObject);
begin
if Sender is TButton then
with Sender as TButton do
if Assigned(TImage(Tag)) then
begin
//Hide the previously selected image
if Assigned(FMyCurrentImage) then
FMyCurrentImage.Hide;
//Assign and show the clicked button's image
FMyCurrentImage := TImage(Tag);
FMyCurrentImage.Show;
end;
end;
What kind of component are you using in your form to show the image?
I don't know what you really need, but here's something I guess you'd want:
I have created three components in the form to test it: two TButton's and one of TImage type.
TfrmTest = class(TForm)
btn1: TButton;
btn2: TButton;
img: TImage;
procedure showImage(sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
In the var section:
var
frmTest: TfrmTest;
imagesArray: array[1..2] of String = ('blue.jpg', 'red.jpg');
buttonsArray: array[1..2] of String = ('btn1', 'btn2');
The implementation of your event:
procedure TfrmTest.showImage(sender: TObject);
var
i: integer;
begin
for i := low(buttonsArray) to high(buttonsArray) do
begin
if (buttonsArray[i] = TButton(sender).name) then
begin
img.picture.loadFromFile('your images directory path here' + imagesArray[i]);
break;
end;
end;
end;
In the Object Inspector, you need to set the OnClick event of your buttons with the showImage procedure.
I apologize for having another similar question but I was hoping to find a simpler solution to a problem I am having.
I have a listview in form1 that I want form2 to be able to add to. Form2 is created by form1 by a button press. Form2 has a listview and when I click on a button in form2 I want it to add all items to the listview in form1 and close form2. What is the simplest way to accomplish this?
*I tried using windows messaging but for some reason Lazarus doesn't work with TWM_CopyData.
Since I would prefer the unit referencing, here is what might help you. In the Form2 is declared public property TargetListView into which is assigned the list view from the Form1 before the Form2 is shown. Now you have the access to the Form1 list view from the Form2 scope and you can copy the items there before you close it.
Here is the simplified code for the first unit:
unit Unit1;
uses
Unit2;
type
TForm1 = class(TForm)
Button1: TButton;
ListView1: TListView;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2 := TForm2.Create(Self);
Form2.TargetListView := ListView1;
Form2.Show;
end;
And here is the simplified code for the second unit:
unit Unit2;
type
TForm2 = class(TForm)
Button1: TButton;
ListView1: TListView;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
TargetListView: TListView;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
I: Integer;
begin
TargetListView.Items.BeginUpdate;
try
for I := 0 to ListView1.Items.Count - 1 do
TargetListView.Items.Add.Assign(ListView1.Items[I]);
finally
TargetListView.Items.EndUpdate;
end;
Close;
end;