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;
Related
In Delphi 10.4, I try to save a valid TPicture base64-encoded to an INI file:
procedure TForm1.SavePictureToIniFile(const APicture: TPicture);
var
LInput: TMemoryStream;
LOutput: TMemoryStream;
MyIni: TIniFile;
ThisFile: string;
begin
if FileSaveDialog1.Execute then
ThisFile := FileSaveDialog1.FileName
else EXIT;
LInput := TMemoryStream.Create;
LOutput := TMemoryStream.Create;
try
APicture.SaveToStream(LInput);
LInput.Position := 0;
TNetEncoding.Base64.Encode(LInput, LOutput);
LOutput.Position := 0;
MyIni := TIniFile.Create(ThisFile);
try
MyIni.WriteBinaryStream('Custom', 'IMG', LOutput); // Exception# 234
finally
MyIni.Free;
end;
finally
LInput.Free;
LOutput.Free;
end;
end;
WriteBinaryStream creates an exception:
ERROR_MORE_DATA 234 (0xEA) More data is available.
Why? What does this mean? How can this problem be solved?
EDIT: Taking into consideration what #Uwe Raabe and #Andreas Rejbrand said, this code (which does not use base64-encoding) now works:
procedure TForm1.SavePictureToIniFile(const APicture: TPicture);
var
LInput: TMemoryStream;
MyIni: System.IniFiles.TMemIniFile;
ThisFile: string;
begin
if FileSaveDialog1.Execute then
ThisFile := FileSaveDialog1.FileName
else EXIT;
LInput := TMemoryStream.Create;
try
APicture.SaveToStream(LInput);
LInput.Position := 0;
MyIni := TMemIniFile.Create(ThisFile);
try
MyIni.WriteBinaryStream('Custom', 'IMG', LInput);
MyIni.UpdateFile;
finally
MyIni.Free;
end;
finally
LInput.Free;
end;
end;
I believe this is a limitation in the operating system's functions for handling INI files; the string is too long for it.
If you instead use the Delphi INI file implementation, TMemIniFile, it works just fine. Just don't forget to call MyIni.UpdateFile at the end.
Yes, this is indeed a limitation in the Windows API, as demonstrated by the following minimal example:
var
wini: TIniFile;
dini: TMemIniFile;
begin
wini := TIniFile.Create('C:\Users\Andreas Rejbrand\Desktop\winini.ini');
try
wini.WriteString('General', 'Text', StringOfChar('W', 10*1024*1024));
finally
wini.Free;
end;
dini := TMemIniFile.Create('C:\Users\Andreas Rejbrand\Desktop\pasini.ini');
try
dini.WriteString('General', 'Text', StringOfChar('D', 10*1024*1024));
dini.UpdateFile;
finally
dini.Free;
end;
(Recall that INI files were initially used to store small amounts of configuration data in the 16-bit Windows era.)
Also, Uwe Raabe is right: you should save the Base64 string as text.
All,
I am working on a new datasnap project based on the example project located in C:\Users\Public\Documents\Embarcadero\Studio\18.0\Samples\Object Pascal\DataSnap\FireDAC_DBX.
I am trying to transfer a large stream (1,606,408 bytes) from datasnap server to client. I am running into what appears to be a common issue and that is that the entire stream does not make it to the client.
Here is my server code:
//Returns Customer Info
function TServerMethods.GetBPInfo(CardCode : String): TStringStream;
begin
Result := TStringStream.Create;
try
qBPInfo.Close;
if CardCode.Trim = '' then
qBPInfo.ParamByName('ParmCardCode').AsString := '%%'
else
qBPInfo.ParamByName('ParmCardCode').AsString := '%' + CardCode + '%';
qBPInfo.Open;
FDSchemaAdapterBPInfo.SaveToStream(Result, TFDStorageFormat.sfBinary);
Result.Position := 0;
// Result.SaveToFile('output.adb');
except
raise;
end;
end;
Here is my client code:
procedure TdmDataSnap.GetBPInfo(CardCode : String);
var
LStringStream : TStringStream;
begin
dmDataSnap.FDStoredProcBPInfo.ParamByName('CardCode').AsString := CardCode;
FDStoredProcBPInfo.ExecProc;
LStringStream := TStringStream.Create(FDStoredProcBPInfo.ParamByName('ReturnValue').asBlob);
//LStringStream.Clear;
//LStringStream.LoadFromFile('Output.adb');
try
if LStringStream <> nil then
begin
LStringStream.Position := 0;
try
DataModuleFDClient.FDSchemaAdapterBP.LoadFromStream(LStringStream, TFDStorageFormat.sfBinary);
except
on E : Exception do
showmessage(e.Message);
end;
end;
finally
LStringStream.Free;
end;
end;
You will see the stream save and load code; that is how I determined that the server was getting the entire result set into the stream, and that the client could handle the entire result set and display it properly.
So smaller streams transfer just fine, but this big one, when examined in the ide debugger, does not start with the 65,66,68,83 characters and the load fails with the error, '[FireDAC][Stan]-710. Invalid binary storage format'.
I know from extended Googling that there are work-arounds for this, but I do not understand how to apply the workarounds to my case, with the use of Tfdstoredproc and TfdSchemaAdaptor components. I'm trying to stay with this coding scheme.
How do I adapt this code to correctly receive large streams?
Update 1:
Ok, I tried strings and Base64 encoding. It didn't work.
Client Code:
procedure TdmDataSnap.GetBPInfo(CardCode : String);
var
LStringStream : TStringStream;
TempStream : TStringStream;
begin
dmDataSnap.FDStoredProcBPInfo.ParamByName('CardCode').AsString := CardCode;
FDStoredProcBPInfo.ExecProc;
try
TempStream := TStringStream.Create;
TIdDecoderMIME.DecodeStream(FDStoredProcBPInfo.ParamByName('ReturnValue').asString,TempStream);
if TempStream <> nil then
begin
TempStream.Position := 0;
try
DataModuleFDClient.FDSchemaAdapterBP.LoadFromStream(TempStream, TFDStorageFormat.sfBinary);
except
on E : Exception do
showmessage(e.Message);
end;
end;
finally
TempStream.Free;
end;
end;
Here is my server code:
//Returns Customer Info
function TServerMethods.GetBPInfo(CardCode : String): String;
var
TempStream : TMemoryStream;
OutputStr : String;
begin
Result := '';
TempStream := TMemoryStream.Create;
try
try
qBPInfo.Close;
if CardCode.Trim = '' then
qBPInfo.ParamByName('ParmCardCode').AsString := '%%'
else
qBPInfo.ParamByName('ParmCardCode').AsString := '%' + CardCode + '%';
qBPInfo.Open;
FDSchemaAdapterBPInfo.SaveToStream(TempStream, TFDStorageFormat.sfBinary);
TempStream.Position := 0;
OutputStr := IdEncoderMIMEBPInfo.EncodeStream(TempStream);
Result := OutputStr
except
raise;
end;
finally
TempStream.Free;
end;
end;
The result is the same.
I have searched high and low for a working solution for sending an image (e.g. tpngimage) to the server using a datasnap method - but I cannot make it to work.
When I load the image and save it to a memorystream, I'm able to read the image back from the stream - locally in the client, which is not really a surprise. But when the server method gets called, the stream is nil and contains nothing, the other parameters are fine (simple datatype and an object).
Did I miss something obvious here? I was under the impression that TStream is a valid datatype for datasnap methods, but maybe I'm wrong?
The from client side it looks like this.
function TPerson.Update: Boolean;
var
AStream : TMemoryStream;
APicture : TPngImage;
ASize : Integer;
begin
if (FId > 0) then // if Id below zero we have a problem
begin
ClientModule1.ServerMethods1Client.UpdatePerson(Self);
APicture := TPngImage.Create;
AStream := TMemoryStream.Create;
try
// Temp just use a file
AStream.LoadFromFile('.\images\075.png');
ASize := AStream.Size;
AStream.Position := 0; // wind back if needed
// just for testing, we can read back the image from the stream
APicture.LoadFromStream(AStream);
ClientModule1.ServerMethods1Client.UpdatePersonPicture(self, ASize, AStream);
finally
FreeAndNil(AStream);
FreeAndNil(APicture);
end;
end;
FModified := False;
end;
And the proxy method looks like this
procedure TServerMethods1Client.UpdatePersonPicture(APerson: TPerson; ASize: Integer; APictureStream: TMemoryStream);
begin
if FUpdatePersonPictureCommand = nil then
begin
FUpdatePersonPictureCommand := FDBXConnection.CreateCommand;
FUpdatePersonPictureCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FUpdatePersonPictureCommand.Text := 'TServerMethods1.UpdatePersonPicture';
FUpdatePersonPictureCommand.Prepare;
end;
if not Assigned(APerson) then
FUpdatePersonPictureCommand.Parameters[0].Value.SetNull
else
begin
FMarshal := TDBXClientCommand(FUpdatePersonPictureCommand.Parameters[0].ConnectionHandler).GetJSONMarshaler;
try
FUpdatePersonPictureCommand.Parameters[0].Value.SetJSONValue(FMarshal.Marshal(APerson), True);
if FInstanceOwner then
APerson.Free
finally
FreeAndNil(FMarshal)
end
end;
FUpdatePersonPictureCommand.Parameters[1].Value.SetInt32(ASize);
FUpdatePersonPictureCommand.Parameters[2].Value.SetStream(APictureStream, FInstanceOwner);
FUpdatePersonPictureCommand.ExecuteUpdate;
end;
The Server method looks like this - it fails due to the APictureStream is nil.
procedure TServerMethods1.UpdatePersonPicture(APerson: TPerson; ASize: integer;
APictureStream: TMemoryStream);
var
APicture : TPngImage;
begin
fdqPersons.Close;
fdqPersons.SQL.Clear;
fdqPersons.Connection.StartTransaction;
try
fdqPersons.SQL.Add('update Persons set Picture=:Picture ');
fdqPersons.SQL.Add('where Id=:Id');
fdqPersons.ParamByName('Id').Value := APerson.Id;
APicture := TPngImage.Create;
try
// APicture for testing - but APictureStream is nil!
APicture.LoadFromStream(APictureStream);
fdqPersons.ParamByName('Picture').Assign(APicture);
fdqPersons.ExecSQL;
finally
FreeAndNil(APicture);
end;
fdqPersons.Close;
fdqPersons.Connection.Commit;
LogEvent(format('Person picture updated ID: %d',[APerson.id]));
except
on e:exception do
begin
fdqPersons.Connection.Rollback;
LogEvent(format('Error updating person picture %s',[e.Message]));
raise;
end;
end;
end;
When you call APicture.LoadFromStream(AStream); the stream's position goes to the end, and therefore when passing it into ClientModule1 it does not have any data left to be read. Either get rid of the unnecessary portion where you write the stream to a TPngImage or reset the stream's position back to 0 just after that part.
This program raises an I/O 104 error on EoF when first entering the while loop.
The purpose of the program is to look up if a username is already taken. The existing usernames are stored in a text file.
procedure TForm1.btnRegisterClick(Sender: TObject);
begin
sCUser := edtUserName.Text;
AssignFile(tNames, 'Names.txt');
begin
try
Reset(tNames);
except
ShowMessage('File not found');
Exit;
end;
end;
rewrite(tNames);
while not EoF(tNames) do // I get a I/O 104 Error here `
begin
Readln(tNames, sLine);
iPosComme := Pos(',', sLine);
sUser := Copy(sLine, 1, iPosComme - 1);
Delete(sLine, 1, iPosComme - 1);
if sCUser = sUser then begin
ShowMessage('Username taken');
end
else
begin
rewrite(tNames);
Writeln(tNames, sCUser + ',' + '0');
CloseFile(tNames);
end;
end;
end;
Remove the call to Rewrite()before Eof(). Even if you were not getting an IO error, your code would still fail because Rewrite() closes the file you opened with Reset() and then it creates a new bank file, so Eof() would always be True.
Update: error 104 is file not open for input, which means Reset() is not opening the file but is not raising an exception (which sounds like an RTL bug if Eof() is raising an exception, indicating that {I+} is active).
In any case, using AssignFile() and related routines is the old way to do file I/O. You should use newer techniques, like FileOpen() with FileRead(), TFileStream with TStreamReader, TStringList, etc...
Update: your loop logic is wrong. You are comparing only the first line. If it does not match the user, you are wiping out the file, writing the user to a new file, closing the file, and then continuing the loop. EoF() will then fail at that point. You need to rewrite your loop to the following:
procedure TForm1.btnRegisterClick(Sender: TObject
var
SCUser, sUser: String;
tNames: TextFile;
iPosComme: Integer;
Found: Boolean;
begin
sCUser := edtUserName.Text;
AssignFile(tNames,'Names.txt');
try
Reset(tNames);
except
ShowMessage('File not found');
Exit;
end;
try
Found := False;
while not EoF(tNames) do
begin
Readln(tNames,sLine);
iPosComme := Pos(',', sLine);
sUser := Copy(sLine ,1,iPosComme -1);
if sCUser = sUser then
begin
ShowMessage('Username taken') ;
Found := True;
Break;
end;
end;
if not Found then
Writeln(tNames,sCUser + ',0');
finally
CloseFile(tNames);
end;
end;
For the sake of completeness, this Version works for me, but it is hard to guess what the code is intended to do. Especially the while loop seems a bit displaced, since the file will contain exactly one line after the rewrite-case has ben hit once.
program wtf;
{$APPTYPE CONSOLE}
{$I+}
uses
SysUtils;
procedure Sample( sCUser : string);
var sUser, sLine : string;
iPosComme : Integer;
tnames : textfile;
begin
AssignFile(tNames,'Names.txt');
try
Reset(tNames);
except
Writeln('File not found');
Exit;
end;
while not EoF(tNames) do
begin
Readln(tNames,sLine);
iPosComme := Pos(',', sLine);
sUser := Copy(sLine ,1,iPosComme -1);
Delete( sLine,1, iPosComme -1);
if sCuser = sUser then begin
Writeln('Username taken') ;
end
else begin
Rewrite(tNames);
Writeln(tNames,sCUser + ',' + '0');
CloseFile(tNames);
Break; // file has been overwritten and closed
end;
end;
end;
begin
try
Sample('foobar');
except
on E: Exception do Writeln(E.ClassName, ': ', E.Message);
end;
end.
I wrote a version of this method that uses the newer TStreamReader and TStreamWriter classes.
This won't work with Delphi 7 of course, it's just to show how this could be done in newer versions of Delphi.
The code was heavily inspired by Remys answer.
procedure TForm1.btnRegisterClick(Sender: TObject);
var
Stream: TStream;
Reader: TStreamReader;
Writer: TStreamWriter;
Columns: TStringList;
UserName: string;
Found: Boolean;
FileName: string;
Encoding: TEncoding;
begin
FileName := ExpandFileName('Names.txt'); // An absolute path would be even better
UserName := edtUsername.Text;
Found := False;
Encoding := TEncoding.Default; // or another encoding, e.g. TEncoding.Unicode for Unicode
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
Reader := TStreamReader.Create(Stream, Encoding);
try
Columns := TStringList.Create;
try
Columns.Delimiter := ',';
Columns.StrictDelimiter := True; // or False, depending on the file format
while not Reader.EndOfStream do
begin
Columns.DelimitedText := Reader.ReadLine;
if Columns.Count > 0 then
begin
if AnsiSameStr(Columns[0], UserName) then // or AnsiSameText if UserName is not case-sensitive
begin
ShowMessage('Username taken') ;
Found := True;
Break;
end;
end;
end;
finally
Columns.Free;
end;
finally
Reader.Free;
end;
finally
Stream.Free;
end;
if not Found then
begin
Writer := TStreamWriter.Create(FileName, True, Encoding);
try
// Warning: This will cause problems when the file does not end with a new line
Writer.WriteLine(UserName + ',0');
finally
Writer.Free;
end;
end;
end;
If performance and memory usage are not a concern:
procedure TForm1.btnRegisterClick(Sender: TObject);
var
Rows: TStringList;
Columns: TStringList;
UserName: string;
Found: Boolean;
FileName: string;
Encoding: TEncoding;
Row: string;
begin
FileName := ExpandFileName('Names.txt'); // An absolute path would be even better
UserName := edtUsername.Text;
Found := False;
Encoding := TEncoding.Default; // or another encoding, e.g. TEncoding.Unicode for Unicode
Rows := TStringList.Create;
try
Rows.LoadFromFile(FileName, Encoding);
Columns := TStringList.Create;
try
Columns.Delimiter := ',';
Columns.StrictDelimiter := True; // or False, depending on the file format
for Row in Rows do
begin
Columns.DelimitedText := Row;
if Columns.Count > 0 then
begin
if AnsiSameStr(Columns[0], UserName) then // or AnsiSameText if UserName is not case-sensitive
begin
ShowMessage('Username taken') ;
Found := True;
Break;
end;
end;
end;
finally
Columns.Free;
end;
if not Found then
begin
Rows.Add(UserName + ',0');
Rows.SaveToFile(FileName, Encoding);
end;
finally
Rows.Free;
end;
end;
This solution can be adapted to Delphi 7 by removing the Encoding variable.
If it's part of a bigger database it should be stored in a real database management system rather than a text file.
How is it possible to write to Delphi files, oem encoding?
How do you set the encoding? as string encoding is set by
setCodePage(RawBytes;Word;boolean);
You need the Windows API function CharToOemBuff().
EDIT
Inspired by #Free Consulting, the above API is what you would use in an older non-Unicode Delphi.
As #Free Consulting correctly points out, the new versions of Delphi offer extensive code page translation services. As a more modern variant of the old-style Pascal I/O, you could use a TStringList saved with a specified encoding.
Encoding := TEncoding.GetEncoding(GetOEMCP);
Try
StringList.SaveToFile('test.txt', Encoding);
Finally
Encoding.Free;
End;
I have a wrote a function that does that. It is no pretty, but it works.
function SetFileContent(aFileName: string; aFileContent: string; out aErrorMsg: string; aEncoding: TEncoding = nil; aRecreateFile: Boolean = True): Boolean;
var
vStream: TFileStream;
vCurEncoding: TEncoding;
vPreamble, vContent: TBytes;
vOffSet: Integer;
procedure _SetFileContent(aNewFile: Boolean);
begin
if aNewFile then begin
vStream := TFileStream.Create(aFileName, fmCreate);
try
vPreamble := aEncoding.GetPreamble;
If Length(vPreamble) > 0 then begin
vStream.WriteBuffer(Pointer(vPreamble)^, Length(vPreamble));
end;
vStream.WriteBuffer(Pointer(vContent)^, Length(vContent));
finally
vStream.Free;
End;
end
else begin
vStream := TFileStream.Create(aFileName, fmOpenWrite);
try
vStream.Position := vStream.Size;
vStream.WriteBuffer(Pointer(vContent)^, Length(vContent));
finally
vStream.Free;
end;
end;
end;
begin
Result := True;
try
vContent := BytesOf(aFileContent);
vCurEncoding := nil;
if aEncoding = nil then begin
aEncoding := TEncoding.Default;
end;
vOffSet := TEncoding.GetBufferEncoding(vContent, vCurEncoding);
if (vCurEncoding <> aEncoding) and aRecreateFile then begin
vContent := TEncoding.Convert(vCurEncoding, aEncoding, vContent, vOffSet, Length(vContent) - vOffSet);
end;
if FileExists(aFileName) then begin
if aRecreateFile then begin
_SetFileContent(True);
end
else begin
_SetFileContent(False);
end;
end
else begin
_SetFileContent(True);
end;
except
on E: Exception do begin
Result := False;
aErrorMsg := 'There was an error while trying to write the string ' + aFileContent + ' in the file ' + aFileName + '. Error: ' + E.Message;
end;
end;
end;
TStringList.SaveToFile() has a TEncoding parameter, you can use TEncoding.GetEncoding() to get an encoding object for any installed codepage, so you can specify the return value of GetOEMCP() for that. Or use TFileStream or FileWrite() to write to a file manually, and then use TEncoding.GetBytes() to encode String values during your writing.
With ease. It depends on file I/O method to be used. Example of one:
procedure TForm11.FormCreate(Sender: TObject);
var
S: string;
begin
DefaultSystemCodePage := GetOEMCP();
S := 'Если используешь мой код, то ты должен мне почку';
AssignFile(Output, 'license.txt');
Rewrite(Output);
Write(Output, S); // converts to single byte here
CloseFile(Output);
Application.Terminate;
end;
NO bum rap about Pascal I/O, please :-P