Delphi: Sending multiple strings through sockets? - windows

I am currently using delphi 6 (yes, I know.. but its so far getting the job done.)
I am using Serversocket, and client socket. When I have my client connect to my server, I would like to have it send some info, like computername, lAN IP, OS name, ping.
At the moment I only have the client sending the computer name to the server, I am wondering how can I send multiple information, and set it up accordingly in my grid? here is the source code:
Client:
unit client1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp;
type
TForm1 = class(TForm)
Client1: TClientSocket;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Client1Connect(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function Getusernamefromwindows: string;
var
iLen: Cardinal;
begin
iLen := 256;
Result := StringOfChar(#0, iLen);
GetUserName(PChar(Result), iLen);
SetLength(Result, iLen);
end;
function Getcomputernamefromwindows: string;
var
iLen: Cardinal;
begin
iLen := MAX_COMPUTERNAME_LENGTH + 1;
Result := StringOfChar(#0, iLen);
GetComputerName(PChar(Result), iLen);
SetLength(Result, iLen);
end;
function osver: string;
begin
result := 'Unknown';
case Win32MajorVersion of
4:
case Win32MinorVersion of
0: result := 'windows 95';
10: result := 'Windows 98';
90: result := 'Windows ME';
end;
5:
case Win32MinorVersion of
0: result := 'windows 2000';
1: result := 'Windows XP';
end;
6:
case Win32MinorVersion of
0: result := 'Windows Vista';
1: result := 'Windows 7';
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Client1.Host := '192.168.1.106';
Client1.Active := true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Client1.Active := false;
end;
procedure TForm1.Client1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
Client1.Socket.SendText(Getcomputernamefromwindows + '/' + Getusernamefromwindows);
(*Upon connection to server, I would like it send the os name, but as you
can see I already have SendText being used*)
end;
end.
Server:
unit server1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ScktComp, Grids, DBGrids;
type
TForm1 = class(TForm)
Server1: TServerSocket;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure Server1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
With StringGrid1 do begin
Cells[0,0] := 'Username';
Cells[1,0] := 'IP Address';
Cells[2,0] := 'Operating System';
Cells[3,0] := 'Ping';
end;
end;
(* cells [0,0][1,0][2,0][3,0]
are not to be changed for
these are used to put the
titles in
*)
procedure TForm1.Server1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
begin
with StringGrid1 do begin
Cells[0,1] := Socket.ReceiveText;
Cells[1,1] := Server1.Socket.Connections[0].RemoteAddress;
(*in this area I want it to receive the os version info and place it in
Cells[2,1]*)
end;
end;
end.

You already know the answer, because you are already doing it. Send the various strings with delimiters in between them (in your example, you are using /, but you could also use CRLFs, string length prefixes, etc), and then some final delimiter to signal the end of the data.
The real problem with your code is the use of SendText() and ReceiveText(). SendText() is not guaranteed to send the entire string in one go. It returns how many bytes it actually sent. If fewer than your string length, you have to call SendText() again to send the remaining bytes. As for ReceiveText(), it just returns whatever arbitrary data is on the socket at that moment, which may be an incomplete string, or multiple strings merged together.
You are using lower-level I/O methods without first designing a higher level protocol to describe the data being sent. You need a protocol. Design how you want your data to look, then format your data that way and use the methods to send/receive that data, then break apart the data as needed when received.
So, in this case, you could send a single CRLF-delimited string that contains /-delimited values. The server would then read until it reaches the CRLF, then split the line and use the values according.

Related

Retrieve Delphi runtime application version and application build information for OSX in fire monkey (FMX)

I try to find an example on how to retrieve the application version and build nr so I can display it in the help box of an OSX application.
Trivial on Windows but on Mac its not.
Hope you can help!
Edward
I use this code that I have written. Simply call:
osxNSBundle.BundleVersion()
Here is the code:
uses
Macapi.Foundation,
Macapi.Helpers;
osxNSBundle = class
private
class function MainBundle: NSBundle;
public
class function BundlePath: string;
class function BundleVersionStr: string;
class procedure BundleVersion(var aMajor,aMinor,aBuild: integer);
end;
implementation
class function osxNSBundle.MainBundle: NSBundle;
begin
result := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
end;
class function osxNSBundle.BundlePath: string;
begin
result := NSStrToStr(MainBundle.bundlePath);
end;
class function osxNSBundle.BundleVersionStr: string;
begin
Result := NSStrToStr(TNSString.Wrap(MainBundle.objectForInfoDictionaryKey(StrToNSStr('CFBundleVersion'))));
end;
class procedure osxNSBundle.BundleVersion(var aMajor,aMinor,aBuild: integer);
var lStrArray: TArray<string>;
i: Integer;
begin
aMajor := 0; aMinor := 0; aBuild := 0;
lStrArray := BundleVersionStr.Split(['.']);
if Length(lStrArray)>=3 then
begin
aMajor := lStrArray[0].ToInteger;
aMinor := lStrArray[1].ToInteger;
aBuild := lStrArray[2].ToInteger;
end;
end;

Why SIGSEGV Exception here [duplicate]

This question already has answers here:
Delphi: Access Violation at the end of Create() constructor
(2 answers)
Closed 3 years ago.
I am trying following code to create a simple GUI application:
program RnTFormclass;
{$mode objfpc}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, Forms, StdCtrls;
type
RnTForm = class(TForm)
private
wnd: TForm;
btn: TButton;
public
constructor create;
procedure showit;
end;
constructor RnTForm.create;
begin
Application.Initialize;
wnd := TForm.Create(Application);
with wnd do begin
Height := 300;
Width := 400;
Position:= poDesktopCenter;
Caption := 'LAZARUS WND';
end;
btn := TButton.Create(wnd);
with btn do begin
SetBounds(0, 0, 100, 50);
Caption := 'Click Me';
Parent := wnd;
end;
end;
procedure RnTForm.showit;
begin
wnd.ShowModal; {Error at this line: Throws exception External: SIGSEGV }
end;
var
myform1: RnTForm;
begin
myform1.create;
myform1.showit;
end.
However, it is throwing exception as mentioned as a comment in code above. Where is the problem and how can it be solved?
myform1.Create should be myform1 := RnTForm.Create.
In your code above, myform1 is a nil pointer (since it is a global variable, it is initialized to nil) until you assign something to it, in this case a (pointer to a) new instance of a RnTForm.
And of course, if myform1 is a nil pointer, you cannot use it as if it was indeed pointing to an object (so myform1.showit will not work).

Overloading the assignment operator for Object Pascal

What happens when the assign operator := gets overloaded in Object Pascal? I mainly mean what gets evaluated first and more importantly how (if possible) can I change this order. Here is an example that bugs me:
I declare TMyClass thusly:
TMyClass = class
private
FSomeString: string;
class var FInstanceList: TList;
public
function isValid: boolean;
property SomeString: String write setSomeString;
end;
the isValid function checks MyObject for nil and dangling pointers.
Now lets assume I want to overload the := operator to assign a string to TMyClass. I also want to check if the object I'm assigning this string to is a valid object and if not create a new one, so:
operator :=(const anewString: string): TMyClass;
begin
if not(result.isValid) then
result:= TMyObject.Create;
result.SomeString:= aNewString;
end;
In short I was hoping that the result would automatically hold the pointer to the object I'm assigning to. But tests with the following:
procedure TForm1.TestButtonClick(Sender: TObject);
var
TestObject: TMyObject;
begin
TestObject:= TMyObject.Create;
TestObject:= 'SomeString';
TestObject.Free;
end;
led me to believe that instead an intermediate value for result is assigned first and the actual assignment to TestObject happens after the code in := executes.
Everything I know about coding is self taught but this example shows that I clearly missed some basic concept somewhere.
I understand that there are easier ways to do this than by overloading a := operator but out of scientific curiosity is there ANY way to make this code work? (No matter how complicated.)
It's not possible to do what you want with operator overloads. You must use a method.
The problem is that the := operator does not give you the access to the left hand side (LHS) argument (here it's the Self, a pointer to the current instance) but only to the right hand side argument.
Currently in you example if not(result.isValid) then is dangereous because the result at the beginning of the function is undefined (it can have any value, it can be either nil or not and when not nil, calling isValid will lead to some possible violation access. It does not represent the LHS at all.
Using a regular method you would have an access to the Self and you could call isValid.
I do not have Lazarus to check, but it is possible in Delphi in the following way. We give access to an instance of the class indirectly via TValue.
Here is a sample class:
type
TMyClass = class(TComponent)
private
FSomeString: string;
published
property SomeString: string read FSomeString write FSomeString;
end;
And we do the following in the container class (for example, TForm1).
TForm1 = class(TForm)
private
FMyClass: TMyClass;
function GetMyTypeString: TValue;
procedure SetMyTypeString(const Value: TValue);
public
property MyClass: TValue read GetMyTypeString write SetMyTypeString;
end;
...
function TForm1.GetMyTypeString: TValue;
begin
Result := FMyClass;
end;
procedure TForm1.SetMyTypeString(const Value: TValue);
begin
if Value.Kind in [TTypeKind.tkChar, TTypeKind.tkUString,
TTypeKind.tkString, TTypeKind.tkWChar, TTypeKind.tkWString]
then
begin
if not Assigned(FMyClass) then
FMyClass := TMyClass.Create(self);
FMyClass.SomeString := Value.AsString;
end else
if Value.Kind = TTypeKind.tkClass then
FMyClass := Value.AsType<TMyClass>;
end;
In this case both button clicks will work properly. In other words, it simulates := overloading:
procedure TForm1.Button1Click(Sender: TObject);
begin
MyClass := 'asd';
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
MyClass := TMyClass.Create(self);
end;
And here is how to get access to TMyClass instance:
procedure TForm1.Button3Click(Sender: TObject);
begin
if Assigned(TMyClass(MyClass.AsObject)) then
ShowMessage(TMyClass(MyClass.AsObject).SomeString)
else
ShowMessage('nil');
end;

Indy10, 400ms for a simple TCP/IP request and response

I can't figure out why a simple request and response is taking 400 ms to complete. It only needs under 1 ms to complete on localhost (loopback). When I make a request from my virtual machine to my main development machine it takes 400 ms to complete. It should take max 40 ms. This is how much it takes max for a HTTP request, so TCP should be faster. Here is the code for client and server. I just can't see where I loose time. I can profile if you need more info.
The code is Indy 9 and 10 compatible that is why the IFDEF-s. Also the connection is already established, it takes 400 ms without the connect part, only data send and response.
function TIMCClient.ExecuteConnectedRequest(const Request: IMessageData): IMessageData;
var
DataLength: Int64;
FullDataSize: Int64;
IDAsBytes: TIdBytes;
IDAsString: ustring;
begin
Result := AcquireIMCData;
FAnswerValid := False;
with FTCPClient{$IFNDEF Indy9}.IOHandler{$ENDIF} do
begin
Request.Data.Storage.Seek(0, soFromBeginning);
DataLength := Length(Request.ID) * SizeOf(uchar);
FullDataSize := DataLength + Request.Data.Storage.Size + 2 * SizeOf(Int64);
SetLength(IDAsBytes, DataLength);
Move(Request.ID[1], IDAsBytes[0], DataLength);
// write data
{$IFDEF Indy9}WriteInteger{$ELSE}Write{$ENDIF}(FullDataSize);
{$IFDEF Indy9}WriteInteger{$ELSE}Write{$ENDIF}(DataLength);
{$IFDEF Indy9}WriteBuffer{$ELSE}Write{$ENDIF}(IDAsBytes{$IFDEF Indy9}[0]{$ENDIF}, DataLength);
{$IFDEF Indy9}WriteInteger{$ELSE}Write{$ENDIF}(Request.Data.Storage.Size);
{$IFDEF Indy9}WriteStream{$ELSE}Write{$ENDIF}(Request.Data.Storage);
// set the read timeout
ReadTimeout := FExecuteTimeout;
FullDataSize := ReadInt(FTCPClient);
// read the message ID
SetLength(IDAsBytes, 0);
DataLength := ReadInt(FTCPClient);
ReadBuff(FTCPClient, DataLength, IDAsBytes);
if DataLength > 0 then
begin
SetLength(IDAsString, DataLength div SizeOf(uchar));
Move(IDAsBytes[0], IDAsString[1], DataLength);
Result.ID := IDAsString;
end;
// read the message data
DataLength := ReadInt(FTCPClient);
ReadStream(Result.Data.Storage, DataLength, False);
Result.Data.Storage.Seek(0, soFromBeginning);
// we were succesfull
FAnswerValid := True;
end;
end;
The server side:
procedure TIMCServer.OnServerExecute(AContext: TIMCContext);
var
Request: IMessageData;
Response: IMessageData;
DataLength: Int64;
FullDataSize: Int64;
IDAsBytes: TIdBytes;
IDAsString: ustring;
begin
with AContext.Connection{$IFNDEF Indy9}.IOHandler{$ENDIF} do
begin
ReadTimeout := FExecuteTimeout;
//read the data length of the comming response
FullDataSize := ReadInt(AContext.Connection);
// Acquire the data objects
Request := AcquireIMCData;
Response := AcquireIMCData;
// read the message ID
DataLength := ReadInt(AContext.Connection);
ReadBuff(AContext.Connection, DataLength, IDAsBytes);
if DataLength > 0 then
begin
SetLength(IDAsString, DataLength div SizeOf(uchar));
Move(IDAsBytes[0], IDAsString[1], DataLength);
Request.ID := IDAsString;
end;
// read the message data
DataLength := ReadInt(AContext.Connection);
ReadStream(Request.Data.Storage, DataLength, False);
Request.Data.Storage.Seek(0, soFromBeginning);
try
// execute the actual request handler
FOnExecuteRequest(Request, Response);
finally
// write the data stream to TCP
Response.Data.Storage.Seek(0, soFromBeginning);
DataLength := Length(Response.ID) * SizeOf(uchar);
FullDataSize := DataLength + Response.Data.Storage.Size + 2 * SizeOf(Int64);
// write ID as binary data
SetLength(IDAsBytes, DataLength);
Move(Response.ID[1], IDAsBytes[0], DataLength);
// write data
{$IFDEF Indy9}WriteInteger{$ELSE}Write{$ENDIF}(FullDataSize);
{$IFDEF Indy9}WriteInteger{$ELSE}Write{$ENDIF}(DataLength);
{$IFDEF Indy9}WriteBuffer{$ELSE}Write{$ENDIF}(IDAsBytes{$IFDEF Indy9}[0]{$ENDIF}, DataLength);
{$IFDEF Indy9}WriteInteger{$ELSE}Write{$ENDIF}(Response.Data.Storage.Size);
{$IFDEF Indy9}WriteStream{$ELSE}Write{$ENDIF}(Response.Data.Storage);
end;
end;
The same slow communication was reported by one of the users of my code. He also tested from a virtual machine to a physical machine.
UPDATE:
The following code executes in 2-3 ms between same two machines. Its Indy10, smallest possible case.
procedure TForm2.Button1Click(Sender: TObject);
var
MyVar: Int64;
begin
TCPClient.Host := Edit1.Text;
TCPClient.Port := StrToInt(Edit2.Text);
TCPClient.Connect;
try
stopwatch := TStopWatch.StartNew;
MyVar := 10;
TCPClient.IOHandler.Write(MyVar);
TCPClient.IOHandler.ReadInt64;
stopwatch.Stop;
Caption := IntToStr(stopwatch.ElapsedMilliseconds) + ' ms';
finally
TCPClient.Disconnect;
end;
end;
procedure TForm2.TCPServerExecute(AContext: TIdContext);
var
MyVar: Int64;
begin
if AContext.Connection.IOHandler.InputBuffer.Size > 0 then
begin
MyVar := 10;
AContext.Connection.IOHandler.ReadInt64;
AContext.Connection.IOHandler.Write(MyVar);
end;
end;
Solved the problem. It was easy when you find out what to do and where the problem is. Indy simply did not sent my data straight away. I had to add
OpenWriteBuffer
CloseWriteBuffer
calls to make Indy send the data when I want it. A lot of trouble over a simple misunderstanding of internal workings. Maybe this will spare someone some time.
When the buffer is closed, the data is sent immediately!

Firemonkey OSX update progressbar during download

The progressbar being updated is shown in Windows. In OSX the progressbar is shown but without see the progressbar shifting.
See code below.
procedure TForm1.Button1Click(Sender: TObject);
var
m : TMemoryStream;
begin
IdHTTP1.OnWork:= HttpWork;
m := TMemoryStream.Create;
IdHTTP1.Get('http://www.example.com/pictures.zip', m);
m.SaveToFile('/users/demo/pictures.zip');
m.Free;
end;
procedure TForm1.HttpWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
var
Http: TIdHTTP;
ContentLength: Int64;
Percent: Integer;
begin
Http := TIdHTTP(ASender);
ContentLength := Http.Response.ContentLength;
Percent := 100 * AWorkCount div ContentLength;
ProgressBar1.Value := Percent;
end;
How can the progressbar be updated in OSX?
Here's what I have in my code, and it works on both Windows and Mac:
Percent := 100 * AWorkCount div ContentLength;
frmDownloadProgress.ProgressBar1.Value := Percent;
Application.ProcessMessages;
Application.ProcessMessages is the key for updating the progress bar if the TIdHTTP component is on the main thread.

Resources