안녕하세요 ?
저는 인지정보에 근무하는 윤미화라고 합니다
저희 Package(supercel)가 Win95, Win98에서는 잘 도는데요, NT에서는 Error가
나는데 원인을 몰라서 이렇게 도움을 요청하게 되었습니다.
저희는 디렉토리를 지우기 위해 (서브 디렉토리및 파일 포함) RecursivelyDeleteDirectory 라는 함수를 Call하는데요.
NT에서는 화일은 지워지는데 디렉토리가 지워지지 않고 에러가 발생합니다.
Source file을 첨부하오니 도와주시면 참 많이 감사하겠습니다.
unit FileWork;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Controls,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ShellAPI, FileCtrl;
const
EOC_CHANGEDIR = 1; { Error Operation Code for change directory failure }
EOC_SOURCECOPY = 2; { Error Operation Code for source copy failure }
EOC_DESTCOPY = 3; { Error Operation Code for destination copy failure }
EOC_DELETEFILE = 4; { Error Operation Code for file delete failure }
EOC_DELETEDIR = 5; { Error Operation Code for directory delete failure }
EOC_RENAMEFILE = 6; { Error Operation Code for renaming failure }
EOC_MAKEDIR = 7; { Error Operation Code for MkDir failure }
EOC_SETATTR = 8; { Error Operation Code for Set Attributes failure }
FAC_COPY = 1; { File Action Code for recursive copying }
FAC_MOVE = 2; { File Action Code for recursive moving }
FAC_DELETE = 3; { File Action Code for recursive deletion }
type
TFileWork = class( TComponent )
public
procedure HandleIOException( TheOpCode : Integer; ThePath : String;
TheMessage : String; TheCode : Integer );
procedure DeleteTheFile( ThePath : String );
procedure RemoveDirectory( ThePath : String );
procedure RecursivelyDeleteDirectory( ThePath : String );
procedure HandleRecursiveAction( StartingPath , NewPath : String;
ActionCode : Integer );
end;
implementation
{ deletes a single file }
procedure TFileWork.DeleteTheFile( ThePath : String );
var TheFile : File;
begin
{$I+}
try
AssignFile( TheFile , ThePath );
Erase( TheFile );
except
On E:EInOutError do
begin
HandleIOException( EOC_DELETEFILE , ExtractFileName( ThePath ), E.Message , E.ErrorCode );
end;
end;
end;
{ remove a directory }
procedure TFileWork.RemoveDirectory( ThePath : String );
begin
{$I+}
try
Rmdir( ThePath );
except
On E:EInOutError do
begin
HandleIOException( EOC_DELETEDIR , ExtractFileName( ThePath ) , E.Message , E.ErrorCode );
end;
end;
end;
{ This procedure handles recursively deleting an entire directory tree }
procedure TFileWork.RecursivelyDeleteDirectory( ThePath : String );
begin
HandleRecursiveAction( ThePath , '' , FAC_DELETE );
end;
procedure TFileWork.HandleRecursiveAction( StartingPath , NewPath : String;
ActionCode : Integer );
var
Finished : Boolean; { Loop flag }
TheSR : TSearchRec; { Searchrecord for FF/FN }
TheResult : Integer; { return variable }
TargetPath ,
TheWorkingDirectory ,
TheStoredWorkingDirectory ,
ModifiedDirectory : String; { path for FF/FN }
CdNewPath : String;
begin
{ Set up the initial variables }
Finished := false;
TheWorkingDirectory := StartingPath;
TheStoredWorkingDirectory := TheWorkingDirectory;
TheWorkingDirectory := TheWorkingDirectory + '*.*';
TargetPath := ExtractFilePath( TheWorkingDirectory );
TheResult := FindFirst( TheWorkingDirectory , faAnyFile , TheSR );
while not Finished do
begin
TheResult := FindNext( TheSR );
if TheResult <> 0 then finished := true else
begin
if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory )
<> faDirectory ) then
begin
DeleteTheFile( TargetPath + TheSR.Name );
end;
end;
end;
Finished := false;
ModifiedDirectory := TheStoredWorkingdirectory + '*.*';
TheResult := FindFirst( ModifiedDirectory , faDirectory , TheSR );
while not Finished do
begin
{ Make call to FindNext, using only SearchRecord from FindFirst }
TheResult := FindNext( TheSR );
{ A -1 result means no more files so exit }
if TheResult <> 0 then
finished := true
else
begin
if TheSR.Name <> '..' then
begin
if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory )
= faDirectory ) then
begin
ModifiedDirectory := TheStoredWorkingDirectory + '' +
TheSR.Name;
CdNewPath := NewPath;
NewPath := NewPath + TheSR.Name;
{ Do the recursive call }
HandleRecursiveAction( ModifiedDirectory , NewPath , ActionCode );
RemoveDirectory( TargetPath + TheSR.Name );
NewPath := CdNewPath;
end;
end;
end;
end;
end;
{ This procedure handles displaying a user-friendly Dialog box with a }
{ Message for Delphi IO exception errors. }
procedure TFileWork.HandleIOException( TheOpCode : Integer;
ThePath : String; TheMessage : String; TheCode : Integer );
var ErrorMessageString : String; { Holds internal data }
OperationString : String; { Holds internal data }
begin
{ clear to check for unrecognized code }
ErrorMessageString := '';
{ Check against imported code }
case TheCode of
2 : ErrorMessageString := 'File not found';
3 : ErrorMessageString := 'Path not found';
4 : ErrorMessageString := 'Too many open files';
5 : ErrorMessageString := 'File access denied';
6 : ErrorMessageString := 'Invalid file handle';
12 : ErrorMessageString := 'Invalid file access code';
15 : ErrorMessageString := 'Invalid drive number';
16 : ErrorMessageString := 'Cannot remove current directory';
17 : ErrorMessageString := 'Cannot rename across drives';
100 : ErrorMessageString := 'Disk read error';
101 : ErrorMessageString := 'Disk write error';
102 : ErrorMessageString := 'File not assigned';
103 : ErrorMessageString := 'File not open';
104 : ErrorMessageString := 'File not open for input';
105 : ErrorMessageString := 'File not open for output';
end;
case TheOpCode of
EOC_CHANGEDIR : OperationString := 'Unable to Change Directory due to ';
EOC_SOURCECOPY : OperationString := 'Unable to Copy due to Source File ';
EOC_DESTCOPY : OperationString := 'Unable to Copy due to Destination File ';
EOC_DELETEFILE : OperationString := 'Unable to Delete File due to ';
EOC_DELETEDIR : OperationString := 'Unable to Delete Directory due to ';
EOC_RENAMEFILE : OperationString := 'Unable to Rename File due to ';
EOC_MAKEDIR : OperationString := 'Unable to Create New Directory due to ';
EOC_SETATTR : OperationString := 'Unable to Set File Attributes due to ';
end;
{ If not recognized use message; not a DOS error; reset cursor for neatness }
if ErrorMessageString = '' then
begin
Screen.Cursor := crDefault;
MessageDlg( OperationString + ExtractFileName( ThePath ) + ' ' +
TheMessage , mtError , [mbOK],0);
end
else
begin
{ Recognized DOS exception, reset cursor for neatness }
Screen.Cursor := crDefault;
MessageDlg( OperationString + ExtractFileName( ThePath ) + ' ' +
ErrorMessageString , mtError , [mbOK], 0 );
end;
end;
end.
이 함수가 두군데 unit에 포함되어 있어서 문제가 발생한다고 합니다.(NT에서만)이 함수앞에 SysUtils.을 붙혀 주세요. 그리고 여기를 참고하셔요.
http://www.efg2.com/Lab/Library/Delphi/IO/Directories.htm