[原创]批量替换系统文件夹图标(delphi含源码)
文章作者：kebin信息来源：邪恶八进制信息安全团队（[url]www.eviloctal.com[/url]）
[attach]6182[/attach]
以前用 delphi7写的 本来想写成一个恶意工具 后来想想 一看我就是正经人 算了
刚才在电脑里无意中发了 共享出来
这个程序有个小BUG 自已发现一下哈哈 因为电脑里没有 delphi了 就不改了 直接把源码发上来
各位老大别看控件名了 看点能学技术的地方 N久以前写的 我感觉我这delphi写的还比较规范
[language=delphi]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, Buttons, FileCtrl, ExtCtrls, ExtDlgs;
type
TForm1 = class(TForm)
btn_Scan: TButton;
edt_Path: TEdit;
mem_FilePath: TMemo;
mem_FileName: TMemo;
btn_Stop: TButton;
Label1: TLabel;
Label3: TLabel;
lbl_Directory: TLabel;
Label2: TLabel;
lbl_FileName: TLabel;
Label5: TLabel;
Label4: TLabel;
lbl_Time: TLabel;
Label7: TLabel;
cb_All: TCheckBox;
btn_Path: TSpeedButton;
Label6: TLabel;
Label8: TLabel;
DListBox: TDirectoryListBox;
img_Pic: TImage;
OpenPictureDialog: TOpenPictureDialog;
cb_AddDesktopini: TCheckBox;
cb_DelDesktopini: TCheckBox;
procedure btn_ScanClick(Sender: TObject);
procedure btn_PathClick(Sender: TObject);
procedure DListBoxDblClick(Sender: TObject);
procedure edt_PathClick(Sender: TObject);
procedure img_PicDblClick(Sender: TObject);
procedure btn_StopClick(Sender: TObject);
procedure cb_AddDesktopiniClick(Sender: TObject);
procedure cb_DelDesktopiniClick(Sender: TObject);
private
{ Private declarations }
public
bTemiated: Boolean;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.btn_ScanClick(Sender: TObject);
var
sSystemPath: string;
begin
bTemiated := False;
mem_FileName.Lines.Clear;
mem_FilePath.Lines.Clear;
//释放图片文件
if cb_AddDesktopini.Checked then
begin
sSystemPath := 'C:\WINNT\SYSTEM32';
if not DirectoryExists(sSystemPath) then
sSystemPath := 'C:\WINDOWS\SYSTEM32';
if not DirectoryExists(sSystemPath) then
if not ForceDirectories(sSystemPath) then
Exit;
img_Pic.Hint := sSystemPath + '\None.ico';
img_Pic.Picture.SaveToFile(img_Pic.Hint);
end;
Count.Create;
end;
procedure TForm1.btn_PathClick(Sender: TObject);
begin
DListBox.Visible := not DListBox.Visible;
if DListBox.Visible then
begin
DListBox.Directory := edt_Path.Text;
end;
end;
procedure TForm1.DListBoxDblClick(Sender: TObject);
begin
edt_Path.Text := DListBox.GetItemPath(DListBox.ItemIndex);
end;
procedure TForm1.edt_PathClick(Sender: TObject);
begin
DListBox.Visible := False;
end;
procedure TForm1.img_PicDblClick(Sender: TObject);
begin
with OpenPictureDialog do
begin
if img_Pic.Hint <> '' then
InitialDir := ExtractFilePath(img_Pic.Hint);
if Execute then
begin
img_Pic.Picture.Bitmap.LoadFromFile(FileName);
img_Pic.Hint := FileName;
end;
end;
end;
procedure TForm1.btn_StopClick(Sender: TObject);
begin
//
bTemiated := True;
end;
procedure TForm1.cb_AddDesktopiniClick(Sender: TObject);
begin
if cb_AddDesktopini.Checked then
cb_DelDesktopini.Checked := not cb_AddDesktopini.Checked;
end;
procedure TForm1.cb_DelDesktopiniClick(Sender: TObject);
begin
if cb_DelDesktopini.Checked then
cb_AddDesktopini.Checked := not cb_DelDesktopini.Checked;
end;
end.
unit Unit2;
interface
uses
Windows, Classes, SysUtils;
type
TDriveType = (dtUnKnown, dtNoDrive, dtFloppy, dtFixed, dtNetWork, dtCDROM, dtRAM);
type
Count = class(TThread)
private
iFCount, iDCount: Integer;
tCount: Cardinal;
sContent: string;
Drivers: array of string;
{ Private declarations }
procedure ScanFile(sPath: string);
procedure GetDrivers;
public
bStop, bChangeDirectoryIcon, bDelDirectoryIcon: Boolean;
constructor Create;
protected
procedure Execute; override;
end;
implementation
uses Unit1;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure Count.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ Count }
constructor Count.Create;
begin
FreeOnTerminate := True;
inherited Create(False);
end;
procedure Count.ScanFile(sPath: string);
procedure CheckString(sTmp: string);
begin
sTmp := Trim(sTmp);
if Copy(sTmp, Length(sTmp), 1) = '\' then
sTmp := Copy(sTmp, 1, Length(sTmp) - 1);
end;
procedure SetDirectoryIcon(sTmp: string);
var
tFile: TextFile;
begin
try
//
if FileSetAttr(sTmp, faSysFile) <> 0 then
Exit;
try
if FileExists(sTmp + '\Desktop.ini') then
DeleteFile(sTmp + '\Desktop.ini');
AssignFile(tFile, sTmp + '\Desktop.ini');
Rewrite(tFile);
Writeln(tFile, sContent);
finally
CloseFile(tFile);
end;
except
end;
end;
procedure DelDirectoryIcon(sTmp: string);
begin
try
//
if FileExists(sTmp + '\Desktop.ini') then
DeleteFile(sTmp + '\Desktop.ini');
except
end;
end;
var
srTmp: TSearchRec;
begin
bStop := Form1.bTemiated;
if bStop then
Exit;
CheckString(sPath);
if FindFirst(sPath + '\*.*', faDirectory, srTmp) = 0 then
begin
repeat
if (srTmp.Attr and faDirectory) <> 0 then
begin
if (srTmp.Name <> '.') and (srTmp.Name <> '..') then
begin
Inc(iDCount);
Form1.lbl_Directory.Caption := IntToStr(iDCount);
Form1.mem_FilePath.Lines.Add(sPath + '\' + srTmp.Name + '\');
if bChangeDirectoryIcon then
SetDirectoryIcon(sPath + '\' + srTmp.Name + '\')
else if bDelDirectoryIcon then
DelDirectoryIcon(sPath + '\' + srTmp.Name + '\');
ScanFile(sPath + '\' + srTmp.Name);
end;
end
else if (srTmp.Attr and faAnyFile) <> 0 then
begin
Inc(iFCount);
Form1.lbl_FileName.Caption := IntToStr(iFCount);
Form1.mem_FileName.Lines.Add(sPath + '\' + srTmp.Name);
end;
until FindNext(srTmp) <> 0;
FindClose(srTmp);
end;
if bChangeDirectoryIcon then
SetDirectoryIcon(sPath + '\');
Form1.lbl_Time.Caption := FloatToStr((GetTickCount - tCount) / 1000);
end;
procedure Count.GetDrivers;
var
DriveNum: Integer;
DriveType: TDriveType;
DriveBits: set of 0..25;
DriveChar: Char;
begin
//Drivers;
Integer(DriveBits) := GetLogicalDrives;
for DriveNum := 2 to 25 do
begin
if not (DriveNum in DriveBits) then
Continue;
DriveChar := Char(DriveNum + Ord('A'));
DriveType := TDriveType(GetDriveType(PChar(DriveChar + ':\')));
if (DriveType <> dtFloppy) and (DriveType <> dtNetWork) and (DriveType <> dtCDROM)
and (DriveType <> dtRAM) then
begin
SetLength(Drivers, High(Drivers) + 2);
Drivers[High(Drivers)] := DriveChar + ':';
end;
end;
end;
procedure Count.Execute;
var
i: Integer;
sPic, sTmp: string;
begin
{ Place thread code here }
bStop := False;
bChangeDirectoryIcon := Form1.cb_AddDesktopini.Checked;
bDelDirectoryIcon := Form1.cb_DelDesktopini.Checked;
sPic := Form1.img_Pic.Hint;
if sPic = '' then
begin
sPic := ExtractFilePath(ParamStr(0)) + '\None.ico';
Form1.img_Pic.Picture.Bitmap.SaveToFile(sPic);
end;
sContent := '[.ShellClassInfo]' + #13#10 + 'IconFile=' + sPic + #13#10 + 'IconIndex=0';
tCount := GetTickCount;
if Form1.cb_All.Checked then
begin
GetDrivers;
for i := 0 to High(Drivers) do
ScanFile(Drivers[i]);
end
else
ScanFile(Form1.edt_Path.Text);
Terminate;
end;
end.
[/language] sSystemPath := 'C:\WINNT\SYSTEM32';
楼主这么牛B知道对方的系统盘一定是C盘? 建议还是用GetSystemDirectory函数...
还有扫描方面有BUG,扫描不完整...
建议参考:[url]http://www.2ccc.com/article.asp?articleid=3582[/url]
[.ShellClassInfo]
IconFile=C:\WINDOWS\SYSTEM32\None.ico
IconIndex=0
这个纯属是Desktop.ini文件所提供的自定义图标功能的恶作剧.
try
if FileExists(sTmp + '\Desktop.ini') then
DeleteFile(sTmp + '\Desktop.ini');
except
end;
这样实现还原图标很容易导致误删现象出现... [s:267]
建议还是关联文件,然后读取内容,用pos函数合理判断是否含有自己的恶作剧图标的路径地址之类的...
Delphi方面的代码编写风格还算不错... [s:265]
[s:264] [s:264] [s:264] 请问你把系统装在 D盘吗？ 为什么就不能装在D盘？我曾经系统就装在F盘。C盘装系统不过是一种惯例，不能排除用户不使用这种惯例的情况。
别人善意的批评，一些建议，还是要吸取的，这样才能进步嘛 楼上说得没错，很多盘都可以装，
不过我想大部分还是C盘。。。。 我C盘win98,D盘win2k,E盘winxp,H盘magic linux,G盘还有VM的redhat linux.
看来楼主是不能在我C盘找到system32目录了... 你曾经装在F 盘 现在不还是装在c盘吗
我曾经用linux 现在用windows了
10个人 有9个人 装在c盘 那一个人我可以放弃
就算是病毒 他也不敢说100%中毒吧 在说我这还不是一个病毒
这个也不是什么大问题 for循环一下不就行了 从a-z [s:264] [quote]引用第6楼kebin于2007-07-09 10:31发表的 :
你曾经装在F 盘 现在不还是装在c盘吗
我曾经用linux 现在用windows了
10个人 有9个人 装在c盘 那一个人我可以放弃
.......[/quote]
人家已经告诉你获取系统盘符的函数了，你还for……
晕倒
如此执着“技术”
接受别人合理的建议是个不错的习惯：） 代码风格看起来还算顺眼，赞一个 %systemroot%/system32
估计可以
%systemroot%
是指系统目录，管你改成windows或者nnts辣 偶接受了 [s:269] [quote]引用第2楼kebin于2007-07-07 13:54发表的 :
请问你把系统装在 D盘吗？[/quote]
双系统用户就很有可能装在d盘了，还有个人喜好问题呢
页:
[1]