征集 几个API函数(200分)

  • 主题发起人 主题发起人 f643208
  • 开始时间 开始时间
F

f643208

Unregistered / Unconfirmed
GUEST, unregistred user!
删除所有文件及文件夹中的内容 不要提示 Y/N
快速格式化硬盘 不要提示 Y/N

适用与98 和 2000
 
1.
来自:ligia, 时间:2002-12-9 10:38:00, ID:1495663
//---------------删除目录树------------------------------------------------
FUNCTION FkDeleteTree(vFolder:STRING):Boolean;
VAR
srList: TSearchRec;
DirList: TStringList;
oFound,oTemp: Boolean;
i: integer;
BEGIN
oTemp:=True;
// 建立一个文件夹列表
DirList := TStringList.Create;
vFolder:=TRIM(vFolder);
IF vFolder[length(vFolder)]<>'/' THEN vFolder:=vFolder + '/';
// 生成文件夹列表
oFound:=FindFirst(vFolder+'*.*',(faDirectory+faHidden+faSysFile), srList) = 0;
WHILE oFound DO
BEGIN
IF (DirectoryExists(vFolder+srList.Name) and (srList.Name<>'.') AND (srList.Name<>'..')) THEN
DirList.Add(vFolder+srList.Name);
oFound :=(FindNext(srList)=0);
END;
FindClose(srList);
//查找当前目录的文件删除
oFound:=FindFirst(vFolder+'*.*',(faAnyFile+faHidden+faSysFile+faReadOnly), srList) = 0;
WHILE oFound DO
BEGIN
FileSetAttr(vFolder+srList.Name,0);
oTemp:=DeleteFile(vFolder+srList.Name) and oTemp;
oFound:=(FindNext(srList)=0);
END;
FindClose(srList);
//查找列表的子目录
FOR i := 0 TO DirList.Count-1 DO FkDeleteTree(DirList);
FileSetAttr(vFolder,0);
oTemp:=RemoveDir(vFolder) AND oTemp;
DirList.Free;
Result:=oTemp;
END;
//--------------------------------------------------------------

顺便问一下,你不会是在做什么病毒或木马吧?
 
找到一个函数,看有没有帮助

标题:自己删除自己
说明:警告执行此程序将删除所在目录的所有文件及目录
设计:Zswang
日期:2002-01-29
支持:wjhu111@21cn.com
//*)

///////Begin Source
uses
Windows, Dialogs, SysUtils, Controls;

procedure DeleteMe(mDeleteDir: Boolean = False); { 自己删除自己 }
var
vExeDir: string;

procedure pDelDir(mDirName: string); { 删除指定路径 }
var
vSearchRec: TSearchRec;
PathName: string;
K: Integer;
begin
PathName := mDirName + '/*.*';
K := FindFirst(PathName, faAnyFile, vSearchRec);
while K = 0 do begin
if (vSearchRec.Attr and faDirectory > 0) and
(Pos(vSearchRec.Name, '..') = 0) then begin
{$WARNINGS OFF}
FileSetAttr(vSearchRec.Name, faDirectory);
{$WARNINGS ON}
pDelDir(mDirName + '/' + vSearchRec.Name);
end else if (Pos(vSearchRec.Name, '..') = 0) and
(CompareText(mDirName + '/' + vSearchRec.Name, ParamStr(0)) <> 0) then begin
{$WARNINGS OFF}
FileSetAttr(vSearchRec.Name, 0);
{$WARNINGS ON}
DeleteFile(PChar(mDirName + '/' + vSearchRec.Name));
end;
K := FindNext(vSearchRec);
end;
if CompareText(vExeDir, mDirName) <> 0 then RmDir(mDirName);
end; { pDelDir }

var
BatchFile: TextFile;
BatchFileName: TFileName;
ProcessInfo: TProcessInformation;
StartUpInfo: TStartupInfo;
begin
vExeDir := ExtractFileDir(ParamStr(0));
if mDeleteDir then pDelDir(vExeDir);
BatchFileName := '../DeleteMe.bat';
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile, ':del');
Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
Writeln(BatchFile, 'if exist "' + ParamStr(0) + '"' + ' goto try');
if mDeleteDir then Writeln(BatchFile, 'rd ' + ExtractFileDir(ParamStr(0)));
Writeln(BatchFile, 'del %0');
CloseFile(BatchFile);
FillChar(StartUpInfo, SizeOf(StartUpInfo), #0);
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(BatchFileName), nil, nil,
False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
ProcessInfo) then begin
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
end; { DeleteMe }
///////End Source

///////Begin Demo
begin
if MessageDlg('警告执行此程序将删除所在目录的所有文件及目录',
mtWarning, [mbYes, mbNo], 0) = mrYes then
DeleteMe(True);
end.
///////End Demo
 
下载个API浏览器,自己查查看
http://www.playicq.com/dispdoc.php?t=33&amp;id=2132
 
//删除目录的函数,包括子目录
procedure DeleteDirectory(const Path,WindowTitle:string);
Var T:TSHFileOpStruct;
begin
With T do Begin
Wnd:=0;
wFunc:=FO_DELETE;
pFrom:=Pchar(Path);
pTo:=nil;
///fFlags:=FOF_ALLOWUNDO+FOF_NOCONFIRMATION+FOF_NOERRORUI;//标志表明允许恢复,无须确认并不显示出错信息
fFlags:=FOF_NOCONFIRMATION+FOF_NOERRORUI;//标志表明允许恢复,无须确认并不显示出错信息
hNameMappings:=nil;
lpszProgressTitle:=pchar(WindowTitle);
fAnyOperationsAborted:=False;
End;
SHFileOperation(T);
end;
 
楼主用心不良。
 
快速格式化硬盘
format c:/y
 
删除子目录及其下文件

This doesn't check for attributes being set, which might preclude deletion of a file. Put a {$I-} {$I+} pair around the functions that cause the problem.

procedure removeTree (DirName: string);
var
FileSearch: SearchRec;
begin
{ first, go through and delete all the directories }
chDir (DirName);
FindFirst ('*.*', Directory, FileSearch);
while (DosError = 0) do
begin
if (FileSearch.name <> '.')
AND (FileSearch.name <> '..')
AND ((FileSearch.attr AND Directory) <> 0)
then begin
if DirName[length(DirName)] = '/' then
removeTree (DirName+FileSearch.Name)
else
removeTree (DirName+'/'+FileSearch.Name);
ChDir (DirName);
end;
FindNext (FileSearch)
end;
{then, go through and delete all the files }
FindFirst ('*.*', AnyFile, FileSearch);
while (DosError = 0) do
begin
if (FileSearch.name <> '.')
AND (FileSearch.name <> '..') then
Remove (workdir); ??Remove和WorkDir是何意,删除文件?
end; ??此行似乎不该有
FindNext (FileSearch)
end;
rmDir (DirName) ??应进入上层目录
end;



shell32.dll就有Format这样的函数
There is an API hidden away in Shell32.dll called SHFormatDrive, this brings up the standard format removable drive dialog. I stumbled across this in the borland.public.delphi.winapi newsgroup.

{implementation section}
..
..
const
SHFMT_ID_DEFAULT = $FFFF;
// Formating options
SHFMT_OPT_QUICKFORMAT = $0000;
SHFMT_OPT_FULL = $0001;
SHFMT_OPT_SYSONLY = $0002;
// Error codes
SHFMT_ERROR = $FFFFFFFF;
SHFMT_CANCEL = $FFFFFFFE;
SHFMT_NOFORMAT = $FFFFFFFD;

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt;
stdcall; external 'shell32.dll' name 'SHFormatDrive'

procedure TForm1.btnFormatDiskClick(Sender: TObject);
var
retCode: LongInt;
begin
retCode:= SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT,
SHFMT_OPT_QUICKFORMAT);
if retCode < 0 then
ShowMessage('Could not format drive');
end;

end.
/////////////////////////////////////////
function SHFormatDrive(hWnd : HWND;Drive, fmtID, Options : WORD) : longint; stdcall; external 'shell32.dll';
function _DiskFormat( const Drive : Char ):string; //对一个可移动驱动器或硬盘驱动器格式化,注意这个函数是非常危险的.
var
wDrive : WORD;
dtDrive : string;
formatretcode:longint;
begin
dtDrive := _DiskDriverType(Upcase(Drive));
if not _OK(dtDrive) then begin
result:=dtDrive+'(DiskFormat)'; exit;
end;
// if it's not a HDD or a FDD then raise an exception
if (not _Contain('可移动',dtDrive)) and (not _Contain('硬盘',dtDrive)) then
result := badresult+'无法格式化一个'+dtDrive
else begin// 进行格式化
wDrive := Ord( UpCase(Drive) ) - Ord( 'A' );
// SHFormatDrive 是一个没有公开的 API 函数调用
formatretcode:=SHFormatDrive( Application.Handle, wDrive, $ffff, 0);
if formatretcode=-1 then result:=badresult+'格式化程序已执行,在格式化中发生错误,返回代码:'+inttostr(formatretcode)
else if formatretcode=-2 then result:=badresult+'格式化程序已执行,用户放弃格式化驱动器:'+Drive
else if formatretcode=6 then result:='格式化程序已执行,完成驱动器:'+Drive+'的格式化'
else result:='格式化程序已执行,返回代码:'+inttostr(formatretcode);
end; // else
end;
 
应该格式不了C吧?
 
9X下可以格C(直接写硬盘),NT类可能性很低。
 
看起怎么象要做病毒???[:D]
98下用Format应该就可以了。启动的时候就可以用。
2000下就不知道了,并且在有程序运行的时候是不能格的!
 
看来不是做好事。
 
多人接受答案了。
 
后退
顶部