Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Система";
Текущий архив: 2003.01.06;
Скачать: [xml.tar.bz2];

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.008 c
7-15320
Дмитрий К.К.
2002-10-25 15:58
2003.01.06
Добавить в избранное: Opera


14-15287
^Sanya
2002-12-17 21:24
2003.01.06
У кого-нибудь стоит радио-интернет?


3-14901
mama
2002-12-07 07:19
2003.01.06
индекс пропадает...


6-15185
RETAND
2002-11-05 23:34
2003.01.06
ClientSocket стучиться на ServerSocket, как реализовать??


3-14953
Dmitry Bessonov
2002-12-14 16:10
2003.01.06
Jpeg в БД





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский