Hej !
Jeg har selv fundte en løsning, der kører på (alle gængse Win-platforme,
indtil nu) dog ikke Linux, mener jeg ikke
Enjoy
/Alex
function TTeleEmail.DelTree(const Directory: string; Progress: boolean =
true;
Undo: boolean = true; Confirm: boolean = false): boolean;
const
ProgressFlag: array[boolean] of cardinal = (0, FOF_SILENT);
UndoFlag: array[boolean] of cardinal = (0, FOF_ALLOWUNDO);
ConfirmFlag: array[boolean] of cardinal = (FOF_NOCONFIRMATION, 0);
var
sfo: TSHFileOpStruct;
begin
FillChar(sfo, sizeof(sfo), 0);
sfo.wFunc:= FO_DELETE;
sfo.pFrom:= PChar(Directory);
sfo.fFlags:= ProgressFlag[Progress] or UndoFlag[Undo] or
ConfirmFlag[Confirm];
result:= SHFileOperation(sfo) = 0;
end;
"Alex B. P." <alexbp@post.tele.dk> wrote in message
news:3e5e2aec$0$4291$edfadb0f@dread14.news.tele.dk...
> Jeg vedlægger lige den function, som kalder min DelTree procedure ...
> -----------------------------------------------------------------------
>
> function TTeleEmail.ClearMailFolders():Boolean;
> Begin
> // Result := FALSE;Removed by Helle
>
> DeleteFile(CurrentDir + '\' + InFileFolder + '\' + '*.*');
> DeleteFile(CurrentDir + '\' + OutFileFolder + '\' + '*.*');
> DeleteFile(CurrentDir + '\' + TempFileFolder + '\' + '*.*');
>
> /// Rem'et ud indtil der findes en ikke OS-afhængig DelTree metode ...
>
> DelTree(CurrentDir + '\' + InFileFolder);
> DelTree(CurrentDir + '\' + OutFileFolder);
> DelTree(CurrentDir + '\' + TempFileFolder);
>
> if not DirectoryExists(CurrentDir + '\' + InFileFolder) then
> if not CreateDir(CurrentDir + '\' + InFileFolder) then
> raise Exception.Create('Cannot create :' + CurrentDir + '\' +
> InFileFolder);
>
> if not DirectoryExists(CurrentDir + '\' + OutFileFolder) then
> if not CreateDir(CurrentDir + '\' + OutFileFolder) then
> raise Exception.Create('Cannot create :' + CurrentDir + '\' +
> OutFileFolder);
>
> if not DirectoryExists(CurrentDir + '\' + TempFileFolder) then
> if not CreateDir(CurrentDir + '\' + TempFileFolder) then
> raise Exception.Create('Cannot create :' + CurrentDir + '\' +
> TempFileFolder);
>
>
> Result := TRUE;
>
> end;
>
> --------------------------------------------------------------------------
--
> -------------
> "Alex B. P." <alexbp@post.tele.dk> wrote in message
> news:3e5e29f3$0$4299$edfadb0f@dread14.news.tele.dk...
> > Hej !
> >
> > Har I en køreklar DelTree metode, som ikke af afhængig af
operativ-system,
> > bortset fra WIN32 naturligvis, hehe ???
> >
> > Forklaring:
> > --------------
> >
> > Følgende kode virker fint på Win9x/NT/2000 men compileren giver en hint,
> om
> > at:
> >
> > [Warning] TeleEmail01.pas(410): Symbol 'faVolumeID' is specific to a
> > platform
> > [Warning] TeleEmail01.pas(414): Symbol 'FindData' is specific to a
> platform
> > [Warning] TeleEmail01.pas(417): Symbol 'FindData' is specific to a
> platform
> >
> > <snip>
> >
> > og ved kørsel og compilering på WinXP Pro fejler det, med en access
> > violation på ...
> >
> > GetShortPath ... -> giver volapyk, og len = 0
> >
>
> --------------------------------------------------------------------------
> --
> > ----------------
> > procedure TTeleEmail.DelTree(const Directory: TFileName);
> > var
> > DrivesPathsBuff: array[0..1024] of char;
> > DrivesPaths: string;
> > len: longword;
> > ShortPath: array[0..MAX_PATH] of char;
> > dir: TFileName;
> > procedure rDelTree(const Directory: TFileName);
> > // Recursively deletes all files and directories
> > // inside the directory passed as parameter.
> > var
> > SearchRec: TSearchRec;
> > Attributes: LongWord;
> > ShortName, FullName: TFileName;
> > pname: pchar;
> > begin
> > if FindFirst(Directory + '*', faAnyFile and not faVolumeID,
> > SearchRec) = 0 then begin
> > try
> > repeat // Processes all files and directories
> > if SearchRec.FindData.cAlternateFileName[0] = #0 then
> > ShortName := SearchRec.Name
> > else
> > ShortName := SearchRec.FindData.cAlternateFileName;
> > FullName := Directory + ShortName;
> > if (SearchRec.Attr and faDirectory) <> 0 then begin
> > // It's a directory
> > if (ShortName <> '.') and (ShortName <> '..') then
> > rDelTree(FullName + '\');
> > end else begin
> > // It's a file
> > pname := PChar(FullName);
> > Attributes := GetFileAttributes(pname);
> > if Attributes = $FFFFFFFF then
> > raise EInOutError.Create(SysErrorMessage(GetLastError));
> > if (Attributes and FILE_ATTRIBUTE_READONLY) <> 0 then
> > SetFileAttributes(pname, Attributes and not
> > FILE_ATTRIBUTE_READONLY);
> > if Windows.DeleteFile(pname) = False then
> > raise EInOutError.Create(SysErrorMessage(GetLastError));
> > end;
> > until FindNext(SearchRec) <> 0;
> > except
> > FindClose(SearchRec);
> > raise;
> > end;
> > FindClose(SearchRec);
> > end;
> > if Pos(#0 + Directory + #0, DrivesPaths) = 0 then begin
> > // if not a root directory, remove it
> > pname := PChar(Directory);
> > Attributes := GetFileAttributes(pname);
> > if Attributes = $FFFFFFFF then
> > raise EInOutError.Create(SysErrorMessage(GetLastError));
> > if (Attributes and FILE_ATTRIBUTE_READONLY) <> 0 then
> > SetFileAttributes(pname, Attributes and not
> > FILE_ATTRIBUTE_READONLY);
> > if Windows.RemoveDirectory(pname) = False then begin
> > raise EInOutError.Create(SysErrorMessage(GetLastError));
> > end;
> > end;
> > end;
> > // ----------------
> > begin
> > DrivesPathsBuff[0] := #0;
> > len := GetLogicalDriveStrings(1022, @DrivesPathsBuff[1]);
> > if len = 0 then
> > raise EInOutError.Create(SysErrorMessage(GetLastError));
> > SetString(DrivesPaths, DrivesPathsBuff, len + 1);
> > DrivesPaths := Uppercase(DrivesPaths);
> > len := GetShortPathName(PChar(Directory), ShortPath, MAX_PATH);
> > if len = 0 then
> > raise EInOutError.Create(SysErrorMessage(GetLastError));
> > SetString(dir, ShortPath, len);
> > dir := Uppercase(dir);
> > //rDelTree(IncludeTrailingBackslash(dir)); Removed by Helle
> > rDelTree(IncludeTrailingPathDelimiter(dir));
> > end;
> >
> > Mvh
> >
> > Alex B. Pedersen
> >
> >
>
>