Icon cache rebuilding with Delphi(Delphi 清除Windows 图标缓存源代码)

清除Windows图标缓存的代码:

procedure RebuildIconCache;

....
const
  sr_WindowMetrics='Control Panel\Desktop\WindowMetrics\';
  sr_ShellIconSize='Shell Icon Size';

function  WindowsDir:string;
var
 buffer: array [0..255] of char;
begin
 GetWindowsDirectory(@Buffer,SizeOf(buffer));
 Result:=Buffer;
end;

Function UpdateAllWindowsCallback(WHandle : HWnd;
  Var Parm : Pointer) :
  Boolean; stdcall;
begin
 SendMessage(WHandle,WM_SETTINGCHANGE,0,0);
 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<>0 then SendMessage(wnd,WM_COMMAND,$A065,0)
  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,32);
  inc(sz);
  news:=inttostr(sz);
  regwritestring(HKEY_CURRENT_USER,
    sr_WindowMetrics+sr_ShellIconSize,news);
  UpdateAllWindows;
  if olds='' then olds:='32';
  regwritestring(HKEY_CURRENT_USER,
    sr_WindowMetrics+sr_ShellIconSize,olds);
  UpdateAllWindows;
  RefreshDeskTop;
 finally
  StopWait;
 end;
end;

 

posted @ 2014-04-02 09:50  Max Woods  阅读(500)  评论(0编辑  收藏  举报