I've written a DataSnap server method that returns a TStream object to transfer a file. The client application calls the method and reads the stream fine. My issue is that the method call takes a while to complete before the TStream object is available to read, but on the server side I can see that the method call only takes a second to create the object to return. I was hoping the stream object would be returned immediately so that I can read the stream and display a progress bar for the download progress. Is there another way I can do this?
The server method is very simple :
function TServerMethods.DespatchDocument(sCompanyID, sDocOurRef: string): TStream;
var
sSourceFilePath: string;
strFileStream: TFileStream;
begin
sSourceFilePath := GetDocumentPDFFilePath(sCompanyID, sDocOurRef);
strFileStream := TFileStream.Create(sSourceFilePath, fmOpenRead);
Result := strFileStream;
end;
This is how I did it a while back. I used XE and haven't had a chance to clean it up.
//Server side:
function TServerMethods1.DownloadFile(out Size: Int64): TStream;
begin
Result := TFileStream.Create('upload.fil', fmOpenRead or fmShareDenyNone);
Size := Result.Size;
Result.Position := 0;
end;
//Client side:
procedure TfMain.DownloadFile(Sender: TObject);
var
RetStream: TStream;
Buffer: PByte;
Mem: TMemoryStream;
BytesRead: Integer;
DocumentId: Int64;
Size: Int64;
filename: WideString;
BufSize: Integer;
begin
BufSize := 1024;
try
Mem := TMemoryStream.Create;
GetMem( Buffer, BufSize );
try
RetStream := FDownloadDS.DownloadFile(Size);
RetStream.Position := 0;
if ( Size <> 0 ) then
begin
filename := 'download.fil';
repeat
BytesRead := RetStream.Read( Pointer( Buffer )^, BufSize );
if ( BytesRead > 0 ) then
begin
Mem.WriteBuffer( Pointer( Buffer )^, BytesRead );
end;
lStatus.Caption := IntToStr( Mem.Size ) + '/' + IntToStr( Size );
Application.ProcessMessages;
until ( BytesRead < BufSize );
if ( Size <> Mem.Size ) then
begin
raise Exception.Create( 'Error downloading file...' );
end;
end
else
begin
lStatus.Caption := '';
end;
finally
FreeMem( Buffer, BufSize );
FreeAndNIl(Mem);
end;
except
on E: Exception do
begin
lErrorMessage.Caption := PChar( E.ClassName + ': ' + E.Message );
end;
end;
end;
You can adjust BufSize however you like. I was having trouble getting the size of the stream until I did it this way. I experimented with XE2 and didn't seem to have the same problem but I was uploading. There is probably a better way to retrieve the size of the stream. If I get the answer soon I'll let you know....
On another note - I haven't figured out how to display a progress bar on the server side. I'm still trying to figure this out too.
I hope this helps! Let me know if you have any questions!
Glad you have some luck! This is the other fix I had to do. You can refer to this link https://forums.embarcadero.com/thread.jspa?threadID=66490&tstart=0
After diving in the code I found in "Data.DBXJSONReflect.pas"
procedure TJSONPopulationCustomizer.PrePopulate(Data: TObject; rttiContext: TRttiContext);
...
3473: rttiField.GetValue(Data).AsObject.Free;
3474: rttiField.SetValue(Data, TValue.Empty);
...
I think it should be this way:
3473: rttiField.SetValue(Data, TValue.Empty);
3474: rttiField.GetValue(Data).AsObject.Free;
Related
I am in need of passing a couple things using Data Snap in Delphi XE6 (TStream & TClientdataSet). Lets start with a TStream - maybe what I learn here, I can figure out the TClientDataSet.
Here is my attempt, but it throws an error:
Remote error: Access violaion at address 0040801C in module DSServer.exe
Client demo (DSClient.exe)
//RunReportObj is the real object I will be passing to the server method
Procedure TForm8.Button1Click(Sender: TObject);
var
RunReportObj: TRunReportObject;
S: TStream;
FS: TFileStream;
begin
RunReportObj:= TRunReportObject.Create;
RunReportObj.ID:= '10101';
RunReportObj.ReportName:= 'Test';
RunReportObj.ExportType:= 'PDF';
S:= TStream.Create;
try
S:= ClientModule1.ServerMethods1Client.GetReport(RunReportObj);
S.Seek(0,soFromBeginning);
FS:= TFileStream.Create(RunReportObj.ReportName + '.' + RunReportObj.ExportType, fmOpenWrite);;
try
FS.CopyFrom(S, S.Size);
finally
FS.Free;
end;
finally
S.Free;
end;
end;
ClientClassesUnit1.pas
function TServerMethods1Client.GetReport(RunReportObj: TRunReportObject): TStream;
begin
if FGetReportCommand = nil then
begin
FGetReportCommand := FDBXConnection.CreateCommand;
FGetReportCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FGetReportCommand.Text := 'TServerMethods1.GetReport';
FGetReportCommand.Prepare;
end;
if not Assigned(RunReportObj) then
FGetReportCommand.Parameters[0].Value.SetNull
else
begin
FMarshal := TDBXClientCommand(FGetReportCommand.Parameters[0].ConnectionHandler).GetJSONMarshaler;
try
FGetReportCommand.Parameters[0].Value.SetJSONValue(FMarshal.Marshal(RunReportObj), True);
if FInstanceOwner then
RunReportObj.Free
finally
FreeAndNil(FMarshal)
end
end;
FGetReportCommand.ExecuteUpdate;
Result := FGetReportCommand.Parameters[1].Value.GetStream(FInstanceOwner);
end;
Server demo (DSServer.exe)
//not really doing anything with the RunReportObj yet,
// just trying to test whether or not I can pass a TStream back first
function TServerMethods1.GetReport(RunReportObj: TRunReportObject): TStream;
var
Stream: TMemoryStream;
Writer: TBinaryWriter;
Bytes: TBytes;
begin
result := TMemoryStream.Create;
try
Writer := TBinaryWriter.Create(result);
try
Writer.Write(TEncoding.UTF8.GetBytes('Hello World' + sLineBreak));
finally
Writer.Free;
end;
finally
Stream.Free;
end;
end;
I'm sure I did something foolish :)
You have to take care who is responsible for freeing objects sent with DataSnap. TServerMethods1.GetReport() should not free the Result, as it has to be sent to the client first. On the other side, the client should not free the TStream it gets from TServerMethods1Client.GetReport(), as long as FInstanceOwner is true (which it is by default).
The first condition is fulfilled more by accident, although as David pointed out, you are freeing the uninitialized local variable Stream.
Without being able to actually test this in the moment, the correct code for the client should look like:
Procedure TForm8.Button1Click(Sender: TObject);
var
RunReportObj: TRunReportObject;
S: TStream;
FS: TFileStream;
begin
RunReportObj:= TRunReportObject.Create;
RunReportObj.ID:= '10101';
RunReportObj.ReportName:= 'Test';
RunReportObj.ExportType:= 'PDF';
S:= ClientModule1.ServerMethods1Client.GetReport(RunReportObj);
S.Seek(0,soFromBeginning);
FS:= TFileStream.Create(RunReportObj.ReportName + '.' + RunReportObj.ExportType, fmOpenWrite);;
try
FS.CopyFrom(S, S.Size);
finally
FS.Free;
end;
end;
And for the server side:
function TServerMethods1.GetReport(RunReportObj: TRunReportObject): TStream;
var
Writer: TBinaryWriter;
Bytes: TBytes;
begin
result := TMemoryStream.Create;
Writer := TBinaryWriter.Create(result);
try
Writer.Write(TEncoding.UTF8.GetBytes('Hello World' + sLineBreak));
finally
Writer.Free;
end;
end;
I'm trying to send buffer from client to the server...Buffer revived but i get error message 'data error' while converting the buffer into steam on the server side.
Also i tried to send that buffer as a Stream but i get error message on the server side Out of memory
Client:
procedure TAudio.Buffer(Sender: TObject; Data: Pointer; Size: Integer);
var
Stream: TMemoryStream;
Buff:string;
begin
Move(Data^, ACMC.BufferIn^, Size);
if AConn.Client.Connected then begin
Stream := TMemoryStream.Create;
Stream.WriteBuffer(ACMC.BufferOut^, ACMC.Convert);
Stream.Position := 0;
Buff := ZCompressStreamToString(Stream);
AConn.Client.IOHandler.WriteLn(Buff);
Stream.Free;
Writeln('sent');
end;
end;
Server Thread:
try
List := MainForm.idtcpsrvrMain.Contexts.LockList;
try
if List.IndexOf(Ctx) <> -1 then
begin
TMainContext(Ctx).Queue.Add(EncryptStr('AUDIO|2|'+BYTES));
Stream:
Buffer := TMainContext(Ctx).Connection.IOHandler.ReadLn;
mStream := TMemoryStream.Create;
try
ZDecompressStringToStream(Buffer,mStream);
mStream.Position := 0;
SetLength(Buffer,mStream.Size);
mStream.ReadBuffer(pointer(Buffer)^,mStream.Size);
SendMessage(hLstbox,LB_ADDSTRING,0,lparam(Buffer));
iList := SendMessage(hLstbox,LB_GETCOUNT,0,0);
SendMessage(hLstbox,LB_SETTOPINDEX,iList-1,0);
ACMO.Play(Pointer(Buffer)^,Length(Buffer));
finally
mStream.Free;
end;
if NodesList.Items[index].TerminateAudioThreads then
begin
..
..
Terminate;
end
else goto Stream;
Note:
both ZCompressStreamToString & ZDecompressStringToStream functions are tested on the client side and its worked.
I have multiple services processing some files. Each service must have exclusive access to the file while processing. I solved this problem a while ago by creating a global mutex that uses some temp files, something like this:
function AppLocked: boolean;
begin
result := FileExists(GetTempDir + '__MUTEX__' + LockExt);
end;
procedure AppLock;
var
F: TextFile;
begin
if FileExists(GetTempDir + '__MUTEX__' + LockExt) then
exit
else
try
AssignFile(F, GetTempDir + '__MUTEX__' + LockExt);
Rewrite(F);
Writeln(F, DateTimeToStr(Now));
CloseFile(F);
except
end;
end;
procedure AppUnLock;
begin
if FileExists(GetTempDir + '__MUTEX__' + LockExt) then
SysUtils.DeleteFile(GetTempDir + '__MUTEX__' + LockExt);
end;
This works pretty good, and I don't want to fix something that works, but I just wonder, is there a better solution?
An actual Mutex (as in win32 Mutex) is the preferred method.
Your solution has a problem, if the application terminates and you missed to unlock. This could happen on an abnormal termination. It would be better to create a file, that will automatically erase itself if the application terminates.
All the magic is done by FILE_FLAG_DELETE_ON_CLOSE
unit uAppLock;
interface
function AppLocked : Boolean;
function AppLock : Boolean;
procedure AppUnlock;
implementation
uses
Windows, SysUtils, Classes;
var
// unit global variable
LockFileHandle : THandle;
// function to build the filename
function GetLockFileName : string;
begin
// You have to point out, where to get these informations
Result := GetTempDir + '__MUTEX__' + LockExt;
end;
function AppLocked : Boolean;
begin
Result := FileExists( GetLockFileName );
end;
function AppLock : Boolean;
var
LFileName : string;
LLockFileStream : TStream;
LInfoStream : TStringStream;
begin
Result := False;
if AppLock
then
Exit;
LFileName := GetLockFileName;
// Retrieve the handle of the LockFile
LockFileHandle := CreateFile( PChar( LFileName ), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_DELETE,
nil, CREATE_NEW, FILE_FLAG_DELETE_ON_CLOSE or FILE_ATTRIBUTE_TEMPORARY, 0 );
if LockFileHandle <> INVALID_HANDLE_VALUE
then
begin
Result := True;
LInfoStream := nil;
LLockFileStream := nil;
try
LInfoStream := TStringStream.Create;
LInfoStream.WriteString( DateTimeToStr( Now ) );
LInfoStream.Seek( 0, soFromBeginning );
LLockFileStream := THandleStream.Create( LockFileHandle );
LLockFileStream.CopyFrom( LInfoStream, LInfoStream.Size );
finally
LInfoStream.Free;
LLockFileStream.Free;
end;
end;
end;
procedure AppUnlock;
begin
// Just close the handle and the file will be deleted
CloseHandle( LockFileHandle );
end;
end.
BTW: GetTempDir looks to be a Directory, but you use it as a Path. So it would be better to rename it into GetTempPath instead :o)
I don't know much about delphi win 32 programming, but I hope someone can answer my question.
I get duplicate l_sGetUniqueIdBuffer saved into the database which I want to avoid.
The l_sGetUniqueIdBuffer is actually different ( the value of l_sAuthorisationContent is xml, and I can see a different value generated by the call to getUniqueId) between rows. This problem is intermittant ( duplicates are rare...) There is only milliseconds difference between the update date between the rows.
Given:
( unnesseary code cut out)
var
l_sGetUniqueIdBuffer: PChar;
FOutputBufferSize : integer;
begin
FOutputBufferSize := 1024;
...
while( not dmAccomClaim.ADOQuClaimIdentification.Eof ) do
begin
// Get a unique id for the request
l_sGetUniqueIdBuffer := AllocMem (FOutputBufferSize);
l_returnCode := getUniqueId (m_APISessionId^, l_sGetUniqueIdBuffer, FOutputBufferSize);
dmAccomClaim.ADOQuAddContent.Active := False;
dmAccomClaim.ADOQuAddContent.Parameters.ParamByName('pContent').Value := (WideString(l_sAuthorisationContent));
dmAccomClaim.ADOQuAddContent.Parameters.ParamByName('pClaimId').Value := dmAccomClaim.ADOQuClaimIdentification.FieldByName('SB_CLAIM_ID').AsString;
dmAccomClaim.ADOQuAddContent.Parameters.ParamByName('pUniqueId').Value := string(l_sGetUniqueIdBuffer);
dmAccomClaim.ADOQuAddContent.ExecSQL;
FreeMem( l_sAuthorisationContent, l_iAuthoriseContentSize );
FreeMem( l_sGetUniqueIdBuffer, FOutputBufferSize );
end;
end;
I guess i need to know, is the value in l_sGetUniqueIdBuffer being reset for every row??
AllocMem is implemented as follows
function AllocMem(Size: Cardinal): Pointer;
begin
GetMem(Result, Size);
FillChar(Result^, Size, 0);
end;
so yes, the value that l_sGetUniqueBuffer is pointing to will always be reset to an empty string.
Debugging
var
l_sGetUniqueIdBuffer: PChar;
FOutputBufferSize : integer;
list: TStringList;
begin
FOutputBufferSize := 1024;
...
list := TStringList.Create;
try
list.Sorted := True;
while( not dmAccomClaim.ADOQuClaimIdentification.Eof ) do
begin
// Get a unique id for the request
l_sGetUniqueIdBuffer := AllocMem (FOutputBufferSize);
l_returnCode := getUniqueId (m_APISessionId^, l_sGetUniqueIdBuffer, FOutputBufferSize);
dmAccomClaim.ADOQuAddContent.Active := False;
dmAccomClaim.ADOQuAddContent.Parameters.ParamByName('pContent').Value := (WideString(l_sAuthorisationContent));
dmAccomClaim.ADOQuAddContent.Parameters.ParamByName('pClaimId').Value := dmAccomClaim.ADOQuClaimIdentification.FieldByName('SB_CLAIM_ID').AsString;
dmAccomClaim.ADOQuAddContent.Parameters.ParamByName('pUniqueId').Value := string(l_sGetUniqueIdBuffer);
if list.IndexOf(l_sGetUniqueIdBuffer) <> - 1 then
write; //***** Place a breakpoint here.
list.Add(l_sGetUniqueIdBuffer);
dmAccomClaim.ADOQuAddContent.ExecSQL;
FreeMem( l_sAuthorisationContent, l_iAuthoriseContentSize );
FreeMem( l_sGetUniqueIdBuffer, FOutputBufferSize );
end;
finally
list.Free;
end;
end;
I am trying to stream an XML File from Server To Client using DataSnap, with the help of ldsandon, i was able to download the sample from embarcadero, but my problem is I cannot follow it.
a pseudo of the program should work this way.
client will request from the server for selected xml file in the combobox.
the server will load the client selected xml file back to client.
i am just am trying to figure it out using delphi DataSnap, if not I will either use synapse or indy for tranferring the file, but I found Datasnap to be interesting.
could anyone help me please, a working if possible?
thanks a lot.
Please Help me, I need your help very badly.. thanks and thanks
I found this link, but I could not figure out how to convert it to TFileStream
// server side
function TServerMethods1.GetCDSXML(SQL: String; var FileSize: Integer): TStream;
begin
QryMisc.Close;
QryMisc.SQL.Text := SQL;
CDSMisc.Open;
Result := TMemoryStream.Create;
try
CDSMisc.SaveToStream(Result, dfXML);
FileSize := Result.Size; // not CDSMisc.DataSize;
Result.Position := 0; // Seek not implemented in abstract class
finally
CDSMisc.Close;
end;
end;
// client side
procedure TClientModule1.PopMiscCDS(SQL: String);
const
BufSize = $8000;
var
RetStream: TStream;
Buffer: PByte;
MemStream: TMemoryStream;
BytesRead: Integer;
FileSize: Integer;
begin
try
MemStream := TMemoryStream.Create;
GetMem(Buffer, BufSize);
try
//---------------------------------------------------------
RetStream := ServerMethods1Client.GetCDSXML(SQL, FileSize);
//---------------------------------------------------------
repeat
BytesRead := RetStream.Read(Pointer(Buffer)^, BufSize);
if BytesRead > 0 then
MemStream.WriteBuffer(Pointer(Buffer)^, BytesRead);
until BytesRead < BufSize;
if FileSize <> MemStream.Size then
raise Exception.Create('Error downloading xml');
MemStream.Seek(0, TSeekOrigin.soBeginning);
CDSMisc.Close;
CDSMisc.LoadFromStream(MemStream);
finally
FreeMem(Buffer, BufSize);
MemStream.Free;
end;
except
on E: Exception do
begin
ShowMessage(E.Message);
end;
end;
end;