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;