I am trying to send a TStringStream from client to server, then send it back from server to client, using Indy TCP components.
Here is my client code:
var
Jpg: TJPEGImage;
StringStream: TStringStream;
strcams, StringImageData: String;
byt, i: integer;
procedure SendCommandWithParams(Command, Params: String);
begin
Lock;
try
if not FTCP.Connected then
begin
exit;
end;
FTCP.Socket.WriteLn('1' + Command, IndyTextEncoding_UTF8);
FTCP.Socket.WriteLn(Params, IndyTextEncoding_UTF8);
finally
Unlock;
end;
end;
begin
Jpg := TJPEGImage.Create;
StringStream := TStringStream.Create('');
try
try
Jpg.Performance := jpBestSpeed;
Jpg.ProgressiveEncoding := True;
Jpg.ProgressiveDisplay := True;
Jpg.Assign(Image2.Picture.Bitmap);
Jpg.CompressionQuality := 25;
Jpg.Compress;
Jpg.SaveToStream(StringStream);
StringImageData := StringStream.DataString;
strcams := '<[S:' + IntToStr(Length(StringImageData)) + 'B]>' +
StringImageData;
if Length(strcams) < byt then
begin
SendCommandWithParams('SIMGSEND', strcams + sep + 'IMGID5423' + sep);
end;
except
on e: exception do
//
end;
finally
StringImageData := '';
FreeAndNil(Jpg);
FreeAndNil(StringStream);
end;
end;
I can receive the TStringStream data, but the data received is corrupted, and some times it gets replaced with the second parameter that I send which is 'IMGID5423' + sep. I am not sure if this is because of some limit of packet sending through TCP so the data does not arrive complete, or is this a parser issue?
My current parser should separate each text that ended with #13#10. Here is how it looks:
var
ReceiveParams, ReceiveStream: Boolean;
S: string;
Command: String;
begin
Command := Fholdcommand;
ReceiveParams := false;
ReceiveStream := false;
if Command[1] = '1' then // command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
end;
if ReceiveParams then // params incomming
begin
S := FTCP.Socket.ReadLn(IndyTextEncoding_UTF8);
FCMD := Command;
FPRMS := S;
FSTREAM := false;
if Assigned(FOnCallbackProc) then
begin
Synchronize(DoCallbackProc);
end;
end;
I am still confused about the real issue. I try to send the TStringStream in a local procedure, and it is received normally without any corruption.
Am I sending the data wrong altogether through Indy?
This is how I am receiving the data:
procedure CreateJpg(Data:string);
var
StringStream : TStringStream;
JpegImage : TJPEGImage;
Bitmap : TBitmap;
tmpPos:integer;
pp:string;
label check;
begin
GData := Data;
if LeftStr(GData,4) = '<[S:' then
begin
tmpPos := Pos(WideString('B]>'),GData);
pp := Copy(GData,5,tmpPos-5);
CDataELen := StrToInt(pp); //MidStr(st,5,tmppos - 5);
CData := RightStr(GData,length(GData)-(tmppos+2));
goto check;
end;
CData := CData + GData;
check:
//if CDataELen = length(CData) then
begin
StringStream := TStringStream.Create('');
JpegImage := TJpegImage.Create;
StringStream.WriteString(CData);
CData := '';
try
try
StringStream.Seek(0, soFromBeginning);
JpegImage.LoadFromStream(StringStream);
Bitmap := TBitmap.Create;
with Bitmap do
begin
Canvas.Lock;
try
Width := JpegImage.Width;
Height := JpegImage.Height;
Canvas.Draw(0, 0, JpegImage);
finally
Canvas.Unlock;
end;
end;
img.Picture.Bitmap.Width := Bitmap.Width;
img.Picture.Bitmap.Height := Bitmap.Height;
img.Picture.Bitmap.Canvas.Draw(0, 0, Bitmap);
except
on E: Exception do
//
end;
finally
FreeAndNil(StringStream);
FreeAndNil(JpegImage);
FreeAndNil(Bitmap);
end;
end;
end;
The problem is that you are saving the JPG binary data to a TStringStream and then letting it reinterpret the binary data as if it were string data. You can't do that. You need to save the JPG data to a binary stream instead, like TMemoryStream, and then encode the binary data using a string-safe encoding, like Base64.
Try something more like this instead:
uses
..., IdCoder, IdCoderMIME;
...
var
Jpg: TJPEGImage;
JpegStream: TMemoryStream;
strcams, StringImageData: String;
begin
try
JpegStream := TMemoryStream.Create;
try
Jpg := TJPEGImage.Create;
try
Jpg.Performance := jpBestSpeed;
Jpg.ProgressiveEncoding := True;
Jpg.ProgressiveDisplay := True;
Jpg.Assign(Image2.Picture.Bitmap);
Jpg.CompressionQuality := 25;
Jpg.Compress;
Jpg.SaveToStream(JpegStream);
finally
Jpg.Free;
end;
JpegStream.Position := 0;
StringImageData := TIdEncoderMIME.EncodeStream(JpegStream);
finally
JpegStream.Free;
end;
strcams := '<[S:' + IntToStr(Length(StringImageData)) + 'B]>' + StringImageData;
SendCommandWithParams('SIMGSEND', strcams + sep + 'IMGID5423' + sep);
except
on e: exception do
//
end;
end;
And then on the receiving end:
procedure CreateJpg(Data: string);
var
JpegStream: TMemoryStream;
JpegImage: TJPEGImage;
Bitmap: TBitmap;
tmpPos, tmpLen: integer;
pp: string;
begin
try
if not TextStartsWith(Data, '<[S:') then
begin
// bad data, do something else...
Exit;
end;
tmpPos := Pos('B]>', Data);
pp := Copy(Data, 5, tmpPos-5);
tmpLen := StrToInt(pp);
Data := Copy(Data, tmpPos+3, tmpLen);
Bitmap := TBitmap.Create;
try
JpegImage := TJpegImage.Create;
try
JpegStream := TMemoryStream.Create;
try
TIdDecoderMIME.DecodeStream(Data, JpegStream);
JpegStream.Position := 0;
JpegImage.LoadFromStream(JpegStream);
finally
JpegStream.Free;
end;
with Bitmap do
begin
Canvas.Lock;
try
Width := JpegImage.Width;
Height := JpegImage.Height;
Canvas.Draw(0, 0, JpegImage);
finally
Canvas.Unlock;
end;
end;
finally
JpegImage.Free;
end;
img.Picture.Assign(Bitmap);
finally
Bitmap.Free;
end;
except
on E: Exception do
//
end;
end;
Your problem appears to be that you are treating binary data as though it is text. Binary data can contain anything, for instance #13#10 line breaks or indeed anything whatsoever.
If you wish to send that data as text, then you need to use a text encoding. For example, encode it as base64.
Or transmit the content as binary rather than text.
Related
I look for an example, how to receive a file from server (I use Indy)
I want to send to server some demand
On client:
MyIdTCPClient.IOHandler.WriteLn('SEND_FILE');
MyIdTCPClient.IOHandler.WriteLn('1.XLS');
On Server
procedure TServerMainForm.IdTCPServerExecute(AContext: TIdContext);
var AStream : TMemoryStream;
filesize : Integer;
line, filename: String;
begin
line := AContext.Connection.IOHandler.ReadLn();
if line = 'SEND_FILE' then
begin
filename := AContext.Connection.IOHandler.ReadLn();
AStream := TIdFileStream.Create(filename, fmOpenRead + fmShareDenyNone);
try
AContext.Connection.IOHandler.Write('FILE_DOWNLOAD'); //send command "FILE"
AContext.Connection.IOHandler.Write(ExtractFilename(filename)); // send file name
AContext.Connection.IOHandler.Write(IntToStr(AStream.Size)); //send file size
AContext.Connection.IOHandler.Write(AStream);
finally
FreeAndNil(AStream);
end;
and then on Client
if MyIdTCPClient.IOHandler.InputBufferIsEmpty then
begin
MyIdTCPClient.IOHandler.CheckForDataOnSource(10);
if MyIdTCPClient.IOHandler.InputBufferIsEmpty then Exit;
end;
S := MyIdTCPClient.IOHandler.ReadLn();
if S = 'FILE_DOWNLOAD' then
begin
MyIdTCPClient.IOHandler.LargeStream := True;
if MyIdTCPClient.IOHandler.InputBufferIsEmpty then
begin
MyIdTCPClient.IOHandler.CheckForDataOnSource(10);
if MyIdTCPClient.IOHandler.InputBufferIsEmpty then Exit;
end;
Filename := MyIdTCPClient.IOHandler.ReadLn(); //filename
S := MyIdTCPClient.IOHandler.ReadLn(); // filesize
FileSize := StrToInt(S);
AStream := TIDFileStream.Create(ExtractFilePath(Paramstr(0)) + '\XLS\' + Filename, fmCreate);
try
AContext.Connection.IOHandler.ReadStream(AStream, Filesize, False);
finally
FreeAndNil(AStream);
end;
But it doesn't works.
Any file is not created on client;
Can you help me?
When sending the FILE_DOWNLOAD reply, the server is calling IOHandler.Write(String) instead of IOHandler.WriteLn() to send the FILE_DOWNLOAD and filename strings. The strings are not being terminated with CRLF, but the client is using ReadLn() to read those strings. So it never reaches the point where it tries to create the file and read into it.
That being said, I would suggest a slightly alternative design for your protocol and code.
You don't need to send filenames on their own lines. They should be on the same lines as the commands that they belong to.
TIdIOHandler.Write(TStream) and TIdIOHandler.ReadString() can handle sending/reading the stream size for you. You don't need to send/read the size manually, and certainly not as a string.
Try this instead:
Client
var
XLSFolder: string;
...
MyIdTCPClient.IOHandler.WriteLn('SEND_FILE 1.XLS');
...
if MyIdTCPClient.IOHandler.InputBufferIsEmpty then
begin
MyIdTCPClient.IOHandler.CheckForDataOnSource(10);
if MyIdTCPClient.IOHandler.InputBufferIsEmpty then Exit;
end;
S := MyIdTCPClient.IOHandler.ReadLn();
Cmd := Fetch(S);
if Cmd = 'FILE_DOWNLOAD' then
begin
AStream := TFileStream.Create(XLSFolder + S, fmCreate);
try
MyIdTCPClient.IOHandler.LargeStream := True;
MyIdTCPClient.IOHandler.ReadStream(AStream, -1, False);
finally
AStream.Free;
end;
end;
...
initialization
XLSFolder := ExtractFilePath(Paramstr(0)) + 'XLS\';
Server
procedure TServerMainForm.IdTCPServerExecute(AContext: TIdContext);
var
AStream : TFileStream;
cmd, params, filename: String;
begin
params := AContext.Connection.IOHandler.ReadLn();
cmd := Fetch(params);
if cmd = 'SEND_FILE' then
begin
filename := ExtractFilename(params);
try
AStream := TFileStream.Create('<some path>\' + filename, fmOpenRead or fmShareDenyWrite);
except
AContext.Connection.IOHandler.WriteLn('FILE_DOWNLOAD_ERR ' + filename);
Exit;
end;
try
AContext.Connection.IOHandler.WriteLn('FILE_DOWNLOAD ' + filename);
AContext.Connection.IOHandler.LargeStream := True;
AContext.Connection.IOHandler.Write(AStream, 0, True);
finally
AStream.Free;
end;
end;
end;
I have to send an XML-File to a Website with a secure Connection. Delphi 2010, Indy 10.5.9. The Code used is as follows:
Params: TIdMultiPartFormDataStream;
ResponseStr: string;
begin
result := 0;
sRootCertFile := 'xxx\Digital.pem';
sCertFile := 'xxx\Digital.pem';
sKeyFile := 'xxx\Digital.pem';
with FAdminSetup.RDWSSLHandler do
begin
SSLOptions.VerifyMode := [];
SSLOptions.VerifyDepth := 0;
SSLOptions.RootCertFile := sRootCertFile;
SSLOptions.CertFile := sCertFile;
SSLOptions.KeyFile := sKeyFile;
end;
sURL := 'https://xxx/xxxservice';
begin
IdHttpVVO := TIdHttp.Create(nil);
try
// IdHttpVVO.Request.ContentType := 'multipart/form-data';
// IdHttpVVO.ProtocolVersion := pv1_1;
// IdHttpVVO.HTTPOptions := [hoKeepOrigProtocol,hoForceEncodeParams];
// IdHttpVVO.Request.Connection := 'Keep-Alive';
// IdHttpVVO.Request.CacheControl := 'no-cache';
// IdHttpVVO.Request.ContentLength := Length(sAnsiXML); // <-- new
IdHttpVVO.IOHandler := FAdminSetup.RDWSSLHandler;
Params := TIdMultiPartFormDataStream.Create;
try
with Params do
begin
AddFile('file', filename, GetMIMETypeFromFile(filename));
end;
resultStr := IdHttpVVO.Post(sURL, Params);
finally
Params.Free;
end;
ShowMessage(resultstr);
The result is always the same:
'HTTP/1.0 500 Error'
when doing the post part.
All the remarks have been tried and did not give any change. The Password for the connection is supplied as follows:
procedure TFAdminSetup.RDWSSLHandlerGetPasswordEx(ASender: TObject;
var VPassword: AnsiString; const AIsWrite: Boolean);
begin
VPassword := 'xxx';
end;
The Website is working, the certificates seem to be ok, as there is a small tool included written in C that works.
Where is my mistake? Thanks
I am using indys idhttp to submit an URL (post)
Procedure submit_post(url_string,EncodedStr:string;amemo:TMemo);
var
aStream: TMemoryStream;
Params: TStringStream;
begin
aStream := TMemoryStream.create;
Params := TStringStream.create('');
try
with Fmain.IdHTTP1 do
begin
Params.WriteString(EncodedStr);
Request.ContentType := 'application/x-www-form-urlencoded';
Request.Charset := 'utf-8';
try
Response.KeepAlive := False;
Post(url_string, params, aStream);
except
on E: Exception do
begin
Screen.Cursor := crDefault;
exit;
end;
end;
end;
aStream.WriteBuffer(#0' ', 1);
aStream.Position := 0;
amemo.Lines.LoadFromStream(aStream);
Screen.Cursor := crDefault;
finally
aStream.Free;
Params.Free;
end;
end;
It works like a charm for me. I am trying to submit a URL (post) with a parameter containing 300 chars, but will be splittet automatically by adding an "&" every 90 chars. So the server only receives 90 chars instead of 300.
How can I submit an URL with a 300 character parameter without this automatic separation ?
function SubmitPost(Params:String): string;
const
URL= 'http://xxxx.com/register.php?';
var
lHTTP: TIdHTTP;
Source,
ResponseContent: TStringStream;
I:Integer;
begin
lHTTP := TIdHTTP.Create(nil);
lHTTP.Request.ContentType := 'text/xml';
lHTTP.Request.Accept := '*/*';
lHTTP.Request.Connection := 'Keep-Alive';
lHTTP.Request.Method := 'POST';
lHTTP.Request.UserAgent := 'OS Test User Agent';
Source := TStringStream.Create(nil);
ResponseContent:= TStringStream.Create;
try
try
lHTTP.Post(URL+Params, Source, ResponseContent);
Result := ResponseContent.DataString;
except
//your exception here
end;
finally
lHTTP.Free;
Source.Free;
ResponseContent.Free;
end;
end;
Usage
mmo1.Text := SubmitPost('Username=xxxx&Password=xxxx');
I found the mistake. My Post function works perfectly, but the URL is built by params coming from a memo line. With "WantReturns = FALSE", I can build a URL with the maximum line length of the memo. I guess 1024 characters per line which is okay for me.
This is my server's coding
procedure TForm1.IdTCPServerExecute(AThread: TIdPeerThread);
var
InputString: string;
ACommand: string[1];
AFileName: string;
ATempFileName: string;
AFileStream: TFileStream;
begin
InputString := UpperCase(AThread.Connection.ReadLn);
ACommand := Copy(InputString, 1, 1);
AFileName := FPicFilePath + Copy(InputString, 2, 5) + '.jpg';
if ACommand = 'R' then begin
AFileStream := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone);
try
AThread.Connection.WriteStream(AFileStream, true, true);
finally
AFileStream.Free;
end;
end else if ACommand = 'S' then begin
ATempFileName := FPicFilePath + 'TEMP.jpg';
if FileExists(ATempFileName) then
DeleteFile(ATempFileName);
AFileStream := TFileStream.Create(ATempFileName, fmCreate);
try
AThread.Connection.ReadStream(AFileStream, -1, false);
//RenameFile(ATempFileName, AFileName);
finally
AFileStream.Free;
end;
end;
AThread.Connection.Disconnect;
end;
And this is my client's coding
procedure TForm1.SendImageToServer(ASendCmd: string);
var
AFileStream: TFileStream;
begin
MessageDlg('Sending ' + ASendCmd + ' :' + FSendFileName, mtInformation, [mbOK], 0);
Screen.Cursor := crHourGlass;
with IdTCPClient do begin
if Connected then Disconnect;
Host := '127.0.0.1';
Port := 2108;
AFileStream := TFileStream.Create(FSendFileName, fmOpenRead);
try
try
Connect;
try
WriteLn(ASendCmd);
WriteStream(AFileStream, true, false);
finally
Disconnect;
end;
finally
AFileStream.Free;
end;
except
end;
end;
Screen.Cursor := crDefault;
end;
I can successfully get images from server, but when I had to send a new image back to server, I just had an empty TEMP.jpg.
Please help.
Thanks.
Delphi 5, Indy 9
When sending a file from the client to the server, the client is not telling WriteStream() to send the stream size, but the server is telling ReadStream() to expect the stream size to arrive, so you have a mismatch.
When sending a file from the server to the client, the server is telling WriteStream() to send the stream size, and the client is telling ReadStream() to expect the stream size to arrive, so there is no mismatch.
I am trying to retrieve a large number of images from the web using a TidHttp component.
The problem is that there is a number of images that are missing (Example: 7403, 7412, etc)
How do i test for only those that exist and save those to file?
procedure TForm.Button1Click(Sender: TObject);
var
MS : TMemoryStream;
JPEGImage: TJPEGImage;
Url, numString: String;
I, Code: Integer;
begin
for I := 7400 to 7500 do
begin
{
Url :='http://www.mywebpage.com/images/DSC' + numString+ '.jpg';
try
idhttp1.Head(URL);
code := idhttp1.ResponseCode;
except on E: EIdHTTPProtocolException do
code := idhttp1.ResponseCode;
end;//try except
if code = 200 then
begin
MS := TMemoryStream.Create;
JPEGImage := TJPEGImage.Create;
try
try
idhttp1.Get(Url, MS); //Send the request and get the image
code := idhttp1.ResponseCode;
MS.Seek(0,soFromBeginning);
JPEGImage.LoadFromStream(MS);//load the image in a Stream
Image1.Picture.Assign(JPEGImage);//Load the image in a Timage component
Image1.Picture.SaveToFile('C:\Museum_Data\DSC' + numString + '.jpg');
Application.ProcessMessages;
except
on E: EIdHTTPProtocolException do
code := idhttp1.ResponseCode; // or: code := E.ErrorCode;
end; //try except
finally
MS.free;
JPEGImage.Free;
end; //try finally
end; //if
end;
end;
You don't have to do anything extra for that. If you try to access a non-existant URL, the HTTP server will report an error that TIdHTTP than wraps into an EIdHTTPProtocolException exception. You do not have to bother with calling TIdHTTP.Head() first, since you are downloading the images to a TMemoryStream before saving them. You can catch the exception when calling TIdHTTP.Get() by itself, no need to check the ResponseCode at all.
Try this:
procedure TForm.Button1Click(Sender: TObject);
var
MS: TMemoryStream;
JPEG: TJPEGImage;
Url: String;
I: Integer;
begin
MS := TMemoryStream.Create;
try
JPEG := TJPEGImage.Create;
try
for I := 7400 to 7500 do
begin
Url := 'http://www.mywebpage.com/images/DSC' + IntToStr(I) + '.jpg';
MS.Clear;
try
IdHTTP1.Get(Url, MS);
except
on E: EIdHTTPProtocolException do
Continue;
end;
MS.Position := 0;
JPEG.LoadFromStream(MS);
Image1.Picture.Assign(JPEG);
JPEG.SaveToFile('C:\Museum_Data\DSC' + IntToStr(I) + '.jpg');
Application.ProcessMessages;
end;
finally
JPEG.Free;
end;
finally
MS.Free;
end;
end;
You do not actually need the TImage in order to save the data to file. If you can omit the TImage.Picture.Assign() stage, then the code a bit simpler by eliminating the TJPEGImage altogether (unless you are trying to validate the download files are valid), eg:
procedure TForm.Button1Click(Sender: TObject);
var
MS: TMemoryStream;
Url: String;
I: Integer;
begin
MS := TMemoryStream.Create;
try
for I := 7400 to 7500 do
begin
Url := 'http://www.mywebpage.com/images/DSC' + IntToStr(I) + '.jpg';
MS.Clear;
try
IdHTTP1.Get(Url, MS);
except
on E: EIdHTTPProtocolException do
Continue;
end;
MS.Position := 0;
MS.SaveToFile('C:\Museum_Data\DSC' + IntToStr(I) + '.jpg');
Application.ProcessMessages;
end;
finally
MS.Free;
end;
end;
Or:
procedure TForm.Button1Click(Sender: TObject);
var
FS: TFileStream;
Url, FileName: String;
I: Integer;
begin
for I := 7400 to 7500 do
begin
Url := 'http://www.mywebpage.com/images/DSC' + IntToStr(I) + '.jpg';
FileName := 'C:\Museum_Data\DSC' + IntToStr(I) + '.jpg';
FS := TFileStream.Create(FileName, fmCreate);
try
try
try
IdHTTP1.Get(Url, FS);
except
on E: EIdHTTPProtocolException do
Continue;
end;
Application.ProcessMessages;
finally
Fs.Free;
end;
except
DeleteFile(FileName);
end;
end;
end;