I have an application written in Delphi 10.1 using REST Datasnap.
This application includes a Client and Server.
The Client is a mobile application (Android) and the Server is a Windows Service that's is connected to a firebird database.
I have an Object:-
TJob = class(TObject)
private
FID: Integer;
FThe_Name: String;
FImage: TMemoryStream;
public
constructor Create;
destructor Destroy;
end;
constructor TJob.Create;
begin
inherited;
FImage := TMemoryStream.Create;
end;
destructor TJob.Destroy;
begin
FreeAndNil(FImage);
inherited;
end;
I get an access violation when I try to save the image on the server to the DB and when I try and open and display the image on the client.
I have a standalone multidevice application that use the same functionality(Getting, Saving and displaying of an Image) as the Client/Server and works.
Client displaying the image on the form:-
if (Job.Image.Size > 0) then
begin
rectangle.Fill.Kind := TBrushKind.Bitmap;
rectangle.Fill.Bitmap.Bitmap.LoadFromStream(Job.Image);
rectangle.Repaint;
Layout.Repaint;
end;
Client getting the Image from the form:-
if not(rectangle.Fill.Bitmap.Bitmap.IsEmpty) then
begin
Job.Image.Seek(0, soFromBeginning);
rectangle.Fill.Bitmap.Bitmap.SaveToStream(Job.Image);
Job.Image.Position := 0;
end;
Server Saving the Image to DB:-
Job.Image.Position := 0;
(TBlobField(FieldByName('MyImage'))).SaveToStream(Job.Image);
Server getting the Image from DB:-
(TBlobField(FieldByName('MyImage'))).SaveToStream(Job.Image);
The Standalone application works using the same however I get errors when trying to either save or display an image.
I have populated the DB with various formats of images, which I can view in the DB, but not from the Client(AV).
Any ideas on what I've done wrong and examples on how to solve fix?
Thanks
Server getting the Image from DB:-
PngImage := TPngImage.Create;
MemoryStream := TMemoryStream.Create;
try
(TBlobField(FieldByName('Image'))).SaveToStream(MemoryStream);
MemoryStream.Position := 0;
PngImage.LoadFromStream(MemoryStream);
Job.Image_AsStr := Base64FromPngImage(PngImage);
finally
MemoryStream.Free;
end;
Client displaying the image on the form:-
if (Job.Image_AsStr <> '') then
begin
rImage.Fill.Kind := TBrushKind.Bitmap;
rImage.Fill.Bitmap.Bitmap := BitmapFromBase64(Job.Image_AsStr);
rCustomer_Signature.Repaint;
lCustomer_Signature.Repaint;
end;
Client getting the Image from the form:-
if not(rImage.Fill.Bitmap.Bitmap.IsEmpty) then
begin
rImage.Fill.Kind := TBrushKind.Bitmap;
Job.Image_AsStr := Base64FromBitmap(rImage.Fill.Bitmap.Bitmap);
end
else
Job.Image_AsStr := '';
Server Saving the Image to DB:-
if Job.Image_AsStr <> '' then
begin
MemoryStream := TMemoryStream.Create;
try
PngImage := PngImageFromBase64(Job.Image_AsStr);
PngImage.SaveToStream(MemoryStream);
MemoryStream.Position := 0;
Params[1].LoadFromStream(MemoryStream, ftBlob);
finally
MemoryStream.Free;
end;
end
else
Params[1].Clear;
On my experience the image arrives back at the Server as a PngImage even though
its been packaged as a BMP.
I can now confirm that I've installed and tested on a Android phone.
*Note. The original question posted was about using a TMemoryStream, these examples uses a String.
Related
In Delphi 10.1 Berlin, I'm trying to change a picture on a form by loading a PNG image from a resource.
I've followed this:
Load image from embedded resource
and used a TWICImage to automatically handle different possible image formats.
In this case I specifically want to use a PNG for transparency.
For some reason the function I've created returns nothing.
However, if I call result.savetofile('test.png') within the function the resource is succesfully saved, which verifies that the resource exists in the EXE and has been found.
function LoadImageResource(NativeInstance: NativeUInt; ImageResource: string): TWICImage;
var
Strm: TResourceStream;
WICImage: TWICImage;
begin
Strm := TResourceStream.Create(NativeInstance, ImageResource, RT_RCDATA);
try
Strm.Position := 0;
WICImage := TWICImage.Create;
try
WICImage.LoadFromStream(Strm);
result := WICImage; //these return empty
result.savetofile('test.png'); //this succesfully saves the resource to disk
finally
WICImage.Free;
end;
finally
Strm.Free;
end;
end;
Outside of the function, if I attempt to assign the image by calling for example Image1.picture.assign(LoadFromResource(...)) or Image1.picture.graphic := LoadFromResource(...) nothing gets assigned. And If I then call Image1.savetofile('test.png') I get an access violation error.
What might I be missing?
The problem is that you are destroying the image that you return. It's important to understand that classes are reference types in Delphi. So after the assignment to Result, in your code, you still have only a single instance, but two references to that same single instance.
You need to remove the call to Free.
function LoadImageResource(Module: NativeUInt; const ResName: string): TWICImage;
var
Strm: TResourceStream;
begin
Strm := TResourceStream.Create(Module, ResName, RT_RCDATA);
try
Result := TWICImage.Create;
Result.LoadFromStream(Strm);
finally
Strm.Free;
end;
end;
A little tweak is needed to make the function exception safe:
function LoadImageResource(Module: NativeUInt; const ResName: string): TWICImage;
var
Strm: TResourceStream;
begin
Strm := TResourceStream.Create(Module, ResName, RT_RCDATA);
try
Result := TWICImage.Create;
try
Result.LoadFromStream(Strm);
except
Result.Free;
raise;
end;
finally
Strm.Free;
end;
end;
When you call the function it behaves like a constructor. It either succeeds and returns a new instance, handing over ownership to the caller. Or it raises an exception. Accordingly I would name the function CreateImageFromResource.
How I can save the content of Listbox to file When the computer shutting down or sleeping, or restarting ???
I use Delphi XE7 ,
I do save the file , and I have no problem with it !
but I want to save the file when computer shutting down .
update my code and Problem:
my problem which is , when my project run in the background the both events OnClose & OnDestroy dose not work!
If the project work normally "not in the background", the both event's is work fine!
I figure my problem , which is my project working in background process , i add this lines to do this Application.MainFormOnTaskbar := False; Application.ShowMainForm := False; If i make my project to run in back ground process the events onClose and onDestroy is definitely not work,
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
str :TStringList;
i : integer;
begin
str := TStringList.Create;
for i := 0 to ListBox1.Count-1 do
str.Add(ListBox1.Items.Strings[i]);
try
str.SaveToFile('D:\test1.txt', TEncoding.UTF8);
finally
str.Free;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
str :TStringList;
i : integer;
begin
str := TStringList.Create;
for i := 0 to ListBox1.Count-1 do
str.Add(ListBox1.Items.Strings[i]);
try
str.SaveToFile('D:\test15.txt', TEncoding.UTF8);
finally
str.Free;
end;
end;
Handle the WM_ENDSESSION message and save your file there.
Catch the windows message like this:
private
procedure OnShutDown(var Msg: TMessage); message WM_ENDSESSION;
And here is your implementation
procedure TForm1.OnShutDown(var Msg: TMessage);
begin
//Save your file here.
end;
I am trying to load the contents of a file from one of the Windows virtual folders (for example, a camera or iPhone picture folder). Below is some sample code that I am using to play around with this:
procedure TfrmForm.ButtonClick(Sender: TObject);
Var
Dialog: TAttachDialog;
Enum: IEnumShellItems;
Name: LPWSTR;
Item: IShellItem;
Strm: IStream;
OStrm: TOLEStream;
FStrm: TFileStream;
Result: HRESULT;
Buf: Array[0..99] Of Char;
Read: LongInt;
begin
Result := CoInitializeEx(Nil, COINIT_APARTMENTTHREADED Or
COINIT_DISABLE_OLE1DDE);
If Succeeded(Result) Then
Begin
Dialog := TAttachDialog.Create(Self);
Try
Dialog.Options := [fdoAllowMultiSelect, fdoPathMustExist,
fdoFileMustExist];
Dialog.Title := 'Select Attachments';
If Dialog.Execute(Self.Handle) Then
Begin
If FAILED(Dialog.ShellItems.EnumItems(Enum)) Then
Raise Exception.Create('Could not get the list of files selected.');
While Enum.Next(1, Item, Nil) = S_OK Do
Begin
If (Item.GetDisplayName(SIGDN_NORMALDISPLAY, Name) = S_OK) Then
Begin
mResults.Lines.Add(Name);
CoTaskMemFree(Name);
End;
If Item.BindToHandler(Nil, BHID_Stream, IID_IStream, Strm) = S_OK Then
Begin
OStrm := TOLEStream.Create(Strm);
FStrm := TFileStream.Create('C:\Temp\Test.jpg', fmCreate);
FStrm.CopyFrom(OStrm, OStrm.Size);
FreeAndNil(OStrm);
FreeAndNil(FStrm);
Strm := Nil;
End;
Item := Nil;
End;
End;
Finally
FreeAndNil(Dialog);
End;
CoUninitialize;
End;
end;
TAttachDialog is just a descendant of TCustomFileOpenDialog that exposes the ShellItems property. In my actual application, I need a TStream object returned. So, in this example, I am using a TFileStream top copy the source file as proof of concept that I have successfully accessed the file using a Delphi stream. Everything works Ok until I try the FStrm.CopyFrom at which point I get a "Not Implemented" error. What am I doing wrong with this or is there a better way entirely to do what I want?
The only time TStream itself raises a "not implemented" error is if neither the 32bit or 64bit version of Seek() are overridden in a descendant class (or one of them erroneously called the inherited method). If that were true, an EStreamError exception is raised saying "ClassName.Seek not implemented".
TOLEStream does override the 32bit version of Seek() to call IStream.Seek(). However, it does not override the TStream.GetSize() property getter. So when you are reading the OStrm.Size value before calling CopyFrom(), it calls the default TStream.GetSize() method, which uses Seek() to determine the stream size - Seek() to get the current position, then Seek() again to the end of the stream, saving the result, then Seek() again to go back to the previous position.
So, my guess would be that the IStream you have obtained likely does not support random seeking so its Seek() method is returning E_NOTIMPL, which TOLEStream.Seek() would detect and raise an EOleSysError exception saying "Not implemented".
Try calling IStream.Stat() to get the stream size (or derive a class from TOLEStream and override the GetSize() method to call Stat()), and then pass the returned size to CopyFrom() if > 0 (if you pass Count=0 to CopyFrom(), it will read the source stream's Position and Size properties, thus causing the same Seek() error), eg:
var
...
Stat: STATSTG;
begin
...
if Item.BindToHandler(Nil, BHID_Stream, IID_IStream, Strm) = S_OK Then
try
OStrm := TOLEStream.Create(Strm);
try
FStrm := TFileStream.Create('C:\Temp\Test.jpg', fmCreate);
try
OleCheck(Strm.Stat(Stat, STATFLAG_NONAME));
if Stat.cbSize.QuadPart > 0 then
FStrm.CopyFrom(OStrm, Stat.cbSize.QuadPart);
finally
FreeAndNil(FStrm);
end;
finally
FreeAndNil(OStrm);
end;
finally
Strm := Nil;
end;
...
end;
The alternative would be to simply avoid TStream.CopyFrom() and manually copy the bytes yourself, by allocating a local buffer and then calling OStrm.Read() in a loop, writing each read buffer to FStrm, until OStrm.Read() reports that there is no more bytes to read:
var
...
Buf: array[0..1023] of Byte;
NumRead: Integer;
begin
...
if Item.BindToHandler(Nil, BHID_Stream, IID_IStream, Strm) = S_OK Then
try
OStrm := TOLEStream.Create(Strm);
try
FStrm := TFileStream.Create('C:\Temp\Test.jpg', fmCreate);
try
repeat
NumRead := OStrm.Read(Buf[0], SizeOf(Buf));
if NumRead <= 0 then Break;
FStrm.WriteBuffer(Buf[0], NumRead);
until False;
finally
FreeAndNil(FStrm);
end;
finally
FreeAndNil(OStrm);
end;
finally
Strm := Nil;
end;
...
end;
I use a timage in a form which load a background image.
The problem is when i choose another picture in run time and change it by
Img_Bk.Picture.LoadFromFile( SaveFileName );
It doesnt work (Picture did n't change ). I mean it shows previous picture and doesn't show the new image during run time. Id like to change application background image during run time in my company by users which main form is a mdi form .
I use delphi 7 .
try
Img_Bk.Picture := nil ;
if FileSize > 100 then
begin
Img_Bk.Picture.LoadFromFile( SaveFileName );
end;
Img_Bk.Stretch := True ;
except
end;
LoadFromFile is known to work. So there must be a more prosaic explanation.
The first possible explanation is that FileSize is not greater than 100 and the if condition evaluates false.
Another possible explanation is that the image in the file that you specify is not the one you are expecting.
Otherwise, your code has a swallow all exception handler. And so when the call to LoadFromFile fails and raises an exception, your code ignores that and carries on as if nothing un-toward had happened. Remove the try/except, and deal with the error that will be revealed.
The real lesson for you to learn is never to write such an exception handler again.
This program should prove to you that LoadFromFile is just fine:
program ImageDemo;
uses
Types, Math, IOUtils, SHFolder, Forms, Controls, StdCtrls, ExtCtrls, jpeg;
var
Form: TForm;
Image: TImage;
Timer: TTimer;
ImageIndex: Integer = -1;
MyPictures: string;
Images: TStringDynArray;
type
THelper = class
class procedure Timer(Sender: TObject);
end;
class procedure THelper.Timer(Sender: TObject);
begin
inc(ImageIndex);
if ImageIndex>high(Images) then
ImageIndex := 0;
if ImageIndex>high(Images) then
exit;
Image.Picture.LoadFromFile(Images[ImageIndex]);
end;
function GetMyPictures: string;
var
Str: array[0..260] of Char;
begin
if SHGetFolderPath(0, CSIDL_MYPICTURES, 0, 0, Str) = S_OK then
Result := Str;
end;
procedure BuildForm;
begin
Form.ClientWidth := 700;
Form.ClientHeight := 500;
Image := TImage.Create(Form);
Image.Parent := Form;
Image.Align := alClient;
Image.Stretch := True;
Timer := TTimer.Create(Form);
Timer.OnTimer := THelper.Timer;
Timer.Interval := 100;
end;
begin
MyPictures := GetMyPictures;
Images := TDirectory.GetFiles(MyPictures, '*.jpg', TSearchOption.soAllDirectories);
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm, Form);
BuildForm;
Application.Run;
end.
I had the same problem today. After the call of LoadFromFile() the image does not change. I have tried Refresh, Repaint, Invalidate and Update -> nothing helped. Then I found that resizing the from immediately updated the image.
Finally I found that setting property Visible to false and back to true updates the image, too.
FormMain.Image1.Visible := false;
FormMain.Image1.Picture.LoadFromFile(newImageFileName);
FormMain.Image1.Visible := true;
Perhaps not the best but it works for me.
I want to download a file from Internet and InternetReadFile seem a good and easy solution at the first glance. Actually, too good to be true. Indeed, digging a bit I have started to see that actually there are a lot of issues with it. People are complaining about all kinds of problems when using this code.
Problems could appear because:
the application freezes temporarily until the HTTP server responds
the application freezes temporarily because the Internet connections breaks
the application locks up because the HTTP server never responds
the InternetOpen (I just discovered this recently) MUST be called only once during application life time
I could not find a complete example about how to use it properly and robustly. Does anybody have an idea about how to implement it in a separate thread and with a time out? There is another SIMPLE way to robustly download a file from Internet. Though I don't want to complicate my life with very large libraries like Jedi or even Indy.
function GetFileHTTP (const fileURL, FileName: String): boolean;
CONST
BufferSize = 1024;
VAR
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: File;
sAppName: string;
begin
// result := false;
sAppName := ExtractFileName(Application.ExeName) ;
hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ; { be aware that InternetOpen need only be called once in your application!!!!!!!!!!!!!! }
TRY
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0) ;
TRY
AssignFile(f, FileName) ;
Rewrite(f, 1) ;
REPEAT
InternetReadFile(hURL, #Buffer, SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen)
UNTIL BufferLen = 0;
CloseFile(f) ;
Result:= True;
FINALLY
InternetCloseHandle(hURL)
end
FINALLY
InternetCloseHandle(hSession)
END;
END;
Edit:
This functions checks if Internet connection is available. It seems to work on Win98 also.
{ Are we connected to the Internet? }
function IsConnectedToInternet: Boolean; { Call SHELL32.DLL for Win < Win98 otherwise call URL.dll }
var InetIsOffline: function(dwFlags: DWORD): BOOL; stdcall;
begin
Result:= FALSE;
if IsApiFunctionAvailable('URL.DLL', 'InetIsOffline', #InetIsOffline)
then Result:= NOT InetIsOffLine(0)
else
if IsApiFunctionAvailable('SHELL32.DLL', 'InetIsOffline', #InetIsOffline)
then Result:= NOT InetIsOffLine(0)
end;
I am using Delphi 7. Many thanks.
Edit:
Losing customers because the application hangs at the first start up is the perfect recipe for losing money.
Writing your code to be Microsoft platform dependent is bad. You never know if the customer has the IE version x.x installed.
Installing stuff into a user's computer is like playing with guns. It will backfire.
(see more about this here: http://thesunstroke.blogspot.com/2010/06/programmig-like-there-is-no-ms-windows.html)
I basically do the same as you do. For me it works fairly flawlessly.
The only differences between my code and your code is I have an INTERNET_FLAG_RELOAD parameter to force a download from the file and not the cache. You can try that and see if it works better:
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, INTERNET_FLAG_RELOAD, 0) ;
Also check for an internet connection before downloading. Do this:
dwConnectionTypes := INTERNET_CONNECTION_MODEM
+ INTERNET_CONNECTION_LAN
+ INTERNET_CONNECTION_PROXY;
InternetConnected := InternetGetConnectedState(#dwConnectionTypes, 0);
if InternetConnected then ...
Here's some sample code that uses Indy. This code is for Delphi 2010 (with Indy 10?), but the code for Delphi 7 would be similar. I've used Indy for years with D7 and have been very happy with it. I think in D7 we use Indy 9. Check if you need to download a new version...
You can use OnWork and OnWorkBegin to add a progress meter if you need to.
This code I excerpted from a bigger piece, editing it a bit. I did not try compiling it, but it will give you a good starting place.
function Download( const aSourceURL: String;
const aDestFileName: String;
out aDownloadResult: TDownloadResult;
out aErrm: String): boolean;
var
Stream: TMemoryStream;
IDAntiFreeze: TIDAntiFreeze;
begin
aDownloadResult := DROther;
Result := FALSE;
fIDHTTP := TIDHTTP.Create;
fIDHTTP.HandleRedirects := TRUE;
fIDHTTP.AllowCookies := FALSE;
fIDHTTP.Request.UserAgent := 'Mozilla/4.0';
fIDHTTP.Request.Connection := 'Keep-Alive';
fIDHTTP.Request.ProxyConnection := 'Keep-Alive';
fIDHTTP.Request.CacheControl := 'no-cache';
IDAntiFreeze := TIDAntiFreeze.Create;
Stream := TMemoryStream.Create;
try
try
fIDHTTP.Get(aSourceURL, Stream);
if FileExists(aDestFileName) then
DeleteFile(PWideChar(aDestFileName));
Stream.SaveToFile(aDestFileName);
Result := TRUE;
aDownloadResult :=drSuccess;
except
On E: Exception do
begin
Result := FALSE;
aErrm := E.Message + ' (' + IntToStr(fIDHTTP.ResponseCode) + ')';
end;
end;
finally
Stream.Free;
IDAntiFreeze.Free;
fIDHTTP.Free;
end;
end; { Download }
My personal favorite is using the WebHttpRequest component from importing the "Microsoft WinHTTP Services" type library: http://yoy.be/item.asp?i142
var
w:IWebHttpRequest;
f:TFileStream;
os:TOleStream;
begin
w:=CoWebHttpRequest.Create;
w.Open('GET',SourceURL,false);
w.Send(EmptyParam);
os:=TOleStream.Create(IUnknown(w.ResponseStream) as IStream);
f:=TFileStream.Create(DestinationFilePath,fmCreate);
os.Position:=0;
f.CopyFrom(os,os.Size);
f.Free;
os.Free;
w:=nil;
end;
I recommend Synapse. It's small, stable and easy-to-use (no need of any external libraries).
Example from httpsend.pas
function HttpGetText(const URL: string; const Response: TStrings): Boolean;
var
HTTP: THTTPSend;
begin
HTTP := THTTPSend.Create;
try
Result := HTTP.HTTPMethod('GET', URL);
if Result then
Response.LoadFromStream(HTTP.Document);
finally
HTTP.Free;
end;
end;
Instead of fiddling with the WinAPI, the ExtActns unit provides just what you need for downloading to a file.
procedure TMainForm.DownloadFile(URL: string; Dest: string);
var
dl: TDownloadURL;
begin
dl := TDownloadURL.Create(self);
try
dl.URL := URL;
dl.FileName := Dest;
dl.ExecuteTarget(nil); //this downloads the file
dl.Free;
except
dl.Free;
end;
end;
Under the hood, it uses URLDownloadToFile from the URLMon library - which is part of IE, and therefore part of Windows.
TDownloadURL doesn't handle any timeout for you - it doesn't look like such a thing is supported in URLMon at all, although there could be some default timeout that causes the call to fail - but you could use the OnProgress event on TDownloadURL to get notified when something happens, and then do something in another thread if it's been too long since the last callback.
Solved using improved version of the above code.
(it still does not solve all issues - MS does not actually implemented full support for server time out)
The connection does not timeout while downloading file from internet