Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.01.06;
Скачать: CL | DM;

Вниз

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

 
Lizard   (2002-10-23 11:31) [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;

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

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


 
Opuhshii ©   (2002-10-23 14:33) [1]

;) Вот народ пошел,.. Копи-Пасте Программист ,.. даже писать уже лень!


 
Lizard   (2002-10-24 20:54) [2]

Да в том-то все и дело, что просто копи-пасте не получится.
Я ж помочь прошу, а ты ругаться.


 
AlexKniga ©   (2002-10-24 21:05) [3]

2 Lizard
В чем проблема то?


 
Lizard   (2002-10-24 21:34) [4]

Проблема в том, что не могу никак нормально совместить эти исходники, чтобы прога работала. Мне нужно из этого барахла собрать один исходник и скомпилировать его. Хотелось чтобы все это еще и работало. Т.е. сделать прогу,
удаляющую каталог со всем содержимым по принципу нортоновского wipeinfo.


 
Lizard   (2002-10-26 14:32) [5]

Ну неужели никто не знает как это сделать ?


 
Anatoly Podgoretsky ©   (2002-10-26 14:48) [6]

Да copy/paste


 
Pumpkin   (2002-10-26 15:06) [7]

Полный Copy-Paste :)
Внутри DeleteDir вместо DeleteFile поставь WipeFile.


 
Lizard   (2002-10-27 20:22) [8]

Да ёкраный бабай, ну пробовал так, ну ни фига не выходит.
Если все так просто, попробуйте потом скомпилировать ваше детище.


 
Pumpkin ©   (2002-10-27 21:57) [9]

Во-первых это не наше детище, а твое.
Во-вторых надо было сделать пару мелких поправок.
В-третьих лови:


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;
Result := True;
finally
fs.Free;
end;
if Result then Result := DeleteFile(FileName);
end;

function DeleteDir(Dir: String): boolean;
var
Found : integer;
SearchRec : TSearchRec;
begin
result:=false;
//if IOResult<>0 then ;
{$I-}
ChDir(Dir);
{$I+}
if IOResult <> 0 then begin
ShowMessage("


 
Pumpkin ©   (2002-10-27 22:08) [10]

Сорри, в 11-й строчке с конца вместо
if not DeleteFile(SearchRec.Name) then begin
нужно
if not WipeFile(SearchRec.Name) then begin



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

Текущий архив: 2003.01.06;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.015 c
1-15105
VitGun
2002-12-22 21:30
2003.01.06
Скан-код


8-15163
Pavel_s
2002-09-19 09:08
2003.01.06
TImage


1-14974
ruslanyd
2002-12-18 15:56
2003.01.06
MDI Child ShowModal


1-15021
izhalex
2002-12-24 14:59
2003.01.06
курсор в Memo


14-15256
VictorT
2002-10-25 20:20
2003.01.06
Халявный хостинг