Форум: "Основная";
Текущий архив: 2002.11.04;
Скачать: [xml.tar.bz2];

Вниз

Помогите совместить два исходника в один.   Найти похожие ветки 

← →
Lizard   (2002-10-22 20:17) [0]

Прогу, удаляющую каталоги со всем содержимым надо объединить с прогой, удаляющей файлы по принципу WipeInfo. Т.е. сделать прогу,
удаляющую каталог со всем содержимым по принципу нортоновского wipeinfo.

------1-я прога { Удалить каталог со всем содержимым }--------

function DeleteDir(Dir : string) : boolean;
Var
Found : integer;
SearchRec : TSearchRec;
begin result:=false;
if IOResult<>0 then ;
ChDir(Dir);
if IOResult<>0 then
begin
ShowMessage("Не могу войти в каталог: "+Dir);
exit;
end;
Found := FindFirst("*.*", faAnyFile, SearchRec);
while Found = 0 do
begin
if (SearchRec.Name<>".")and(SearchRec.Name<>"..") then
if (SearchRec.Attr and faDirectory)<>0 then
begin
if not DeleteDir(SearchRec.Name) then exit;
end
else
if not DeleteFile(SearchRec.Name) then
begin
ShowMessage("Не могу удалить файл: "+SearchRec.Name);
exit;
end;
Found := FindNext(SearchRec);
end;
FindClose(SearchRec);
ChDir("..");
RmDir(Dir);
result:=IOResult=0;
end;


---------2-ая прога WipeInfo -------------------------

procedure WipeFile(FileName: string);
var
buffer: array [0..4095] of Byte;
max, n: LongInt;
i: Integer;
fs: TFileStream;

procedure RandomizeBuffer;
var
i: Integer;
begin
for i := Low(buffer) to High(buffer) do
buffer[i] := Random(256);
end;
begin
fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);
try
for i := 1 to 3 do
begin
RandomizeBuffer;
max := fs.Size;
fs.Position := 0;
while max > 0 do
begin
if max=SizeOf(buffer) then
n := SizeOf(buffer)
else
n := max;
fs.Write(Buffer, n);
max := max - n;
end;
FlushFileBuffers(fs.Handle);
end;
finally
fs.Free;
end;
Deletefile(FileName);
end;

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

Большое спасибо всем кто откликнется.

---

← →
Jeer   (2002-10-22 20:32) [1]

Совсем так плохо ?

if not DeleteFile(SearchRec.Name) then

== WipeFile(SearchRec.Name);

---

← →
Lizard   (2002-10-22 20:40) [2]

Не получается так.

---

← →
Jeer   (2002-10-22 20:42) [3]

Как ?

---

← →
TTCustomDelphiMaster   (2002-10-22 20:46) [4]

В первой программе

if not DeleteFile(SearchRec.Name) then
заменить на
if not WipeFile(SearchRec.Name) then


Во второй программе

procedure WipeFile(FileName: string);
заменить на
function WipeFile(FileName: string): boolean;

fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);
заменить на
Result := False;
fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);

fs.Free;
end;
Deletefile(FileName);
заменить на
fs.Free;
end;
Result := Deletefile(FileName);

---

← →
Lizard   (2002-10-22 21:04) [5]

Если я правильно понял, то должно получиться что-то вроде этого:

function WipeFile(FileName: string): boolean;

var
buffer: array [0..4095] of Byte;
max, n: LongInt;
i: Integer;
fs: TFileStream;

procedure RandomizeBuffer;
var
i: Integer;
begin
for i := Low(buffer) to High(buffer) do
buffer[i] := Random(256);
end;
begin
Result := False;
fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);
try
for i := 1 to 3 do
begin
RandomizeBuffer;
max := fs.Size;
fs.Position := 0;
while max > 0 do
begin
if max=SizeOf(buffer) then
n := SizeOf(buffer)
else
n := max;
fs.Write(Buffer, n);
max := max - n;
end;
FlushFileBuffers(fs.Handle);
end;
finally
fs.Free;
end;
Result := Deletefile(FileName);
end;



function DeleteDir(Dir : string) : boolean;
Var
Found : integer;
SearchRec : TSearchRec;
begin result:=false;
if IOResult<>0 then ;
ChDir(Dir);
if IOResult<>0 then
begin
ShowMessage("Не могу войти в каталог: "+Dir);
exit;
end;
Found := FindFirst("*.*", faAnyFile, SearchRec);
while Found = 0 do
begin
if (SearchRec.Name<>".")and(SearchRec.Name<>"..") then
if (SearchRec.Attr and faDirectory)<>0 then
begin
if not DeleteDir(SearchRec.Name) then exit;
end
else
if not wipeFile(SearchRec.Name) then
begin
ShowMessage("Не могу удалить файл: "+SearchRec.Name);
exit;
end;
Found := FindNext(SearchRec);
end;
FindClose(SearchRec);
ChDir("..");
RmDir(Dir);
result:=IOResult=0;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
wipefile("folder\");
end;



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

Все компилируется, но прога выдает сообщение Cannot open file.

---

← →
TTCustomDelphiMaster   (2002-10-22 21:55) [6]

try
fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);
try
for i := 1 to 3 do
begin
RandomizeBuffer;
max := fs.Size;
fs.Position := 0;
while max > 0 do
begin
if max=SizeOf(buffer) then
n := SizeOf(buffer)
else
n := max;
fs.Write(Buffer, n);
max := max - n;
end;
FlushFileBuffers(fs.Handle);
end;
finally
fs.Free;
end;
except
end;

---

← →
Jeer   (2002-10-22 21:59) [7]

Маладец..
Все готово для ^C + ^V

---

← →
Lizard   (2002-10-23 10:23) [8]

Я извиняюсь, мужики, но опять не работает.

---

← →
Lizard   (2002-10-23 11:15) [9]

Please, ну очень надо.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.11.04;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.01 c