Delphi memory stream to server - memorystream

I am working on creating a chat program. But for some reason my stream won't come through. Could someone check my code and tell me what I am doing wrong?
Client side:
procedure TForm1.Button1Click(Sender: TObject);
var
myStream : TMemoryStream;
chat : String;
begin
//Creating a stream
chat := 'bladibla';
myStream := TMemoryStream.Create();
myStream.Size := Length(Chat);
myStream.WriteBuffer(Pointer(Chat)^, Length(Chat));
//Resetting the stream position
myStream.Position := 0;
//Sending the stream
TcpClient1.Active := true;
TcpClient1.SendStream(myStream);
TcpClient1.Active := false;
//Free the stream
myStream.Free;
end;
Server Side:
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
chat : string;
begin
//Receives the message from the client
ClientSocket.ReceiveBuf(Pointer(Chat)^,Length(Chat),0);
memo1.Lines.Add(chat);
memo1.Lines.Add('------');
end;

If you're using D2009 or later, then when sending, you're cutting the data in half. Also, given you will ultimately be reading the data with ReceiveBuf, it would probably be sensible to prepend a length marker. Less substantively, you also don't need to set the memory stream's Size up front, and should wrap the stream usage in a try/finally block:
procedure TForm1.Button1Click(Sender: TObject);
var
myStream : TMemoryStream;
chat : String;
Len: Int32;
begin
//Creating a stream
chat := 'bladibla';
myStream := TMemoryStream.Create();
try
Len := Length(Chat);
myStream.WriteBuffer(Len, SizeOf(Len));
myStream.WriteBuffer(Pointer(Chat)^, Len * SizeOf(Char));
//Resetting the stream position
myStream.Position := 0;
//Sending the stream
TcpClient1.Active := true;
TcpClient1.SendStream(myStream);
TcpClient1.Active := false;
finally
//Free the stream
myStream.Free;
end;
end;
In the case of the receiving code, you haven't pre-allocated the Chat buffer. As such, Length(Chat) will be 0. Given my suggested code above, we can read off the length marker first:
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
chat : string;
Len: Int32;
begin
//Receives the message from the client
ClientSocket.ReceiveBuf(Len, SizeOf(Len),0);
SetLength(Chat, Len);
ClientSocket.ReceiveBuf(Pointer(Chat)^,Len * SizeOf(Char),0);
memo1.Lines.Add(chat);
memo1.Lines.Add('------');
end;
Lastly... the components used in this code are deprecated, so it might be an idea to investigate Indy instead.

Related

Delphi Syntax error in FROM clause, but no from clause

I'm really new to Delphi and have not yet worked with SQL (I'm a complete beginner).
I use code to connect my database and tables to my program, but as soon as I run my program, I get a Syntax error in FROM clause message.
When I select break, it highlights end; of a part of the code.
function TADOCommand.Execute(var RecordsAffected: Integer;
const Parameters: OleVariant): _Recordset;
var
VarRecsAffected: OleVariant;
begin
SetConnectionFlag(cfExecute, True);
try
Initialize;
Result := CommandObject.Execute(VarRecsAffected, Parameters,
Integer(CommandObject.CommandType) + ExecuteOptionsToOrd
(FExecuteOptions));
RecordsAffected := VarRecsAffected;
finally
SetConnectionFlag(cfExecute, False);
end;
end;
I have three tables, of which two display on their grids, but one is not displaying on the grid, and also gives me the Syntax error in FROM clause when I want to do anything with it.
This is the code that I used to connect my database in the datamodule:
unit dmChamps_u;
interface
uses
System.SysUtils, System.Classes, ADODB, DB; // add Ado and DB
type
TdmChamps = class(TDataModule)
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
conArchers: TADOConnection;
tblArchers: TADOTable;
tblJT: TADOTable;
tblMatches: TADOTable;
dscArchers: TDataSource;
dscMatches: TDataSource;
dscJT: TDataSource;
end;
var
dmChamps: TdmChamps;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TdmChamps.DataModuleCreate(Sender: TObject);
begin
// create objects
conArchers := TADOConnection.Create(dmChamps);
tblArchers := TADOTable.Create(dmChamps);
tblMatches := TADOTable.Create(dmChamps);
tblJT := TADOTable.Create(dmChamps);
dscArchers := TDataSource.Create(dmChamps);
dscMatches := TDataSource.Create(dmChamps);
dscJT := TDataSource.Create(dmChamps);
// setup connection
conArchers.ConnectionString :=
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=ArchChampsDB.mdb;Mode=ReadWrite;Persist Security Info=False';
conArchers.LoginPrompt := false;
conArchers.Open;
// setup table archers
tblArchers.Connection := conArchers;
tblArchers.TableName := 'Archers';
// setup data source
dscArchers.DataSet := tblArchers;
tblArchers.Open;
// setup table matches
tblMatches.Connection := conArchers;
tblMatches.TableName := 'Matches';
// setup data source
dscMatches.DataSet := tblMatches;
tblMatches.Open;
// setup table JT
tblJT.Connection := conArchers;
tblJT.TableName := 'Judges/Timekeepers';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
end;
end.
I've looked through all of the questions on the From clause error already on the site, but none of the scenarios quite match my problem. I also went to Embarcadero's site and read about TableDirect, which I thought might be a possible solution, but it was already in the code.
Your error is here
tblJT.TableName := 'Judges/Judges';
You can't has a table with that name, or Judges or Timekeepers
You can solve do it:
// setup table J
tblJT.Connection := conArchers;
tblJT.TableName := 'Judges';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
Separated
// setup table T
tblJT.Connection := conArchers;
tblJT.TableName := 'Timekeepers';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
Maybe it is because of the slash in 'Judges/Timekeepers'.
Did you try to debug step by step going to the code in DataModuleCreate?

How do I send POST data using TW3HttpRequest

So I've started playing with SMS and I've tried to make a program (label and button) to hit a website with a post request and display the result.
I have no problems with Hints/Warnings/Errors and everything looks good to me. The following code is a rework of a couple of existing examples mashed together.
procedure TForm1.ExecuteCmd;
var
whttp : TW3HttpRequest;
wParams : string;
begin
wHttp := TW3HttpRequest.Create;
try
whttp.OnDataReady := lambda (Sender)
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
whttp.OnReadyStateChange := lambda (Sender)
if (wHttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://www.server1.com/executecmd.php');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
finally
wHttp.free;
end;
end;
procedure TForm1.W3Button1Click(Sender: TObject);
begin
ExecuteCmd;
end;
The problem is this, when I actually click the button I get the following error message:
Uncaught TypeError: Cannot read property 'readyState' of null [line #6277]
The error is in the auto generated code and seems to have no relation to what I've written specifically. If I take out all references to ReadyState from my code I still get the error.
What am I missing? I feel like it has something to do with the Lambda functions.
Your problem is that you are expecting whttp.Send to block. Send, as its JavaScript equivalent, is asynchronous. Before the POST could even execute, whttp object is freed (in the finally block). When callback (OnReadyStateChanged) is called, whttp was already freed (and is now null) and you are then trying to call ReadyState on that freed (null) object.
Another reason for confusion is that object.Free in Delphi for Windows/OS X destroys the object while in Smart it merely sets the object reference to nil and leaves the destruction to JavaScript's garbage collection. That's why the whttp is still alive after the Free and why the OnReadyStateChanged is called at all.
This works fine:
uses
W3System, W3Graphics, W3Components, W3Forms, W3Fonts, W3Borders, W3Application,
W3Button, W3Inet, W3Memo;
type
TForm1=class(TW3form)
procedure W3Button1Click(Sender: TObject);
private
{$I 'Form1:intf'}
whttp: TW3HttpRequest;
protected
procedure InitializeForm; override;
procedure InitializeObject; override;
procedure Resize; override;
end;
implementation
{ TForm1}
procedure TForm1.W3Button1Click(Sender: TObject);
var
wParams: string;
begin
whttp := TW3HttpRequest.Create;
whttp.OnReadyStateChange := lambda (Sender)
if (whttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
W3Memo1.Text := wHttp.ResponseText;
whttp.OnReadyStateChange := nil;
whttp := nil;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://httpbin.org/post');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
end;

Lazarus (freepascal) Reading large output from TProcess

I' m reading large process output data in Lazarus using the TProcess and the suggestions from this freepascal wiki page.
The wiki page suggests to create a loop to read the process output data like this:
// ... If you want to read output from an external process, this is the code you should adapt for production use.
while True do
begin
MemStream.SetSize(BytesRead + 2024); // make sure we have room
NumBytes := OurProcess.Output.Read((MemStream.Memory + BytesRead)^, READ_BYTES);
if NumBytes > 0
then begin
Inc(BytesRead, NumBytes);
Write('.') //Output progress to screen.
end else
BREAK // Program has finished execution.
end;
// "Then read the MemStream to do your job"
The wiki page also mentions that the calling program should read from the output pipe to prevent it from getting full.
So, how much data makes the output pipe full?
Why we should use a MemStream (TMemoryStream) and not directly read from OurProcess.Output stream (using the bytesAvailable, etc) in the above loop?
I'm reading 80MB of wav data from a process and I have noticed that both MemStream and OurProcess.Output streams have the same amount of data! The memory usage gets doubled. So the suggested method from the wiki cannot be considered as efficient or optimized. Or there is something I'm missing?
Afaik output/input streams are a stream form of a pipe, not memory streams. The values you see are retrieved from the OS handle, not from memory allocated to the FPC app per se.
It is just like you can ask for the .size of a file on disk without reading the whole file.
procedure RunExternalAppInMemo(DosApp:String;AMemo:TMemo);
const READ_BYTES = 2048;
var
aProcess: TProcess; //TProcess is crossplatform is best way
MemStream: TMemoryStream;
NumBytes: LongInt;
BytesRead: LongInt;
Lines: TStringList;
begin
// A temp Memorystream is used to buffer the output
MemStream := TMemoryStream.Create;
Lines :=TStringList.Create;
BytesRead := 0;
aProcess := TProcess.Create(nil);
aProcess.CommandLine := DosApp;
aprocess.ShowWindow := swoHIDE;
AProcess.Options := AProcess.Options + [poUsePipes];
aProcess.Execute;
while aProcess.Running do
begin
// make sure we have room
MemStream.SetSize(BytesRead + READ_BYTES);
// try reading it
NumBytes := aProcess.Output.Read((MemStream.Memory + BytesRead)^, READ_BYTES);
if NumBytes > 0 // All read() calls will block, except the final one.
then Inc(BytesRead, NumBytes)
else
BREAK // Program has finished execution.
end;
MemStream.SetSize(BytesRead);
Lines.LoadFromStream(MemStream);
AMemo.lines.AddStrings(Lines);
aProcess.Free;
Lines.Free;
MemStream.Free;
end;
I was dealing with this problem today, I've modified Georgescu answer, as I wanted Memo to display output stream on the fly
procedure RunExternalAppInMemo(DosApp:String;AMemo:TMemo);
const READ_BYTES = 2048;
var
aProcess: TProcess; //TProcess is crossplatform is best way
NumBytes: LongInt;
Buffer: array of byte;
begin
// set the size of your buffer
SetLength(Buffer,READ_BYTES);
aProcess := TProcess.Create(nil);
aProcess.CommandLine := DosApp;
aprocess.ShowWindow := swoHIDE;
AProcess.Options := AProcess.Options + [poUsePipes];
aProcess.Execute;
while aProcess.Running do
begin
// try reading it
NumBytes := aProcess.Output.Read(Buffer[0], length(buffer)*sizeof(byte)); // I usually do it that way, so I can change Buffer size on if needed
AProcess.Suspend; //I have no experience with pipes, but it seems way I won loose eny output?
if NumBytes > 0 then // All read() calls will block, except the final one.
begin
AMemo.Lines.Add(Pchar(Buffer);
application.ProcessMessages;
AProcess.Resume;
end
else
BREAK; // Program has finished execution.
end;
setlength(Buffer,0);
aProcess.Free;
end;

Delphi XE2 Indy10 udp client-server interchange using SendBuffer-ReceiveBuffer

I use Delphi XE2 and Indy10 UDP protocol.
I can't receive server echo on client side if I use ReceiveBuffer method.
I got "Socket Error # 10040" although I send back very small echo
message from server to client.
Console application to illustrate my problem is below.
Thanks in advance.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, IdGlobal, IdBaseComponent, IdComponent, IdSocketHandle,
IdUDPClient, IdUDPServer, IdUDPBase, IdStack;
type
TUDP_Serv = class(TIdUDPServer)
procedure udpSvUDPRead(AThread: TIdUDPListenerThread;
AData: TIdBytes; ABinding: TIdSocketHandle);
end;
var
udpServer: TUDP_Serv;
udpCl: TIdUDPClient;
bSnd, bRcv: TBytes;
s: string;
k: integer;
//==============================================================================
procedure TUDP_Serv.udpSvUDPRead(AThread: TIdUDPListenerThread; AData: TIdBytes;
ABinding: TIdSocketHandle);
begin
writeln(' Server read: ' + ToHex(AData, length(AData)));
with ABinding do SendTo(PeerIP, PeerPort, AData);
end;
//==============================================================================
begin
try
udpServer := TUDP_Serv.Create;
with udpServer do begin
OnUDPRead := udpSvUDPRead; DefaultPort := 20001; BufferSize := 2048;
ThreadedEvent := true; Active := True;
if Active then writeln('Server started on port: ' + IntToStr(DefaultPort));
end;
udpCl := TIdUDPClient.Create;
with udpCl do begin
BufferSize := 2048; Host := '127.0.0.1'; Port := 20001;
end;
SetLength(bSnd, 5); bSnd[0] := $31; bSnd[1] := $0;
bSnd[2] := $33; bSnd[3] := $0; bSnd[4] := $0;
repeat
writeln(' Client send: ' + ToHex(bSnd, length(bSnd)));
with udpCl do SendBuffer(Host, Port, bSnd); sleep(100);
try
k := udpCl.ReceiveBuffer(bRcv, 10);
if k > 0 then writeln(' Client read: ' + ToHex(bRcv, length(bRcv)));
except
on E: exception do begin
writeln(Format(' Client read err: %s',[E.Message]));
end;
end;
readln(s);
until s <> '';
except
on E: Exception do begin
Writeln(E.ClassName, ': ', E.Message); readln(s);
end;
end;
end.
Screen output:
Server started on prot: 20001
Client send: 3100330000
Server read: 3100330000
Client read err: Socket Error # 10040
Message too long.
10040 is WSAEMSGSIZE, which means the buffer you tried to receive into was smaller than the actual size of the message that was received.
You are not allocating any memory for bRcv before calling ReceiveBuffer(), so you are trying to receive into a 0-byte buffer, hense the error. You need to pre-allocate bRcv to at least the same size as your messages, if not larger.
ReceiveBuffer() does not allocate a new TBytes for each received message. You have to allocate the buffer yourself beforehand and then ReceiveBuffer() will merely fill it in, returning how many bytes were actually received into it.

How do set the timeout on a wcf service caller in Delphi?

I have a straightforward call to a wcf service hosted by iis I'm Delphi 2010
The operation being called on the service could take several minutes
What is the best way of avoiding a timeout error in Delphi?
I deliberately put a Thread.Sleep inside my WCF Service force it to wait for 31 seconds
After 30 seconds I got the error
Project raised exception class ESOAPHTTPException with message 'The handle is in the wrong state for the requested operation - URL:http://10.1.1.4/STC.WcfServices.Host/FlexProcurementService.svc - SOAPAction:http://navsl.stcenergy.com/FlexProcurement/FlexProcurementService/GetPassthroughSummaryGridReportData'.
This turned out to be a bug in Delphi 2010 which I have applied the patch for, so now I get the error operation timed out
function GetFlexProcurementService(const objServiceInfo: TWCFService; UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO): FlexProcurementService;
var
RIO: THTTPRIO;
begin
Result := nil;
if (Addr = '') then
begin
if UseWSDL then
Addr := objServiceInfo.WSDL
else
Addr := objServiceInfo.URL;
end;
if HTTPRIO = nil then
RIO := THTTPRIO.Create(nil)
else
RIO := HTTPRIO;
try
Result := (RIO as FlexProcurementService);
if UseWSDL then
begin
RIO.WSDLLocation := Addr;
RIO.Service := objServiceInfo.Svc;
RIO.Port := objServiceInfo.Prt;
end else
RIO.URL := Addr;
finally
if (Result = nil) and (HTTPRIO = nil) then
RIO.Free;
end;
end;
Paul
uses wininet;
...
function SetTimeout(const HTTPReqResp: THTTPReqResp; Data: Pointer; NumSecs : integer) : boolean;
var
TimeOut: Integer;
begin
// Sets the receive timeout. i.e. how long to wait to 'receive' the response
TimeOut := (NumSecs * 1000);
try
InternetSetOption(Data, INTERNET_OPTION_RECEIVE_TIMEOUT, Pointer(#TimeOut), SizeOf(TimeOut));
InternetSetOption(Data, INTERNET_OPTION_SEND_TIMEOUT, Pointer(#TimeOut), SizeOf(TimeOut));
except on E:Exception do
raise Exception.Create(Format('Unhandled Exception:[%s] while setting timeout to [%d] - ',[E.ClassName, TimeOut, e.Message]));
end;
end;
In the RIO OnBeforePost:
procedure TEETOUpsertWrapper.OnBeforePost(const HTTPReqResp: THTTPReqResp; Data: Pointer); begin
SetTimeout(HTTPReqResp, Data, 5 * 60);
end;