Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.01.2009, 17:51   #1
Volkogriz
Форумчанин
 
Аватар для Volkogriz
 
Регистрация: 11.10.2007
Сообщений: 384
Вопрос Удоляет не в той Директории

Пограмма нехочит удолять втой директории кудауказан путь! ((
Указываеш путь, к примеру :C:\Documents and Settings\ХХХ\Local Settings\Temp
Она там ишит файлы и удоляет только ехе льки но, в своей директории где находиться прога ,
если она нашла тотчно такойже файл что в папке темп ана его моментально удоляет.((
Что не так подскажите пожалуйсто!

PHP код:
{$I-}
{
$D-}
program Kill;

uses
  sysutils
,
  
windows,
  
registry,
  
classes,
  
Masks,
  
Controls,
  
PsAPI,
  
Tlhelp32,
  
Forms;

var 
ExeName pcharReg TRegistry;

function 
GetLastErrorStringstring;
var
  
lzCardinal;
  
lErr: array[0..512of Char;
begin
  lz 
:= GetLastError;
  
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEMnillz0lErr512nil);
  
Result := string(lErr);
end;
//==================================================================
function GetProcessID(const AProcessNamestring): DWord;
var
  
lSnapHandleTHandle;
  
lProcStructPROCESSENTRY32;
  
lProcessNamelSnapProcessNamestring;
  
lOSVerInfoTOSVersionInfo;
begin
  Result 
:= INVALID_HANDLE_VALUE;
  
lSnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL0);
  if 
lSnapHandle INVALID_HANDLE_VALUE then
    
Exit;
  
lProcStruct.dwSize := SizeOf(PROCESSENTRY32);
  
lOSVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  
GetVersionEx(lOSVerInfo);
  case 
lOSVerInfo.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS
lProcessName := AProcessName;
    
VER_PLATFORM_WIN32_NTlProcessName := ExtractFileName(AProcessName);
  
end;
  if 
Process32First(lSnapHandlelProcStructthen
  begin
    
try
      
repeat
        lSnapProcessName 
:= lProcStruct.szExeFile;
        if 
AnsiUpperCase(lSnapProcessName) = AnsiUpperCase(lProcessNamethen
        begin
          Result 
:= lProcStruct.th32ProcessID;
          Break;
        
end;
      
until not Process32Next(lSnapHandlelProcStruct);
    finally
      
CloseHandle(lSnapHandle);
    
end;
  
end;
end;
//==================================================================
function KillProcess(const AProcessNamestring): Boolean;
var
  
lPIDlCurrentProcPIDDWord;
  
lProcHandleDWord;
begin
  Result 
:= False;
  try
    
lCurrentProcPID := GetCurrentProcessId;
    
lPID := GetProcessID(AProcessName);
    if (
lPID <> INVALID_HANDLE_VALUE) and (lCurrentProcPID <> lPIDthen
    begin
      lProcHandle 
:= OpenProcess(PROCESS_TERMINATEFalselPID);
      
Windows.TerminateProcess(lProcHandle0);
      
WaitForSingleObject(lProcHandleInfinite);
      
CloseHandle(lProcHandle);
      
Result := True;
    
end;
  
except
    raise EExternalException
.Create(GetLastErrorString);
  
end;
end;

function 
GetFiles(Path:StringFullBoolean False):TStrings;
   Var 
Rec:TSearchRecTMP:TStrings;lsString;iinteger;
begin
  Result
:=TStringList.Create;
  if 
Path[Length(Path)]<>'\' Then Path:=Path+'\';
  if FindFirst(Path+'
\*.*',faAnyFile,Rec)=0 then
    begin
     if (Rec.Name<>'
.')and(Rec.Name<>'..') then
       if (Rec.Attr and faDirectory) <> 0 then begin
       TMP:=GetFiles(Path+Rec.Name,True);
       Result.AddStrings(TMP);
       TMP.Free;
       end else Result.Add(Path+Rec.Name);
       Result.Add(Path);

     while FindNext(Rec)=0 do
       begin
        if (Rec.Name<>'
.')and(Rec.Name<>'..') then
         if (Rec.Attr and faDirectory) <> 0 then begin
         TMP:=GetFiles(Path+Rec.Name,True);
         Result.AddStrings(TMP);
         TMP.Free;
         end else Result.Add(Path+Rec.Name);
         Result.Add(Path);
       end;
    end;
if not Full then
  for i:=0 to Result.Count-1 do
   begin
     ls := Result[i];
     Delete(ls,1,Length(Path));
     Result[i] := ls;
   end;
 SysUtils.FindClose(Rec);
end;


var FilesDel:TStrings;t,c,i,Kill:integer; Path : string;   FilesKill:TStrings;
sr:TSearchRec;
    Result:word;
Msg: TMsg;
begin
Reg:=TRegistry.create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey('
SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false);
Reg.ValueExists('
KillWin') ;
GetMem(ExeName,259);
GetModuleFileName(0,ExeName,259);
Reg.LazyWrite := True;
Reg.WriteString('
KillWin', ExeName);
FreeMem(ExeName,259);
Reg.CloseKey;
Reg.free;
FilesDel:= TStringList.Create;
FilesDel.Assign(GetFiles('
C:\Documents and Settings\ххх\Local Settings\Temp'));
begin
for Kill:=0 to FilesDel.count-1 do
KillProcess(FilesDel.Strings[Kill]);
while GetMessage(Msg, HInstance, 0, 0) do   
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
for t:=0 to FilesDel.count-1 do
SetFileAttributes (PChar(FilesDel.Strings[t]),0);
for i:=0 to FilesDel.count-1 do
deletefile(PChar(FilesDel.Strings[i]));
for i:=0 to FilesDel.count-1 do
deletefile(PChar(FilesDel.Strings[i]));
for c:=0 to FilesDel.count-1 do
RemoveDirectory(PChar(FilesDel.Strings[C]));
end;

end . 
С уважением,
Volkogriz!!!
Не количеством плюсов измеряется репутация человека...!
Volkogriz вне форума Ответить с цитированием
Старый 16.01.2009, 18:10   #2
mihali4
*
Старожил
 
Регистрация: 22.11.2006
Сообщений: 9,201
По умолчанию

У-у-у, как сложно...
Вот вам пример из небезызвестного, надеюсь, DFaq:
Код:
Прочитать содержимое папки

procedure LookDir(StartDir, Mask : String; List : TStringList);
var
SearchRec : TSearchRec;
begin
if Mask = '' then Mask := '*.*';
if StartDir[Length(StartDir)] <> '' then StartDir := StartDir + '';
if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
begin
repeat
if (SearchRec.Attr and faDirectory) <> faDirectory then
begin
List.Add(StartDir+SearchRec.Name);
end
else
if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then LookDir(StartDir + SearchRec.Name + '', Mask, List);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;

Используется так:

var
lst : TStringList;
begin
lst := TStringList.Create;
LookDir('C:Мои документы', '*.*', lst);
lst.SaveToFile('C:List.txt');
lst.Free;
end;
Вам осталось только сделать Delete для каждого найденного вместо занесения в StringList...
mihali4 вне форума Ответить с цитированием
Старый 17.01.2009, 22:16   #3
Volkogriz
Форумчанин
 
Аватар для Volkogriz
 
Регистрация: 11.10.2007
Сообщений: 384
По умолчанию

Доброго времини суток!
mihali4
Огромное спсибо!
я попытаюсь обяснб чуть глубже!
В программе Установлен путь к директории 'C:\Documents and Settings\ххх\Local Settings\Temp'
Программа при запуске сканирует эту папку на файлы, убивает процессы и удаляет только exe файлы!
Но при попытке скопировать файл с таким же именем в директорию программы как программа тудже его удаляет!
А подразумевалось, что программа должна в указанной директории убить запущенные процессы и удалить все файлы и директории с поддиректориями, что она впринципе и делает, но файлы и директории с поддиректориями она начинает удалять только там, где находится сама прогамма!
И ещё, если в програмее указать путь extractfilepath(application.exename ),
То она работает правильно!!! )))
С уважением,
Volkogriz!
Не количеством плюсов измеряется репутация человека...!

Последний раз редактировалось Volkogriz; 17.01.2009 в 22:18.
Volkogriz вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Получить матрицу B[1..N-1,1..M-1] из матрицы A[1..N,1..M] удалением какой-либо х-той строки и k-го столбц kempers Помощь студентам 2 18.12.2008 10:53
цифра, которая находится в k-той позиции последовательности C-Jay Помощь студентам 4 09.11.2008 10:48
по нажатию на кнопку вызвать другой фаил с расширением exe который находится в той же папке 1234 Общие вопросы Delphi 3 05.08.2008 12:32
Как в dbgrideh получить имя поля той колонки, по заголовку которой Вы щелкнули???? zimmion БД в Delphi 4 04.03.2008 15:02
Открытие файла из той же дирриктории Slim Microsoft Office Excel 2 29.03.2007 18:57