26

Re: File-> Clipboard....... Clipboard-> the File

Probably following decision

program Workclipboard;
{$APPTYPE CONSOLE}
uses
Windows, SysUtils, Classes, Clipbrd;
procedure CopyStreamToClipboard (fmt: Cardinal; S: TStream);
var
hMem: THandle;
pMem: Pointer;
begin
Assert (Assigned (S));
S.Position: = 0;
hMem: = GlobalAlloc (GHND or GMEM_DDESHARE, S.Size);
if (hMem <> 0) then begin
pMem: = GlobalLock (hMem);
if (pMem <> nil) then begin
try
S.Read (pMem ^, S.Size);
S.Position: = 0;
finally
GlobalUnlock (hMem);
end;
//Clipboard. Open;
try
Clipboard. SetAsHandle (fmt, hMem);
finally
//Clipboard. Close;
end;
end else begin
GlobalFree (hMem);
OutOfMemoryError;
end;
end else OutOfMemoryError;
end;
procedure CopyStreamFromClipboard (fmt: Cardinal; S: TStream);
var
hMem: THandle;
pMem: Pointer;
begin
Assert (Assigned (S));
hMem: = Clipboard. GetAsHandle (fmt);
if hMem <> 0 then begin
pMem: = GlobalLock (hMem);
if pMem <> nil then begin
try
S.Write (pMem ^, GlobalSize (hMem));
S.Position: = 0;
finally
GlobalUnlock (hMem);
end;
end else raise Exception. Create (' CopyStreamFromClipboard: could not lock global handle obtained from clipboard ');
end;
end;
procedure LoadClipboard (Path: String; Part: String);
var
I: Integer;
ftPart: Integer;
ftName: String;
FileStream: TFileStream;
MemoStream: TMemoryStream;
begin
I: = 0;
FileStream: = TFileStream. Create (Path, fmOpenRead);
try
Assert (Assigned (FileStream));
Clipboard. Open;
while FileStream. Position <FileStream. Size do begin
ftName: = Part+IntToStr (I);
ftPart: = RegisterCLipboardFormat (PChar (ftName));
MemoStream: = TMemoryStream. Create;
MemoStream. CopyFrom (FileStream, FileStream. Size);
if ftPart <> 0 then CopyStreamToClipboard (ftPart, MemoStream);
MemoStream. Free;
I: = I+1;
end;
Clipboard. Close;
finally
FileStream. Free;
end;
end;
procedure SaveClipboard (Path: String; Part: String);
var
I: Integer;
ftPart: Integer;
ftName: array [0. 128] of Char;
FileStream: TMemoryStream;
MemoStream: TMemoryStream;
begin
FileStream: = TMemoryStream. Create;
try
Assert (Assigned (FileStream));
Clipboard. Open;
try
for I: = 0 to Clipboard. FormatCount-1 do begin
ftPart: = Clipboard. Formats [i];
if GetClipboardFormatName (ftPart, ftName, SizeOf (ftName)) =0 then ftName [0] :=#0;
if Pos (Part, ftName)> 0 then begin
MemoStream: = TMemoryStream. Create;
CopyStreamFromClipboard (ftPart, MemoStream);
while MemoStream. Position <MemoStream. Size do FileStream. CopyFrom (MemoStream, MemoStream. Size);
MemoStream. Free;
end;
end;
finally
Clipboard. Close;
end;
FileStream. SaveToFile (Path);
finally
FileStream. Free;
end;
end;
var
I: Integer;
begin
if (ParamCount> 0) and (ParamStr (1) = ' Clear ') then Clipboard. Clear;
if (ParamCount> 2) and (ParamStr (1) = ' Load ') then LoadClipboard (ParamStr (2), ParamStr (3));
if (ParamCount> 2) and (ParamStr (1) = ' Save ') then SaveClipboard (ParamStr (2), ParamStr (3));
end.

P.S. Not demanded "Napoleons" and "writers" doing not wish to dig in  the request not to disturb