I'm building a tool that sends a request besides my browser request using TIdMappedPortTCP from Indy 9.
I want to use string #$d#$A (line breaks) by writing it in memo as %0D%0A
but it's not working fine, as you can see in the image.
What's the correct code I should use to make this work?
procedure TForm1.IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
var
memo:string;
begin
memo:= Memo1.text;
if Combobox4.text='Back' then begin
AThread.NetData := AThread.NetData +memo ;
form2.Memo1.Lines.Add(AThread.NetData);
TIdMappedPortTCP is a multi-threaded component. The OnExecute event is triggered in the context of a worker thread. You CANNOT access your TMemo and TComboBox controls directly like you have shown. You MUST synchronize with the UI thread in order to access them safely and correctly.
Try something more like this:
uses
..., IdSync;
type
TGetForm1BackMemoTextSync = class(TIdSync)
protected
FText: string;
procedure DoSynchronize; override;
public
class function GetText: string;
end;
TAddToForm2MemoSync = class(TIdSync)
protected
FText: string;
procedure DoSynchronize; override;
public
class procedure AddToMemo(const S: string);
end;
procedure TGetForm1BackMemoTextSync.DoSynchronize;
begin
if Form1.ComboBox4.Text = 'Back' then
FText := Form1.Memo1.Text;
end;
class function TGetForm1BackMemoTextSync.GetText: string;
begin
with Create do
try
Synchronize;
Result := FText;
finally
Free;
end;
end;
procedure TAddToForm2MemoSync.DoSynchronize;
begin
Form2.Memo1.Lines.Add(FText);
end;
class procedure TAddToForm2MemoSync.AddToMemo(const S: string);
begin
with Create do
try
FText := S;
Synchronize;
finally
Free;
end;
end;
//...
procedure TForm1.IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
var
memo: string;
begin
memo := TGetMemoBackTextSync.GetText;
if memo <> '' then begin
AThread.NetData := AThread.NetData + memo;
TAddToForm2MemoSync.AddToMemo(AThread.NetData);
//...
end;
With that said, you should not be putting %0D%0A in the Memo text at all. Each line in a Memo is already separated by a line break. Reading the Memo.Text property returns a string where each line is separated by the value of the RTL's sLineBreak constant (which is defined as #13#10 on Windows). So just omit %0D%0A from your text and type in natural line breaks instead, and let the RTL handle the rest for you.
If you absolutely must keep %0D%0A in the text, you will have to strip off the native line breaks and then convert %0D%0A into native line breaks manually, eg:
procedure TGetForm1BackMemoTextSync.DoSynchronize;
begin
if Form1.ComboBox4.Text = 'Back' then
begin
FText := StringReplace(Form1.Memo1.Text, sLineBreak, '', [rfReplaceAll]);
FText := StringReplace(FText, '%0D%0A', #13#10, [rfReplaceAll]);
end;
end;
Related
In Delphi 6, I could change the Mouse Cursor for all forms using Screen.Cursor:
procedure TForm1.Button1Click(Sender: TObject);
begin
Screen.Cursor := crHourglass;
end;
I am searching the equivalent in Firemonkey.
Following function does not work:
procedure SetCursor(ACursor: TCursor);
var
CS: IFMXCursorService;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXCursorService) then
begin
CS := TPlatformServices.Current.GetPlatformService(IFMXCursorService) as IFMXCursorService;
end;
if Assigned(CS) then
begin
CS.SetCursor(ACursor);
end;
end;
When I insert a Sleep(2000); at the end of the procedure, I can see the cursor for 2 seconds. But the Interface probably gets freed and therefore, the cursor gets automatically resetted at the end of the procedure. I also tried to define CS as a global variable, and add CS._AddRef at the end of the procedure to prevent the Interface to be freed. But it did not help either.
Following code does work, but will only work for the main form:
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.MainForm.Cursor := crHourGlass;
end;
Since I want to change the cursor for all forms, I would need to iterate through all forms, but then the rollback to the previous cursors is tricky, as I need to know the previous cursor for every form.
My intention:
procedure TForm1.Button1Click(Sender: TObject);
var
prevCursor: TCursor;
begin
prevCursor := GetCursor;
SetCursor(crHourglass); // for all forms
try
Work;
finally
SetCursor(prevCursor);
end;
end;
You'd have to implement your own cursor service that makes it possible to enforce a certain cursor.
unit Unit2;
interface
uses
FMX.Platform, FMX.Types, System.UITypes;
type
TWinCursorService = class(TInterfacedObject, IFMXCursorService)
private
class var FPreviousPlatformService: IFMXCursorService;
class var FWinCursorService: TWinCursorService;
class var FCursorOverride: TCursor;
class procedure SetCursorOverride(const Value: TCursor); static;
public
class property CursorOverride: TCursor read FCursorOverride write SetCursorOverride;
class constructor Create;
procedure SetCursor(const ACursor: TCursor);
function GetCursor: TCursor;
end;
implementation
{ TWinCursorService }
class constructor TWinCursorService.Create;
begin
FWinCursorService := TWinCursorService.Create;
FPreviousPlatformService := TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; // TODO: if not assigned
TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
end;
function TWinCursorService.GetCursor: TCursor;
begin
result := FPreviousPlatformService.GetCursor;
end;
procedure TWinCursorService.SetCursor(const ACursor: TCursor);
begin
if FCursorOverride = crDefault then
begin
FPreviousPlatformService.SetCursor(ACursor);
end
else
begin
FPreviousPlatformService.SetCursor(FCursorOverride);
end;
end;
class procedure TWinCursorService.SetCursorOverride(const Value: TCursor);
begin
FCursorOverride := Value;
TWinCursorService.FPreviousPlatformService.SetCursor(FCursorOverride);
end;
end.
MainUnit:
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
TWinCursorService.CursorOverride := crHourGlass;
try
Sleep(2000);
finally
TWinCursorService.CursorOverride := crDefault;
end;
end;
The IFMXCursorService is how the FMX framework manages cursors. It is not intended for your use. The mechanism that you are meant to use is the form's Cursor property.
This means that you will need to remember the cursor for each form in order to restore it. I suggest that you use a dictionary to do that. Wrap the functionality up into a small class and then at least the pain is localized to the implementation of that class. You can make the code at the call site reasonable.
In my application i save some edit value in a Tstringlist with code below:
procedure TForm1.Button3Click(Sender: TObject);
var
F: TStringList;
begin
SaveDialog1.Filter := 'GPP files (*.GPP)|*.GPP';
if SaveDialog1.Execute then
begin
F := TStringList.Create;
with F do
begin
Add(label7.Caption);
Add(label21.Caption);
SaveToFile(Savedialog1.Filename);
Free;
end;
end;
end;
I want to save Tradiobutton state too in this Tstringlist.
Can you help me?
Regards
Making an answer just to show the code sample in properly formatted form
To read:
try/finally pattern - http://docwiki.embarcadero.com/RADStudio/XE2/en/Writing_a_Finally_Block_(Delphi)
TIniFile class and boolean values - http://docwiki.embarcadero.com/Libraries/XE2/en/System.IniFiles.TCustomIniFile.WriteBool - as a somewhat outdated with limited capabilities but a very simple text structured format.
So your code would become something like
const ini_def_sect = 'Default Section';
procedure TForm1.Button3Click(Sender: TObject);
var
F: TCustomIniFile;
begin
SaveDialog1.Filter := 'GPP files (*.GPP)|*.GPP';
if SaveDialog1.Execute then
begin
F := TIniFile.Create(SaveDialog1.Filename);
try
F.WriteString(ini_def_sect, label7.Name, label7.Caption);
F.WriteString(ini_def_sect, label21.Name, label21.Caption);
F.WriteBool(ini_def_sect, radiobutton1.Name, radiobutton1.Checked);
F.UpdateFile;
finally
F.Destroy;
end;
end;
end;
Or in VCL with-based style (that many dislike as they dislike with statement in Pascal)
const ini_def_sect = 'Default Section';
procedure TForm1.Button3Click(Sender: TObject);
begin
SaveDialog1.Filter := 'GPP files (*.GPP)|*.GPP';
if SaveDialog1.Execute then
begin
with TIniFile.Create(Savedialog1.Filename) do
try
WriteString(ini_def_sect, label7.Name, label7.Caption);
WriteString(ini_def_sect, label21.Name, label21.Caption);
WriteBool(ini_def_sect, radiobutton1.Name, radiobutton1.Checked);
UpdateFile;
finally
Destroy;
end;
end;
end;
And you REALLY REALLY should give your variables (including labels, forms, radio buttons, etc) reasonable names while you still can remember a bit about what do each of those mean. Trust me - a month or two and you would forget.
PS: reading the structured file could be something like
procedure TMainForm.btnOpenClick(Sender: TObject);
begin
OpenDialog1.Filter := 'GPP files (*.GPP)|*.GPP';
if OpenDialog1.Execute then
begin
with TIniFile.Create(OpenDialog1.Filename) do
try
label7.Caption := ReadString(ini_def_sect, label7.Name, '');
label21.Caption := ReadString(ini_def_sect, label21.Name, '');
radiobutton1.Checked := ReadBool(ini_def_sect, radiobutton1.Name, False);
finally
Destroy;
end;
end;
end;
I am new to Delphi and trying to convert vb.net apps to learn. The issue I am having is reading from a TCP/IP host. Currently I can connect via telnet to the device, send a command, and the device will send data non-stop until all data is sent. This could be simply two characters followed by CR/LF, or it could be several rows of varing length data. Each row is end is CR/LF. Prior to writing code, we were able to telnet via Hyperterminal to the device. Send a command, and, with the capture text enabled save to a text file.
Below is the code I have so far. I have not coded for saving to text file (one step at a time). The data is pipe delimited. I have no control on the format or operatation of the device aside from sending commands and receiving data. It works most of the time however there are times when not all of the data (65 records for testing) are received. I will greatly appreciate guidence and feel free to comment on my code, good or bad.
function Parse(Char, S: string; Count: Integer): string;
var
I: Integer;
T: string;
begin
if S[Length(S)] <> Char then
S := S + Char;
for I := 1 to Count do
begin
T := Copy(S, 0, Pos(Char, S) - 1);
S := Copy(S, Pos(Char, S) + 1, Length(S));
end;
Result := T;
end;
procedure TForm2.btnEXITClick(Sender: TObject);
begin
if idTcpClient1.connected then
begin
idTcpClient1.IOHandler.InputBuffer.clear;
idTcpClient1.Disconnect;
end;
Close;
end;
procedure TForm2.btnSendDataClick(Sender: TObject);
var
mTXDataString : String;
RXString : String;
begin
IdTCPClient1.Host := IPAddress.Text;
IdTCPClient1.Port := StrToInt(IPPort.Text);
mTXDataString := mTXData.Text + #13#10;
IdTCPClient1.Connect;
If IdTCPClient1.Connected then
begin
IdTCPClient1.IOHandler.Write(mTXDataString);
mTXDataString := mTXData.Lines.Text;
if MTXDataString.Contains('SCHEMA') then
begin
mRXData.Lines.Add(IdTCPClient1.IOHandler.ReadLn);
while not (IdTCPClient1.IOHandler.InputBufferIsEmpty) do
begin
RXString := IdTCPClient1.IOHandler.ReadLn;
If (RXString <> '') and (RXString <> '??') then
begin
//Add received data to RXmemo
mRXData.Lines.Add(RXString);
//Determine number of records to received based on schema data
lblRecords.Caption := Parse(',', RXString, 2);
end;
end; //while not
end // if
else
if mTXDataString.Contains('DATA') then
begin
mRXData.Lines.Add(IdTCPClient1.IOHandler.ReadLn);
while not (IdTCPClient1.IOHandler.InputBufferIsEmpty) do
begin
RXString := IdTCPClient1.IOHandler.ReadLn;
If (RXString <> '') and (RXString <> '??') then
begin
mRXData.Lines.Add(RXString);
end; // if
end; //while not
end; // if Schema or not
end; // if Connected
IdTCPClient1.Disconnect;
end; //Procedure
HyperTerminal and Telnet apps display whatever data they receive, in real-time. TIdTCPClient is not a real-time component. You control when and how it reads. If you are expecting data to arrive asynchronously, especially if you don't know how many rows are going to be received, then you need to perform the reading in a timer or worker thread, eg:
procedure TForm2.TimerElapsed(Sender: TObject);
var
S: String;
begin
if IdTCPClient1.IOHandler = nil then Exit;
if IdTCPClient1.IOHandler.InputBufferIsEmpty then
begin
IdTCPClient1.IOHandler.CheckForDataOnSource(50);
if IdTCPClient1.IOHandler.InputBufferIsEmpty then Exit;
end;
S := IdTCPClient1.IOHandler.ReadLn;
// use S as needed ...
end;
Or:
type
TMyThread = class(TThread)
protected
fClient: TIdTCPClient;
procedure Execute; override;
public
constructor Create(aClient: TIdTCPClient);
end;
constructor TMyThread.Create(aClient: TIdTCPClient);
begin
inherited Create(False);
fClient := aClient;
end;
procedure TMyThread.Execute;
var
S: String;
begin
while not Terminated do
begin
S := fClient.IOHandler.ReadLn;
// use S as needed ...
end;
end;
Or, if the server supports the actual Telnet protocol, have a look at using Indy's TIdTelnet component instead.
I have a problem with using streams. I would like to read my html code line by line. With reading file line by line i have no problems but i need to read actualy opened document with webbrowser so i write this:
procedure TForm2.SpeedButton2Click(Sender: TObject);
var
iall : IHTMLElement;
strumien : TStringStream;
reader : TStreamReader;
begin
if Assigned(WebBrowser1.Document) then
begin
iall := (WebBrowser1.Document AS IHTMLDocument2).body;
while iall.parentElement <> nil do
begin
iall := iall.parentElement;
end;
Strumien:=Tstringstream.Create(iall.innerHTML);
Strumien.Position:=0;
reader:=TStreamReader.Create(Strumien, TEncoding.UTF8);
reader.OwnStream;
while not reader.EndOfStream do
memo1.Lines.Add(reader.ReadLine);
end;
end;
This code doesnt work. Reads only few lines from center of document and gives "List index out of bounds" Anyone know why? Using Embarcadero XE2 Delphi
Thanks a lot!
You are mixing different string encodings together, which might account for why TStreamReader is not able to read everything correctly. TStringStream also uses TEncoding in D2009+, but you are not specifying any TEncoding type in the TStringStream constructor, so it will use TEncoding.Default, which is not the same encoding as TEncoding.UTF8. So you are taking the original UTF-16 encoded HTML string, converting it to the OS default Ansi encoding, and then trying to read it back as UTF-8. That can only work if the data does not contain any non-ASCII characters in it.
Try this instead:
procedure TForm2.SpeedButton2Click(Sender: TObject);
var
iall : IHTMLElement;
iparent : IHTMLElement;
strumien : TStringStream;
reader : TStreamReader;
s: String;
begin
if Assigned(WebBrowser1.Document) then
begin
iall := (WebBrowser1.Document AS IHTMLDocument2).body;
iparent := iall.parentElement;
while iparent <> nil do
begin
iall := iparent;
iparent := iparent.parentElement;
end;
Strumien := TStringStream.Create(iall.innerHTML, TEncoding.UTF8, False);
try
Strumien.Position := 0;
reader := TStreamReader.Create(Strumien, TEncoding.UTF8);
try
while not reader.EndOfStream do
begin
s := reader.ReadLine;
// use s as needed...
end;
finally
reader.Free;
end;
finally
Strumien.Free;
end;
end;
end;
In the specific case of loading the document into a TMemo, you don't need the TStringStream or TStreamReader at all:
procedure TForm2.SpeedButton2Click(Sender: TObject);
var
iall : IHTMLElement;
iparent : IHTMLElement;
begin
if Assigned(WebBrowser1.Document) then
begin
iall := (WebBrowser1.Document AS IHTMLDocument2).body;
iparent := iall.parentElement;
while iparent <> nil do
begin
iall := iparent;
iparent := iparent.parentElement;
end;
Memo1.Text := iall.innerHTML;
end;
end;
I know i have posted a similar question before but i am not able to get it working I have this simple code :
procedure TfrmMain.srvrConnect(AContext: TIdContext); //idhttpserver on connect event
var
S,C : String;
begin
repeat
s := s + AContext.Connection.Socket.ReadChar;
until AContext.Connection.Socket.InputBufferIsEmpty = True;
frmMain.caption := S;
Memo1.Lines.Add(S);
end;
The strings displays ok in the memo but the caption doesn't get updated
TIdHTTPServer is a multi-threaded component. TIdContext runs in its own worker thread. You cannot safely update the Form's Caption (or do anything else with the UI) from outside of the main thread. You need to synchronize with the main thread, such as with the TIdSync or TIdNotify class.
On a side note, calling ReadChar() in a loop is very inefficient, not to mention error-prone if you are using Delphi 2009+ since it cannot return data for surrogate pairs.
Use something more like this instead;
type
TDataNotify = class(TIdNotify)
protected
Data: String;
procedure DoNotify; override;
public
constructor Create(const S: String);
class procedure DataAvailable(const S: String);
end;
constructor TDataNotify.Create(const S: String);
begin
inherited Create;
Data := S;
end;
procedure TDataNotify.DoNotify;
begin
frmMain.Caption := Data;
frmMain.Memo1.Lines.Add(Data);
end;
class procedure TDataNotify.DataAvailable(const S: String);
begin
Create(S).Notify;
end;
procedure TfrmMain.srvrConnect(AContext: TIdContext); //idhttpserver on connect event
var
S: String;
begin
AContext.Connection.IOHandler.CheckForDataOnSource(IdTimeoutDefault);
if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
S := AContext.Connection.IOHandler.InputBufferAsString;
TDataNotify.DataAvailable(S);
end;
end;
First, make sure you are writing to the right variable. Are you sure that frmMain is the form you want the caption do change?
Also, you could try:
procedure TfrmMain.srvrConnect(AContext: TIdContext); //idhttpserver on connect event
var
S,C : String;
begin
repeat
s := s + AContext.Connection.Socket.ReadChar;
until AContext.Connection.Socket.InputBufferIsEmpty = True;
oCaption := S;
TThread.Synchronize(nil, Self.ChangeCaption);
end;
procedure TfrmMain.ChangeCaption;
begin
Self.Caption := oCaption;
Memo1.Lines.Add(oCaption);
end;
And finally, make sure that the first line on S is not a blank line, because the form's caption will not show strings that contains a line feed.