fileopsub.txt

某省公路收费站违章车辆抓拍管理系统

  
 

   Delphi中对目录拷贝、删除和搬移的操作
2000-09-02

--------------------------------------------------------------------------------

　　 笔者在工作中遇到了需要对目录进行拷贝、删除和搬移的需求，Delphi本身提供了一些目录操作函数，但只
是针对空目录而言，对目录下带有子目录的情况，更是无能为力。利用Win32 API函数和结构，以及递归的程序设
计思想，笔者实现了对任意目录进行拷贝、删除和搬移的功能(分别相当于DOS中的XCopy、DelTree和Move命令)。
以下分别给出了实现代码： 

　　 1、拷贝目录 

　　 为了能拷贝目录下带有子目录的情况，先定义一个辅助的拷贝函数，它是递归执行的，直到把目录下的所有
文件和子目录都拷贝完。 

　　 1.1拷贝目录的递归辅助函数：DoCopyDir 

function DoCopyDir(sDirName:String;sToDirName:String):Boolean;
var hFindFile:Cardinal; t,tfile:String;
    sCurDir:String[255]; FindFileData:WIN32_FIND_DATA;
begin
//先保存当前目录
sCurDir:=GetCurrentDir;
ChDir(sDirName);
hFindFile:=FindFirstFile('*.*',FindFileData);
if hFindFile< >INVALID_HANDLE_VALUE then
begin
if not DirectoryExists(sToDirName) then
ForceDirectories(sToDirName);
repeat
tfile:=FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
Continue;
if FindFileData.dwFileAttributes=
FILE_ATTRIBUTE_DIRECTORY then
begin
t:=sToDirName+'\'+tfile;
if not DirectoryExists(t) then
ForceDirectories(t);
if sDirName[Length(sDirName)]< >'\' then
DoCopyDir(sDirName+'\'+tfile,t)
else
DoCopyDir(sDirName+tfile,sToDirName+tfile);
end
else
begin
t:=sToDirName+'\'+tFile;
CopyFile(PChar(tfile),PChar(t),True);
end;
until FindNextFile(hFindFile,FindFileData)=false;
FindClose(hFindFile);
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//回到原来的目录下
ChDir(sCurDir);
result:=true;
end;
　　 1.2拷贝目录的函数：CopyDir 

function CopyDir(sDirName:String;
sToDirName:string):Boolean;
begin
if Length(sDirName)< =0 then
exit;
//拷贝...
Result:=DoCopyDir(sDirName,sToDirName);
end;
　　 2、删除目录 

　　 删除目录与拷贝目录很类似，但为了能删除位于根目录下的一个空目录，需要在辅助函数中设置一个标志
变量，即：如果删除的是空目录,则置bEmptyDir为True，这一句已经用深色框表示了。 

　　 2.1删除目录的递归辅助函数：DoRemoveDir 

function DoRemoveDir(sDirName:String):Boolean;
var
hFindFile:Cardinal;
tfile:String;
sCurDir:String;
bEmptyDir:Boolean;
FindFileData:WIN32_FIND_DATA;
begin
//如果删除的是空目录,则置bEmptyDir为True
//初始时,bEmptyDir为True
bEmptyDir:=True;
//先保存当前目录
sCurDir:=GetCurrentDir;
SetLength(sCurDir,Length(sCurDir));
ChDir(sDirName);
hFindFile:=FindFirstFile('*.*',FindFileData);
if hFindFile< >INVALID_HANDLE_VALUE then
begin
repeat
tfile:=FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
begin
bEmptyDir:=bEmptyDir and True;
Continue;
end;
//不是空目录,置bEmptyDir为False
bEmptyDir:=False;
if FindFileData.dwFileAttributes=
FILE_ATTRIBUTE_DIRECTORY then
begin
if sDirName[Length(sDirName)]< >'\' then
DoRemoveDir(sDirName+'\'+tfile)
else
DoRemoveDir(sDirName+tfile);
if not RemoveDirectory(PChar(tfile)) then
result:=false
else
result:=true;
end
else
begin
if not DeleteFile(PChar(tfile)) then
result:=false
else
result:=true;
end;
until FindNextFile(hFindFile,FindFileData)=false;
FindClose(hFindFile);
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//如果是空目录,则删除该空目录
if bEmptyDir then
begin
//返回上一级目录
ChDir('..');
//删除空目录
RemoveDirectory(PChar(sDirName));
end;

//回到原来的目录下
ChDir(sCurDir);
result:=true;
end;
　　 2.2删除目录的函数：DeleteDir 

function DeleteDir(sDirName:String):Boolean;
begin
if Length(sDirName)< =0 then
exit;
//删除...
Result:=DoRemoveDir(sDirName) and RemoveDir(sDirName);
end;
　　 3、移动目录 

　　 有了拷贝目录和删除目录的函数，移动目录就变得很简单，只需顺序调用前两个函数即可： 

function MoveDir(sDirName:String;
sToDirName:string):Boolean;
begin
if CopyDir(sDirName,sToDirName) then
if RemoveDir(sDirName) then
result:=True
else
result:=false;
end;
 
--------------------------------------------------------------------------------

　　1．读硬盘序列号 

function GetDiskSerial(DiskChar: Char): string;

var
SerialNum : pdword;
a, b : dword;
Buffer : array [0..255] of char;
begin
result := "";
if GetVolumeInformation(PChar(diskchar+":\"), Buffer, SizeOf(Buffer), SerialNum,
a, b, nil, 0) then
　Result := IntToStr(SerialNum^);
end;

　　2．检查磁盘是否就绪

Function DiskReady(Root: string) : Boolean;

var
Oem : CARDINAL ;
Dw1,Dw2 : DWORD ;

begin
Oem := SetErrorMode( SEM_FAILCRITICALERRORS ) ;
if LENGTH(Root) = 1 then Root := Root + ":\\" ;
　Result := GetVolumeInformation( PCHAR( Root ), NIL,0,NIL, Dw1,Dw2, NIL,0 ) ;
　SetErrorMode( Oem ) ;
end;

怎样拷贝目录 
How to Copy A Directory?
In Win32 there is an API function for that: SHFileOperation.
copy a whole directory tree
procedure TForm1.Button2Click(Sender: TObject);
var
  OpStruc: TSHFileOpStruct;
  frombuf, tobuf: Array [0..128] of Char;
Begin 
  //不认识*.*, 和findfirst,findnext结合起来用,
  //他可以把一个给定的目录下的东西(包括子目录)移走,定义在shellapi单元
  //path or filename 不能超长，定义成string很容易超长!!!!!,from shi
  FillChar( frombuf, Sizeof(frombuf), 0 );
  FillChar( tobuf, Sizeof(tobuf), 0 );
  StrPCopy( frombuf, 'd:\brief\*.*' );
  StrPCopy( tobuf, 'd:\temp\brief' );
  With OpStruc DO Begin
    Wnd:= Handle;
    wFunc:= FO_COPY;// ..FO_MOVE
    pFrom:=frombuf;
    pTo:=tobuf;
    fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
    fAnyOperationsAborted:= False;
    hNameMappings:= Nil;
    lpszProgressTitle:= Nil;
  end;
  ShFileOperation( OpStruc );
end;

 
一个可执行的文件怎么删掉它自己？  
How Can A Exe File Kill himself?
a common trick to make a program self-destruct is to have it write a tiny
batch file, and, as the very last thing it does before closing, starting
this batch file with a
   winexec(batchfilename, SW_HIDE );
The batch deletes the program and then can delete itself. The last line is a
del %0
and it is *not* terminated with a carriage return/line feed pair.