{
example:
Copy:
EmbeddedWB1.Copy;
NDClipboard.CopyNDDataToClipboard;
Cut:
EmbeddedWB1.Cut;
NDClipboard.CopyNDDataToClipboard;
Paste:
if NDClipboard.HasFormat(CF_NDCONTENT) then
begin
NDClipboard.CopyNDDataFromClipboard;//从剪贴板取出数据，并进行解壳操作
EmbeddedWB1.Paste;//粘贴到目标中去
NDClipboard.CopyNDDataToClipboard; //再将剪贴板里的数据重新加壳
end
else
EmbeddedWB1.Paste;
}
unit uNDClipboardClass;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Clipbrd;
const
NDClipboardFormatStr = 'CF_NDCONTENT';
type
TNDClipboard = class(TClipboard)
public
procedure SetNdData;
procedure GetNdData;
procedure CopyNDDataToClipboard;
procedure CopyNDDataFromClipboard;
procedure SaveClipDataToStream(var AMem: TMemoryStream);
procedure LoadClipDataFromStream(var AMem: TMemoryStream);
end;
TDataIdnet = array[0..2] of Char;
TClipboardFileHead = packed record
rIdent: TDataIdnet;
rCount: Word;
end;
TClipboardFileItem = packed record
rFormat: Word;
rSize: Longword;
rData: Pointer;
end;
const rDataIdnet: TDataIdnet = 'cbf';
var
CF_NDCONTENT: Word;
function NDClipboard: TNDClipboard;
function ClipboardSaveToStream(mStream: TStream): Boolean;
function ClipboardLoadFromStream(mStream: TStream): Boolean;
procedure CopyStreamToClipboard(fmt: Cardinal; S: TStream);
procedure CopyStreamFromClipboard(fmt: Cardinal; S: TStream);
procedure SaveClipboardFormat(fmt: Word; writer: TWriter);
procedure LoadClipboardFormat(reader: TReader);
procedure SaveClipboard(S: TStream);
procedure LoadClipboard(S: TStream);
implementation
function ClipboardSaveToStream(mStream: TStream): Boolean;
var
vClipboardFileHead: TClipboardFileHead;
vClipboardFileItem: TClipboardFileItem;
I: Integer;
vData: THandle;
begin
Result := False;
if not Assigned(mStream) then Exit;
vClipboardFileHead.rIdent := rDataIdnet;
vClipboardFileHead.rCount := Clipboard.FormatCount;
mStream.Write(vClipboardFileHead, SizeOf(vClipboardFileHead));
try
Clipboard.Open;
for I := 0 to Clipboard.FormatCount - 1 do begin
vData := GetClipboardData(Clipboard.Formats[I]);
vClipboardFileItem.rFormat := Clipboard.Formats[I];
vClipboardFileItem.rSize := GlobalSize(vData);
vClipboardFileItem.rData := GlobalLock(vData);
try
mStream.Write(vClipboardFileItem, SizeOf(vClipboardFileItem) -
SizeOf(vClipboardFileItem.rData));
mStream.Write(vClipboardFileItem.rData^, vClipboardFileItem.rSize);
finally
GlobalUnlock(vData);
end;
end;
finally
Clipboard.Close;
end;
Result := True;
end; { ClipboardSaveToStream }
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 { If }
else
begin
GlobalFree(hMem);
OutOfMemoryError;
end;
end { If }
else
OutOfMemoryError;
end; { CopyStreamToClipboard }
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 { If }
else
raise Exception.Create('CopyStreamFromClipboard: could not lock global handle ' +
'obtained from clipboard!');
end; { If }
end; { CopyStreamFromClipboard }
procedure SaveClipboardFormat(fmt: Word; writer: TWriter);
var
fmtname: array[0..128] of Char;
ms: TMemoryStream;
begin
Assert(Assigned(writer));
if 0 = GetClipboardFormatName(fmt, fmtname, SizeOf(fmtname)) then
fmtname[0] := #0;
ms := TMemoryStream.Create;
try
CopyStreamFromClipboard(fmt, ms);
if ms.Size > 0 then
begin
writer.WriteInteger(fmt);
writer.WriteString(fmtname);
writer.WriteInteger(ms.Size);
writer.Write(ms.Memory^, ms.Size);
end; { If }
finally
ms.Free
end; { Finally }
end; { SaveClipboardFormat }
procedure LoadClipboardFormat(reader: TReader);
var
fmt: Integer;
fmtname: string;
Size: Integer;
ms: TMemoryStream;
begin
Assert(Assigned(reader));
fmt := reader.ReadInteger;
fmtname := reader.ReadString;
Size := reader.ReadInteger;
ms := TMemoryStream.Create;
try
ms.Size := Size;
reader.Read(ms.memory^, Size);
if Length(fmtname) > 0 then
fmt := RegisterCLipboardFormat(PChar(fmtname));
if fmt <> 0 then
CopyStreamToClipboard(fmt, ms);
finally
ms.Free;
end; { Finally }
end; { LoadClipboardFormat }
procedure SaveClipboard(S: TStream);
var
writer: TWriter;
i: Integer;
begin
Assert(Assigned(S));
writer := TWriter.Create(S, 4096);
try
Clipboard.Open;
try
writer.WriteListBegin;
for i := 0 to Clipboard.formatcount - 1 do
SaveClipboardFormat(Clipboard.Formats[i], writer);
writer.WriteListEnd;
finally
Clipboard.Close;
end; { Finally }
finally
writer.Free
end; { Finally }
end; { SaveClipboard }
procedure LoadClipboard(S: TStream);
var
reader: TReader;
begin
Assert(Assigned(S));
reader := TReader.Create(S, 4096);
try
Clipboard.Open;
try
clipboard.Clear;
reader.ReadListBegin;
while not reader.EndOfList do
LoadClipboardFormat(reader);
reader.ReadListEnd;
finally
Clipboard.Close;
end; { Finally }
finally
reader.Free
end; { Finally }
end; { LoadClipboard }
function ClipboardLoadFromStream(mStream: TStream): Boolean;
var
vClipboardFileHead: TClipboardFileHead;
vClipboardFileItem: TClipboardFileItem;
I: Integer;
vData: THandle;
begin
Result := False;
if not Assigned(mStream) then Exit;
if mStream.Size <= SizeOf(vClipboardFileHead) then Exit;
mStream.Read(vClipboardFileHead, SizeOf(vClipboardFileHead));
if vClipboardFileHead.rIdent <> rDataIdnet then Exit;
Clipboard.Clear;
Clipboard.Open;
try
for I := 0 to vClipboardFileHead.rCount - 1 do begin
mStream.Read(vClipboardFileItem, SizeOf(vClipboardFileItem) -
SizeOf(vClipboardFileItem.rData));
vData := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE,
vClipboardFileItem.rSize);
try
vClipboardFileItem.rData := GlobalLock(vData);
try
mStream.Read(vClipboardFileItem.rData^, vClipboardFileItem.rSize);
SetClipboardData(vClipboardFileItem.rFormat, vData);
finally
GlobalUnlock(vData);
end;
finally
GlobalFree(vData);
end;
end;
finally
Clipboard.Close;
end;
Result := True;
end; { ClipboardLoadFromStream }
procedure TNDClipboard.SetNdData;
var
Data: THandle;
DataPtr: Pointer;
MemStream: TMemoryStream;
begin
Open;
try
Data := NDclipboard.Handle;
if Data = 0 then Exit;
DataPtr := GlobalLock(Data);
if DataPtr = nil then Exit;
try
MemStream := TMemoryStream.Create;
try
MemStream.WriteBuffer(DataPtr^, GlobalSize(Data));
MemStream.Position := 0;
SetBuffer(CF_NDCONTENT, MemStream.Memory^, MemStream.Size);
finally
MemStream.Free;
end;
finally
GlobalUnlock(Data);
end;
finally
Close;
end;
end;
procedure TNDClipboard.GetNdData;
var
Data: THandle;
DataPtr: Pointer;
MemStream: TMemoryStream;
begin
Open;
try
Data := GetClipboardData(CF_NDCONTENT);
if Data = 0 then Exit;
DataPtr := GlobalLock(Data);
if DataPtr = nil then Exit;
try
MemStream := TMemoryStream.Create;
try
MemStream.WriteBuffer(DataPtr^, GlobalSize(Data));
MemStream.Position := 0;
finally
MemStream.Free;
end;
finally
GlobalUnlock(Data);
end;
finally
Close;
end;
end;
var
FNDClipboard: TNDClipboard;
function NDClipboard: TNDClipboard;
begin
if FNDClipboard = nil then
FNDClipboard := TNDClipboard.Create;
Result := FNDClipboard;
end;
procedure TNDClipboard.CopyNDDataFromClipboard;
var
hbuf: THandle;
bufptr: Pointer;
mstream: TMemoryStream;
begin
hbuf := Clipboard.GetAsHandle(CF_NDCONTENT);
if hbuf <> 0 then begin
bufptr := GlobalLock(hbuf);
if bufptr <> nil then begin
try
mstream := TMemoryStream.Create;
try
mstream.WriteBuffer(bufptr^, GlobalSize(hbuf));
mstream.Position := 0;
//-- 处理流的代码 --
//ClipboardLoadFromStream(mstream)
//LoadClipDataFromStream(mstream);
LoadClipboard(mstream);
finally
mstream.Free;
end;
finally
GlobalUnlock(hbuf);
end;
end;
end;
end;
procedure TNDClipboard.CopyNDDataToClipboard;
var
hbuf: THandle;
bufptr: Pointer;
mstream: TMemoryStream;
begin
mstream := TMemoryStream.Create;
try
//-- 处理流的代码 --
//ClipboardSaveToStream(mstream);
//SaveClipDataToStream(mstream);
SaveClipboard(mstream);
//mstream.SaveToFile('test');
hbuf := GlobalAlloc(GMEM_MOVEABLE, mstream.size);
try
bufptr := GlobalLock(hbuf);
try
Move(mstream.Memory^, bufptr^, mstream.size);
Clipboard.SetAsHandle(CF_NDCONTENT, hbuf);
finally
GlobalUnlock(hbuf);
end;
except
GlobalFree(hbuf);
raise;
end;
finally
mstream.Free;
end;
end;
procedure TNDClipboard.LoadClipDataFromStream(var AMem: TMemoryStream);
var
MemStream, DataStream: TMemoryStream;
i, FormatListLen, DataStreamLen: Integer;
tmpStrings: TStringList;
begin
DataStream := TMemoryStream.Create;
tmpStrings := TStringList.Create;
try
clipbrd.Clipboard.Open;
Clipboard.Clear;
AMem.Position := 0;
AMem.ReadBuffer(FormatListLen, SizeOf(Integer));
AMem.ReadBuffer(DataStreamLen, SizeOf(Integer));
DataStream.CopyFrom(AMem, FormatListLen);
DataStream.position := 0;
tmpStrings.LoadFromStream(DataStream);
DataStream.Clear;
DataStream.CopyFrom(AMem, DataStreamLen);
DataStream.position := 0;
if DataStream.Size <> 0 then DataStream.Position := 0;
for i := 0 to tmpStrings.Count - 1 do
begin
FormatListLen := StrToInt(tmpStrings.Names[i]);
DataStreamLen := StrToInt(tmpStrings.Values[tmpStrings.Names[i]]);
MemStream := TMemoryStream.Create;
try
MemStream.CopyFrom(DataStream, DataStreamLen);
MemStream.Position := 0;
SetBuffer(FormatListLen, MemStream.Memory^, DataStreamLen);
finally
MemStream.Free;
end;
end;
finally
clipbrd.Clipboard.Close;
tmpStrings.Free;
DataStream.Free;
end;
end;
procedure TNDClipboard.SaveClipDataToStream(var AMem: TMemoryStream);
var
Data: THandle;
DataPtr: Pointer;
MemStream, DataStream: TMemoryStream;
i, tmpInt: Integer;
tmpStrings: TStringList;
begin
DataStream := TMemoryStream.Create;
tmpStrings := TStringList.Create;
try
clipbrd.Clipboard.Open;
for i := 0 to Clipboard.FormatCount - 1 do
begin
Data := GetClipboardData(Clipboard.Formats[i]);
if Data = 0 then Continue;
DataPtr := GlobalLock(Data);
try
if DataPtr = nil then Continue;
MemStream := TMemoryStream.Create;
try
tmpInt := GlobalSize(Data);
if tmpInt = 0 then
beep;
MemStream.WriteBuffer(DataPtr^, GlobalSize(Data));
MemStream.Position := 0;
tmpStrings.Add(IntToStr(Clipboard.Formats[i]) + '=' + IntToStr(GlobalSize(Data)));
DataStream.WriteBuffer(MemStream.Memory^, MemStream.Size);
finally
MemStream.Free;
end;
finally
GlobalUnlock(Data);
end;
end;
if tmpStrings.Count <> 0 then
begin
AMem.Clear;
tmpInt := Length(tmpStrings.Text);
AMem.WriteBuffer(tmpInt, SizeOf(Integer));
tmpInt := DataStream.size;
AMem.WriteBuffer(tmpInt, Sizeof(Integer));
MemStream := TMemoryStream.Create;
try
tmpStrings.SaveToStream(MemStream);
AMem.WriteBuffer(MemStream.Memory^, MemStream.Size);
finally
MemStream.Free;
end;
AMem.WriteBuffer(DataStream.Memory^, DataStream.Size);
end;
finally
clipbrd.Clipboard.Close;
tmpStrings.Free;
DataStream.Free;
end;
end;
initialization
CF_NDCONTENT := RegisterClipboardFormat(NDClipboardFormatStr);
FNDClipboard := nil;
finalization
FNDClipboard.Free;
end.
