I've copied a file into the Windows clipboard (By simply clicking right, copy).
I would like to load a TStream descendant with the file currently stored in the clipboard.
uses
Classes, Clipbrd;
MyStream := TMemoryStream.Create;
try
//here I would like to load the clipboard file into MyStream
finally
MyStream.Free;
end;
When you copy a file onto the clipboard from the hard drive, it simply copies the file's full path and filename in CF_HDROP format. You can use the DragQueryFile() function to read the filenames, eg:
uses
Classes, Clipbrd, ShellAPI;
var
hDrop: THandle
MyStream: TMemoryStream;
Files: TStringList;
NumFiles, FileIdx: DWORD;
FileName: array[0..MAX_PATH] of Char;
I: Integer;
begin
Files := TStringList.Create;
try
Clipboard.Open;
try
if Clipboard.HasFormat(CF_HDROP) then
begin
// DO NOT free this handle, the clipboard owns it!
hDrop := Clipboard.GetAsHandle(CF_HDROP);
NumFiles := DragQueryFile(hDrop, $FFFFFFFF, nil, 0);
if NumFiles <> 0 then
begin
for FileIdx := 0 to NumFiles-1 do
begin
if DragQueryFile(hDrop, FileIdx, FileName, MAX_PATH) <> 0 then
Files.Add(FileName);
end;
end;
end;
finally
Clipboard.Close;
end;
for I := 0 to Files.Count-1 do
begin
MyStream := TMemoryStream.Create;
try
MyStream.LoadFromFile(Files[I]);
MyStream.Position := 0;
// use MyStream as needed...
finally
MyStream.Free;
end;
end;
finally
Files.Free;
end;
end;
Related
Thanks to the below functions, I am succesfully retrieving, from a Word document stored locally (synced with the Server through OneDrive), its Server properties (those which are stored as SharePoint columns), all this without Ole automation. The functions' structure is:
Since the Word document is a zipped file, unzip the file where such properties are stored.
Extract the contents of the file into a string.
Load the string into an XML document.
Feed the field names and their contents into a StringList.
``
function WordGetServerProperties (FName:string):TStringList;
var
s,ss:string;
i,ii:integer;
St:TStringList;
XML:IXMLDocument;
N,NN: IXMLNode;
begin
s:=ExtractZipToStr(FName,'customXml/item1.xml',ExtractFilePath(FName));
if StrContains('<p:properties',s)=False then
s:=ExtractZipToStr(FName,'customXml/item2.xml',ExtractFilePath(FName));
if StrContains('<p:properties',s)=False then
s:=ExtractZipToStr(FName,'customXml/item3.xml',ExtractFilePath(FName));
XML:=NewXMLDocument;
St:=TStringList.Create;
XML.Active := True;
XML.LoadFromXML(s);
N:=xml.DocumentElement;
try
for i := 0 to N.ChildNodes.Count -1 do
begin
if N.ChildNodes[i].NodeName = 'documentManagement' then
begin
NN:=N.ChildNodes[i];
for ii := 0 to NN.ChildNodes.Count -1 do
begin
ss:=AnsiReplaceStr(NN.ChildNodes[ii].NodeName,'_x0020_',' ');
if ss='SharedWithUsers' then continue;
ss:=ss+'='+NN.ChildNodes[ii].Text;
st.Add(ss)
end;
end;
end;
finally
XML.Active := False;
end;
Result:=st;
end;
function ExtractZipToStr(const ZipFileName: string; const ZippedFileName, ExtractedFileName: string): widestring;
var
ZipFile: TZipFile;
F,s:string;
i:integer;
Exists:Boolean;
LStream: TStream;
FStream:TFileStream;
LocalHeader: TZipHeader;
begin
Exists:=False;
ZipFile := TZipFile.Create;
LStream := TStream.Create;
try
try
ZipFile.Open(ZipFileName,zmRead);
except on EZipException do begin Result:='noprops'; ZipFile.Close; ZipFile.Free; LStream.Free; exit; end; end;
for i := 0 to ZipFile.FileCount - 1 do
begin
F:= ZipFile.FileNames[i];
if F='docProps/custom.xml' then begin Exists:=True; system.Break; end;
end;
if exists=True then
begin
ZipFile.Read(ZippedFileName, LStream, LocalHeader);
LStream.Position:=0;
Result:=StreamToString(LStream);
end
else Result:='noprops';
finally
ZipFile.Close;
ZipFile.Free;
LStream.Free;
end;
end;
function StreamToString(aStream: TStream): widestring;
var
SS: TStringStream;
begin
if aStream <> nil then
begin
SS := TStringStream.Create('');
try
SS.CopyFrom(aStream, 0);
Result := SS.DataString;
finally
SS.Free;
end;
end else
begin
Result := '';
end;
end;
This is relatively fast but as not as much as I would like. Hopefully I have shown that (being amateur at this) I am at the end of my wits. Would you see any way to either improve or utterly replace these routines by something more efficient?
I've got a minor issue with decompressing using the ZLib unit in Delphi
unit uZCompression;
interface
uses
uCompression;
type
TZZipCompression = class(TInterfacedObject, ICompression)
public
function DoCompression(aContent: TArray<Byte>): TArray<Byte>;
function DoDecompression(aContent: TArray<Byte>): TArray<Byte>;
function GetWindowsBits: Integer; virtual;
end;
TZGZipCompression = class(TZZipCompression)
function GetWindowsBits: Integer; override;
end;
implementation
uses
System.ZLib, System.Classes, uMxKxUtils;
{ TZCompression }
function TZZipCompression.DoCompression(aContent: TArray<Byte>): TArray<Byte>;
var
LContentStream, LOutputStream: TMemoryStream;
LCompressedStream: TZCompressionStream;
begin
LContentStream := ByteArrayToStream(aContent);
LOutputStream := TMemoryStream.Create;
LCompressedStream := TZCompressionStream.Create(LOutputStream, zcDefault, GetWindowsBits);
LCompressedStream.CopyFrom(LContentStream, LContentStream.Size);
LCompressedStream.Free;
Result := StreamToByteArray(LOutputStream);
LOutputStream.Free;
LContentStream.Free;
end;
function TZZipCompression.DoDecompression(aContent: TArray<Byte>): TArray<Byte>;
var
LContentStream, LOutputStream: TMemoryStream;
LDecompressedStream: TZDecompressionStream;
begin
LContentStream := ByteArrayToStream(aContent);
LOutputStream := TMemoryStream.Create;
LDecompressedStream := TZDecompressionStream.Create(LContentStream);
LOutputStream.CopyFrom(LDecompressedStream, LDecompressedStream.Size);
LDecompressedStream.Free;
Result := StreamToByteArray(LOutputStream);
LOutputStream.Free;
LContentStream.Free;
end;
function TZZipCompression.GetWindowsBits: Integer;
begin
Result := 15;
end;
{ TZGZipCompression }
function TZGZipCompression.GetWindowsBits: Integer;
begin
Result := inherited;
Result := Result + 16;
end;
end.
This is my unit which is driven by an interface (which you don't need to know about), and data is passed in and out through a TArray variables.
I've coded it to be able to do 2 types of compression, standard zip and gzip which is determined by the windowsbits passed in to the functions.
Here are a couple of other functions being used to convert the TArray to TMemoryStream
function ByteArrayToStream(aContent: TArray<Byte>): TMemoryStream;
begin
Result := TMemoryStream.Create;
Result.Write(aContent, length(aContent)*SizeOf(aContent[0]));
Result.Position := 0;
end;
function StreamToByteArray(aStream: TMemoryStream): TArray<Byte>;
var
LStreamPos: Int64;
begin
if Assigned(aStream) then
begin
LStreamPos := aStream.Position;
aStream.Position := 0;
SetLength(Result, aStream.Size);
aStream.Read(Result, aStream.Size);
aStream.Position := LStreamPos;
end
else
SetLength(Result, 0);
end;
Now I can compress and decompress to .zip using the TZZipCompression class perfectly fine (it doesn't open up as a zip file, but it does decompress back to the original file which I can open and edit).
I can also compress to .gz using the TZGZipCompression class fine as well (interestingly I can open this gzip file perfectly well).
My issue however is that it won't decompress back from the .gz file and throws and error as soon as it hits
LOutputStream.CopyFrom(LDecompressedStream, LDecompressedStream.Size)
Funnily enough the Help file example has it as below
LOutputStream.CopyFrom(LDecompressedStream, 0)
But this doesn't work either.
Can anyone spot the issue?
Your conversion functions between TArray<Byte> and TMemoryStream are wrong, as you are not accessing the array content correctly. TArray is a dynamic array. When calling TMemoryStream.Write() and TMemoryStream.Read(), you are passing the memory address of the TArray itself, not the memory address of the data that the TArray points at. You need to reference the TArray to get the correct memory address, eg:
function ByteArrayToStream(const aContent: TArray<Byte>): TMemoryStream;
begin
Result := TMemoryStream.Create;
try
if Length(aContent) > 0 then
Result.WriteBuffer(aContent[0], Length(aContent));
Result.Position := 0;
except
Result.Free;
raise;
end;
end;
function StreamToByteArray(aStream: TMemoryStream): TArray<Byte>;
begin
if Assigned(aStream) then
begin
SetLength(Result, aStream.Size);
if Length(Result) > 0 then
Move(aStream.Memory^, Result[0], aStream.Size);
end
else
SetLength(Result, 0);
end;
Alternatively:
function ByteArrayToStream(const aContent: TArray<Byte>): TMemoryStream;
begin
Result := TMemoryStream.Create;
try
Result.WriteBuffer(PByte(aContent)^, Length(aContent));
Result.Position := 0;
except
Result.Free;
raise;
end;
end;
function StreamToByteArray(aStream: TMemoryStream): TArray<Byte>;
begin
if Assigned(aStream) then
begin
SetLength(Result, aStream.Size);
Move(aStream.Memory^, PByte(Result)^, aStream.Size);
end
else
SetLength(Result, 0);
end;
That being said, you don't need to waste memory making copies of the array data using TMemoryStream. You can use TBytesStream instead (since dynamic arrays are reference counted), eg:
function TZZipCompression.DoCompression(aContent: TArray<Byte>): TArray<Byte>;
var
LContentStream, LOutputStream: TBytesStream;
LCompressedStream: TZCompressionStream;
begin
LContentStream := TBytesStream.Create(aContent);
try
LOutputStream := TBytesStream.Create(nil);
try
LCompressedStream := TZCompressionStream.Create(LOutputStream, zcDefault, GetWindowsBits);
try
LCompressedStream.CopyFrom(LContentStream, 0);
finally
LCompressedStream.Free;
end;
Result := Copy(LOutputStream.Bytes, 0, LOutputStream.Size);
finally
LOutputStream.Free;
end;
finally
LContentStream.Free;
end;
end;
function TZZipCompression.DoDecompression(aContent: TArray<Byte>): TArray<Byte>;
var
LContentStream, LOutputStream: TBytesStream;
LDecompressedStream: TZDecompressionStream;
begin
LContentStream := TBytesStream.Create(aContent);
try
LOutputStream := TBytesStream.Create(nil);
try
LDecompressedStream := TZDecompressionStream.Create(LContentStream, GetWindowsBits);
try
LOutputStream.CopyFrom(LDecompressedStream, 0);
finally
LDecompressedStream.Free;
end;
Result := Copy(LOutputStream.Bytes, 0, LOutputStream.Size);
finally
LOutputStream.Free;
end;
finally
LContentStream.Free;
end;
end;
I am using Delphi 2007 with Indy 10. I have a gzip file. I have verified it can be decompressed with this Online Decompression Tool.
I am trying to use the TIdCompressorZlib component to decompress using Delphi. Here is my code:
procedure TForm2.Button9Click(Sender: TObject);
var
lCompressor : TIdCompressorZLib;
FileStream : TFileStream;
memorystream: TMemoryStream;
begin
lCompressor := TIdCompressorZLib.create(self);
FileStream := TFileStream.Create('c:\temp\test.gz', fmOpenRead);
filestream.position := 0;
memorystream:= TMemoryStream.create;
memorystream.position := 0;
lcompressor.DecompressGZipStream(FileStream,MemoryStream);
filestream.free;
showmessage('done');
end;
I cannot get it to work. If I pass fmOpenReadWrite in the constructor I get a zlib error (-5) when DecompressGZipStream is called.
If I pass fmOpenRead in the constructor I get a OS System Error Code 5 Access Denied when DecompressGZipStream is called.
Update David Hefferan suggested it is a file reading issue. So I am zeroing in on that. I am able to copy the file using this procedure:
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
S, T: TFileStream;
Begin
S := TFileStream.Create( sourcefilename, fmOpenRead );
try
T := TFileStream.Create( targetfilename,
fmOpenWrite or fmCreate );
try
T.CopyFrom(S, S.Size ) ;
finally
T.Free;
end;
finally
S.Free;
end;
showmessage('done');
End;
UPD Per David Heffernan, I have verified I can Read the data. I successfully ran the file through the following function. It returns the proper number of characters (bytes):
function GetTextFromFile(AFile: string; var Returnstring: string): Boolean;
var
FileStream: TFileStream;
begin
Result := False;
if not FileExists(AFile) then Exit;
FileStream := TFileStream.Create(AFile, fmOpenRead);
try
if FileStream.Size <> 0 then
begin
SetLength(Returnstring, FileStream.Size);
FileStream.Read(Returnstring[1], FileStream.Size);
Result := True;
end;
finally
FileStream.Free;
end;
end;
You can try to use Delphi zlib unit to decompress gzip.
Sample code:
procedure TForm2.Button9Click(Sender: TObject);
var
DecompressionStream : TDecompressionStream;
FileStream : TFileStream;
dest: TFileStream;
byteCount: Integer;
buffer: array [0..65535] of Byte;
begin
FileStream := TFileStream.Create('c:\temp\test.gz', fmOpenRead);
try
//no need to set FileStream position to 0, it's there already
DecompressionStream:=TDecompressionStream.Create(FileStream, 15+16);
//16 is flag that gzip stream used, not zlib.
//15 is maximum memory usage, to speed-up decompression.
try
dest:=TFileStream.Create('c:\temp\test.txt', fmCreate);
try
dest.CopyFrom(DecompressionStream,0);
finally
dest.free;
end;
finally
DecompressionStream.free;
end;
finally
filestream.free;
end;
showmessage('done');
end;
UPD: this code doesn't work for D2007 or earlier versions, no overloaded constructor with WindowBits argument...
i have this Thread that get image url from the web then save it to memory stream then save from memory stream To file
i needed to convert any image that downloaded to a gif image so i do something like this
unit downloadimgThread;
interface
uses Windows, SysUtils, Classes, dialogs, IdSSLOpenSSL, IdHttp, IdUri, System.AnsiStrings, Graphics, Jpeg, Vcl.Imaging.GIFImg, PNGImage;
type
TDownloadUpdateVisualEvent = procedure(Sender: TObject; Anameofimg: String;
var Aimagelocate: String) of object;
type
TURLDownload = class(TThread)
private
FOnUpdateVisual: TDownloadUpdateVisualEvent;
FURL: String;
Fnameofimg: string;
FPathImage: string;
FFileNameImage: string;
ImageName: string;
PathURL: string;
procedure DoUpdateVisual;
protected
procedure Execute; override;
public
constructor Create(Thrdid: Pointer; const AUrl: String;
Const AOutPathImages: string; AOnUpdateVisual: TDownloadUpdateVisualEvent;
Anameofimg: String); reintroduce;
property URL: string read FURL write FURL;
property PathImage: string read FPathImage;
property FileNameImage: string read FFileNameImage;
end;
var
URLDOWNLOAD: TURLDownload;
implementation
{ TURLDownload }
function JpgToGif(ms: TMemoryStream): Boolean;
var
gif: TGIFImage;
jpg: TJPEGImage;
begin
Result := False;
gif := TGIFImage.Create;
try
jpg := TJPEGImage.Create;
try
//jpg
ms.Position := 0;
jpg.LoadFromStream(ms);
jpg.DIBNeeded;
gif.Assign(jpg);
//save...
ms.Clear;
gif.SaveToStream(ms);
Result := True;
finally
jpg.Free;
jpg := nil;
end;
finally
gif.Free;
gif := nil;
end;
end;
constructor TURLDownload.Create(Thrdid: Pointer; const AUrl, AOutPathImages: string; AOnUpdateVisual: TDownloadUpdateVisualEvent; Anameofimg: String);
var
URI: TIdURI;
begin
inherited Create(false);
FreeOnTerminate := True;
FURL := AUrl;
FOnUpdateVisual := AOnUpdateVisual;
Fnameofimg := Anameofimg;
FPathImage := AOutPathImages;
URI := TIdURI.Create(AUrl);
try
ImageName := URI.Document;
PathURL := URI.path;
finally
URI.Free;
end;
end;
procedure TURLDownload.DoUpdateVisual;
begin
if Assigned(FOnUpdateVisual) then
FOnUpdateVisual(self, Fnameofimg, FFileNameImage);
end;
procedure TURLDownload.Execute;
var
aMs: TMemoryStream;
aIdHttp: TIdHttp;
IdSSL: TIdSSLIOHandlerSocketOpenSSL;
path: string;
dir: string;
SPEXT : String;
itsimage: string;
responsechk: Integer;
begin
dir := AnsiReplaceText(PathURL, '/', '');
if (ImageName = '') then
begin
exit;
end;
SPEXT := ExtractFileExt(ImageName);
ImageName := Copy(ImageName, 1, Length(ImageName) - Length(SPEXT));
path := PathImage + '\' + ImageName + '.gif';
if fileexists(path) then
begin
FFileNameImage := path;
if Assigned(FOnUpdateVisual) then
begin
Synchronize(DoUpdateVisual);
end;
exit;
end
else
if not fileexists(path) then
begin
aMs := TMemoryStream.Create;
aIdHttp := TIdHttp.Create(nil);
IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
try
IdSSL.SSLOptions.Method := sslvTLSv1;
IdSSL.SSLOptions.Mode := sslmUnassigned;
aIdHttp.HTTPOptions := [hoForceEncodeParams] + [hoNoProtocolErrorException];
aIdHttp.IOHandler := IdSSL;
aIdHttp.AllowCookies := True;
aIdHttp.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
aIdHttp.HandleRedirects := True;
aIdHttp.RedirectMaximum := 3;
try
aIdHttp.Head(trim(FURL));
except
end;
itsimage := aIdHttp.Response.ContentType;
responsechk := aIdHttp.ResponseCode;
if responsechk <> 200 then
begin
FFileNameImage := 'error';
if Assigned(FOnUpdateVisual) then
begin
Synchronize(DoUpdateVisual);
end;
exit;
end;
if (itsimage = 'image/gif') then
begin
try
aIdHttp.Get(trim(FURL), aMs);
except
end;
aMs.SaveToFile(path);
end else if (itsimage = 'image/jpeg') then
begin
try
aIdHttp.Get(trim(FURL), aMs);
except
end;
if JpgToGif(aMs) then
begin
aMs.SaveToFile(path);
end;
end;
try
if aIdHttp.Connected then
aIdHttp.Disconnect;
except
end;
finally
aMs.Free;
IdSSL.Free;
aIdHttp.Free;
end;
end;
FFileNameImage := path;
if Assigned(FOnUpdateVisual) then
begin
Synchronize(DoUpdateVisual);
end;
end;
end.
in this unit i try to check if image type is jpg then convert it to gif and save it specifically at this line of code
if (itsimage = 'image/jpeg') then
begin
try
aIdHttp.Get(trim(FURL), aMs);
except
end;
if JpgToGif(aMs) then
begin
aMs.SaveToFile(path);
end;
// function to convert
function JpgToGif(ms: TMemoryStream): Boolean;
var
gif: TGIFImage;
jpg: TJPEGImage;
begin
Result := False;
gif := TGIFImage.Create;
try
jpg := TJPEGImage.Create;
try
//jpg
ms.Position := 0;
jpg.LoadFromStream(ms);
jpg.DIBNeeded;
gif.Assign(jpg);
//save...
ms.Clear;
gif.SaveToStream(ms);
Result := True;
finally
jpg.Free;
jpg := nil;
end;
finally
gif.Free;
gif := nil;
end;
end;
when i try to convert the image and save it the image saved is corrupted what could be the issue ?
There is a very simple solution for this. And that is to use FMX Bitmap instead of default VCL Bitmap as it allows automatic format recognition on load and automatic format choosing on save based on file extension of the file name you provide to SaveToFile method.
Here is a simple code that loads selected image chosen in OpenDialog into Memory stream first and then into Bitmap and then it saves the image into GIF format.
procedure TForm1.Button1Click(Sender: TObject);
var Bitmap: FMX.Graphics.TBitmap;
MS: TMemoryStream;
begin
if OpenDialog1.Execute then
begin
MS := TMemoryStream.Create;
MS.LoadFromFile(OpenDialog1.FileName);
Bitmap := FMX.Graphics.TBitmap.Create;
Bitmap.LoadFromStream(MS);
Bitmap.SaveToFile('D:\Proba.gif');
end;
end;
As you can see you only need just a few lines and you get ability to convert images between all supported formats.
You can see which ones are supported here:
http://docwiki.embarcadero.com/Libraries/XE8/en/FMX.Graphics.TBitmapCodecManager#Supported_Image_Formats
Just make sure you are indeed using FMX.Graphics.TBitmap by specifying the full namespace for the file in which it resided.
NOTE: Working on VCL application does not mean you can't use some of the functionality that is present in Fire Monkey.
Why does this code not work?
I am writing an application that has ability to save and load its own files and need to know how to stream objects to a file using FileStream.
procedure TForm1.btnSaveClick(Sender: TObject);
var
fs: TFileStream;
begin
fs := TFileStream.Create('c:\temp\a.my', fmCreate);
try
fs.WriteBuffer(Image1.Picture.Graphic, SizeOf(TGraphic));
finally
fs.Free;
end;
ShowMessage('ok');
Image1.Picture.Graphic := nil;
end;
procedure TForm1.btnLoadClick(Sender: TObject);
var
fs: TFileStream;
g: TGraphic;
begin
fs := TFileStream.Create('c:\temp\a.my', fmOpenRead);
try
fs.ReadBuffer(g, SizeOf(TGraphic));
Image1.Picture.Graphic := g;
finally
fs.Free;
end;
ShowMessage('ok');
end;
EDIT 1:
Found the way to do it, but need some more help:
procedure TForm1.btnSaveClick(Sender: TObject);
var
fs: TFileStream;
s: TMemoryStream;
buf: TBytes;
begin
fs := TFileStream.Create('c:\temp\a.my', fmCreate);
s := TMemoryStream.Create;
try
Image1.Picture.Graphic.SaveToStream(s);
SetLength(buf, s.Size);
s.Position := 0;
s.ReadBuffer(buf[0], s.Size);
//fs.WriteBuffer(, SizeOf(Integer)); <-here how do I save an integer which represents the size of the buffer? (so that when reading back i read this first.)
fs.WriteBuffer(buf[0], s.Size);
finally
s.Free;
fs.Free;
end;
ShowMessage('ok');
Image1.Picture.Graphic := nil;
end;
What you have done there is stream the reference, i.e. a pointer. What you need to stream is the contents. You can that with SaveToFile and LoadFromFile.
Regarding your update, assign s.Size to a local variable of type Integer and then use WriteBuffer to save it. In reverse, use ReadBuffer to read into a local variable.
If I were you I would write direct to the file and avoid the memory streak. Use the Position property of TStream to seek around the file. So write 0 for then length, write the graphic, seek back to the beginning and write the true length accounting for the 4 bytes of the length.