清除Windows图标缓存的代码:
procedure RebuildIconCache; ....
const
sr_WindowMetrics='Control Panel\Desktop\WindowMetrics\';
sr_ShellIconSize='Shell Icon Size'; function WindowsDir:string;
var
buffer: array [..] of char;
begin
GetWindowsDirectory(@Buffer,SizeOf(buffer));
Result:=Buffer;
end; Function UpdateAllWindowsCallback(WHandle : HWnd;
Var Parm : Pointer) :
Boolean; stdcall;
begin
SendMessage(WHandle,WM_SETTINGCHANGE,,);
Result:=True;
end; Procedure UpdateAllWindows;
Begin
EnumWindows(@UpdateAllWindowsCallback,
WM_SETTINGCHANGE);
End; function GetIconCacheFile:string;
begin
Result:=getwindowspath+'ShellIconCache';
end; procedure DeleteIconCache;
var
sfile:string;
begin
sfile:=GetIconCacheFile;
if fileexists(sfile) then begin
if deletefile(sfile)=false
then showmessage('Can not erase file: '+sfile);
end;
QueryRestartWindows;
end; function RefreshActiveDesktop:boolean;
const
CLSID_ActiveDesktop: TGUID
= '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
ActiveDesktop: IActiveDesktop;
begin
try
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop)
as IActiveDesktop;
ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
Result:=true;
except
Result:=false;
end;
end; procedure RefreshDesktop;
var
wnd:THandle;
fl:boolean;
begin
fl:=RefreshActiveDesktop;
if fl=false then begin
wnd:=FindWindow('Progman', 'Program Manager');
if wnd<> then SendMessage(wnd,WM_COMMAND,$A065,)
else UpdateAllWindows;
end;
end; procedure RebuildIconCache;
var
news,olds:string;
sz:integer;
begin
Startwait;
try
deletefile(GetIconCacheFile);
olds:=regreadstring(HKEY_CURRENT_USER,
sr_WindowMetrics+sr_ShellIconSize);
sz:=strtointdef(olds,);
inc(sz);
news:=inttostr(sz);
regwritestring(HKEY_CURRENT_USER,
sr_WindowMetrics+sr_ShellIconSize,news);
UpdateAllWindows;
if olds='' then olds:='';
regwritestring(HKEY_CURRENT_USER,
sr_WindowMetrics+sr_ShellIconSize,olds);
UpdateAllWindows;
RefreshDeskTop;
finally
StopWait;
end;
end;