我写的备份/恢复剪贴板数据(0分)

我写的备份/恢复剪贴板数据
uses Clipbrd;
type//自定义数据类型，用来保存剪贴板数据
PClips = ^TClips;
TClips = record
cf: array[0..255] of char; //剪贴板格式代码
buf: TMemoryStream; //剪贴板数据
size: Cardinal; //数据大小
end;

procedure CopyStreamToClipboard(fmt: cardinal; S: TMemoryStream);//将数据流恢复到剪贴板
var
hMem: THandle;
pMem: Pointer;
begin
S.Position := 0;
hMem := GlobalAlloc(GMEM_MOVEABLE 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
SetClipboardData(fmt, hmem);
{我最初用Clipboard.SetAsHandle(fmt, hMem)写的，但效果不好，不知如何改正}
finally
Clipboard.Close;
end;
end
else
begin
GlobalFree(hMem);
OutOfMemoryError;
end;
end
else
OutOfMemoryError;
end;

procedure CopyStreamFromClipboard(fmt: cardinal; S: TMemoryStream);将剪贴板的数据保存到数据流中
var
hMem: THandle;
pMem: Pointer;
begin
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 TForm1.Button1Click(Sender: TObject);{保存剪贴板数据到文件}
const
PredefinedClipboardNames: array[1..17] of string =
('CF_TEXT', 'CF_BITMAP','CF_METAFILEPICT', 'CF_SYLK',
'CF_DIF','CF_TIFF', 'CF_OEMTEXT', 'CF_DIB','CF_PALETTE',
'CF_PENDATA', 'CF_RIFF', 'CF_WAVE', 'CF_UNICODETEXT',
'CF_ENHMETAFILE', 'CF_HDROP', 'CF_LOCALE','CF_MAX');
var
i: Integer;
blk: PClips;
ms: TMemoryStream;
ClipList: TList;
begin
ClipList := TList.Create;
ms := TMemoryStream.Create;
{因为我不知道剪贴板里哪些数据有用，所以只能将剪贴板里的数据一一保存，希望能得到大家的指点}
for i := 0 to Clipboard.FormatCount - 1 do
begin
New(blk);
FormatID :=Clipboard.Formats;
Len := GetClipboardFormatName(FormatID,FormatName,255);{这里也作了修改}
if Len = 0 then
StrCopy(blk.cf,Pchar(PredefinedClipboardNames[FormatID]))
blk.buf := TMemoryStream.Create;
if FormatID= 14 then continue;
{当剪贴板格式代码为14时，保存数据会出现异常，所以终止本次循环，而不保存数据}
CopyStreamFromClipboard(FormatID,blk.buf);
blk.size:=blk.buf.Size;
ClipList.Add(blk);
end;
ms.writebuffer(ClipList.count, sizeof(ClipList.count);
for i:=0 to ClipList.Count -1 do
begin
ms.Writebuffer(PClips(ClipList.Items).cf,sizeof(PClips(ClipList.Items

).cf));
ms.Writebuffer(PClips(ClipList.Items).size,sizeof(PClips(ClipList.Items

).size));
ms.Writebuffer(PClips(ClipList.Items).buf.Memory^,PClips(ClipList.Items

).buf.Size);

end;
ms.SaveToFile('c:/ClipBoard.bak');
while ClipList.count > 0 do
begin
PClips(ClipList.Items[0]).buf.Free; //释放Tmemorystream对象
Dispose(ClipList.Items[0]); //释放TClipList结构
ClipList.Delete(0);
end;
ms.Free;
ClipList.free;
end;

procedure TForm1.Button2Click(Sender: TObject);{恢复剪贴板数据}
const
PredefinedClipboardNames: array[1..17] of string =
('CF_TEXT', 'CF_BITMAP','CF_METAFILEPICT', 'CF_SYLK',
'CF_DIF','CF_TIFF', 'CF_OEMTEXT', 'CF_DIB','CF_PALETTE',
'CF_PENDATA', 'CF_RIFF', 'CF_WAVE', 'CF_UNICODETEXT',
'CF_ENHMETAFILE', 'CF_HDROP', 'CF_LOCALE','CF_MAX');
var
blk: PClips;
i,cnt,FC:integer;
ms: TMemoryStream;
pointer;
ClipList: TList;
begin
ms:=TMemoryStream.Create ;
ClipList := TList.Create;
ms.LoadFromFile('c:/ClipBoard.bak');
Clipboard.Clear;
ms.ReadBuffer(cnt, Sizeof(ClipList.count));
{不知道有没有直接将所有数据一下就复制到剪贴板里的方法，我只能依次将数据放到剪贴板里}
for i := 0 to cnt-1 do
begin
New(blk);
ms.readBuffer(blk.cf ,sizeof(blk.cf));
ms.readBuffer(blk.size ,sizeof(blk.size));
blk.buf := TMemoryStream.Create;
blk.buf.CopyFrom(ms,blk.size);
for FC:=1 to 17 do {这是我后加上的，以前的没有考虑到这一点，所以会有bug}
if string(blk.cf) = PredefinedClipboardNames[FC] then
break;
if FC>17 then
FormatID:= RegisterClipboardFormat(blk.cf)
else
FormatID:=FC;
CopyStreamToClipboard(FormatID,blk.buf);
ClipList.Add(blk);
end;
while ClipList.count > 0 do
begin
PClips(ClipList.Items[0]).buf.Free; //释放Tmemorystream对象
Dispose(ClipList.Items[0]); //释放TClipList结构
ClipList.Delete(0);
end;
ClipList.Free;
ms.free;
end;