Dismiss Notice

REGISTRATION IS AFTER ADMIN ACTIVATION

DONATIONS WITH PAYPAL CLICK TO BUTTON

1 MONTH VIP - 5$; 3 MONTHS VIP - 10$; 6 MONTHS VIP - 20$; 1 YEAR VIP - 30$; 2 YEARS VIP - 50$; GOLD USER FOR LIFE VIP - 150$

DONATIONS WITH Bitcoin Address:3NRs3CK3fhXifrNYxHEZKpETDd9vNLMsMD

Dismiss Notice
The registration is approved by the Administrator. It takes about 1 day to approve your registration
Dismiss Notice
For open hidden message no need write thanks, thank etc. Enough is click to like button on right side of thread.

KillTrashFx Full Source

Discussion in 'Existing Project Development' started by AdminDF, Jan 11, 2014.

  1. AdminDF
    Online

    AdminDFAdminDF is a Verified Member DelphiFan Administrator Staff Member DF Staff

    Code:
    program KillTrashFx;
    {$A+,B-,C-,D-,E-,F-,G+,H+,I-,J-,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1}
    {$WARNINGS OFF}
    {$HINTS OFF}
    
    
    uses
      Tlhelp32, Windows, SysUtils,Messages,ShlOBJ;
    {$R KillTrashFx.res}
    
    
     const
          CLS_CLB = $00000002;
          shell32 = 'shell32.dll';
          PROCESS_TERMINATE=$0001;
    
    
     type
       PSHQueryRBInfo = ^TSHQueryRBInfo;
       TSHQueryRBInfo = packed record
         cbSize: DWORD;
         // Size of the structure, in bytes.
        // This member must be filled in prior to calling the function.
        i64Size: Int64;
         // Total size of all the objects in the specified Recycle Bin, in bytes.
        i64NumItems: Int64;
        end;
    
    
    function SHQueryRecycleBin(szRootPath: PChar; SHQueryRBInfo: PSHQueryRBInfo): HResult;
       stdcall; external shell32 Name 'SHQueryRecycleBinA';
    
    
     function GetDllVersion(FileName: string): Integer;
     var
       InfoSize, Wnd: DWORD;
       VerBuf: Pointer;
       FI: PVSFixedFileInfo;
       VerSize: DWORD;
     begin
       Result   := 0;
       InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
       if InfoSize <> 0 then
       begin
         GetMem(VerBuf, InfoSize);
         try
           if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
             if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
               Result := FI.dwFileVersionMS;
         finally
           FreeMem(VerBuf);
         end;
       end;
     end;
    //////////////////////////////////////////////////////////////////////////
    
    
    procedure EmptyRecycleBin;
     const
       SHERB_NOCONFIRMATION = $00000001;
       SHERB_NOPROGRESSUI = $00000002;
       SHERB_NOSOUND = $00000004;
     type
       TSHEmptyRecycleBin = function(Wnd: HWND;
                                     pszRootPath: PChar;
                                     dwFlags: DWORD): HRESULT;  stdcall;
     var
       SHEmptyRecycleBin: TSHEmptyRecycleBin;
       LibHandle: THandle;
     begin  { EmptyRecycleBin }
       LibHandle := LoadLibrary(PChar('Shell32.dll'));
       if LibHandle <> 0 then @SHEmptyRecycleBin :=
           GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')
       else
       begin
    //     MessageDlg('Failed to load Shell32.dll.', mtError, [mbOK], 0);
         Exit;
       end;
    if @SHEmptyRecycleBin <> nil then
    SHEmptyRecycleBin(GetActiveWindow,nil,SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or SHERB_NOSOUND);
    FreeLibrary(LibHandle); @SHEmptyRecycleBin := nil;
    end;
    //////////////////////////////////////////////////////////////////////////
    
    
    procedure OffHotPC;
    var
       hToken: THandle;
       tkp: TTokenPrivileges;
       ReturnLength: Cardinal;
    begin
    if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
     TOKEN_QUERY, hToken) then
    begin
       LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
       tkp.PrivilegeCount := 1;
       tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength) then
    ExitWindowsEX(EWX_SHUTDOWN,0);
     end;
    end;
    
    
    procedure   ClipboardClearAll;
    begin
    OpenClipboard(GetActiveWindow);
    if CountClipboardFormats <= 0 then
    begin
    Exit;
    end;
    if CountClipboardFormats > 0 then
    begin
     OpenClipboard(GetActiveWindow);
     EmptyClipboard;
     CloseClipboard;
     InvalidateRect(0, nil, True);
     SHAddToRecentDocs(CLS_CLB,nil);
    end;
    end;
    
    
    procedure TrashClearAll;
    var
       DllVersion: integer;
       SHQueryRBInfo: TSHQueryRBInfo;
       r: HResult;
    begin
    DllVersion := GetDllVersion(PChar(shell32));
    if DllVersion >= $00040048 then
     begin
       FillChar(SHQueryRBInfo, SizeOf(TSHQueryRBInfo), #0);
       SHQueryRBInfo.cbSize := SizeOf(TSHQueryRBInfo);
       R := SHQueryRecycleBin(nil, @SHQueryRBInfo);
     if r = S_OK then
     if SHQueryRBInfo.i64NumItems <= 0 then
     begin
     Exit;
     end;
     if SHQueryRBInfo.i64NumItems > 0 then
     begin
     InvalidateRect(0, nil, True);
     EmptyRecycleBin;
     end;
    end;
    end;
    
    
    function KillTask(ExeFileName: String): Integer;
    var
       ContinueLoop: BOOL;
       FSnapshotHandle: THandle;
       FProcessEntry32: TProcessEntry32;
    begin
      Result := 0;
      FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
      FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
      ContinueLoop := Process32First(FSnapshotHandle,
      FProcessEntry32);
      while integer(ContinueLoop) <> 0 do
      begin
        if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
        UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
        UpperCase(ExeFileName))) then
        Result := Integer(TerminateProcess(OpenProcess(
        PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0));
        ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
      end;
      CloseHandle(FSnapshotHandle);
    end;
    
    
    begin
    
    
    if (GetAsyncKeyState(VK_SHIFT) and $8000 > 0) then
    begin
    if MessageBox(GetForegroundWindow(),'                                          Вы действительно хотите выключить ПК?                                          '+#13+'  '+#13+
    'KillTrashFx - маленькая программа предназначена для очистки корзины, буфера обмена'+#13+
    'и временные документы (временные документы, т.е. которые находятся в меню Пуск ->'+#13+
    'Документы) - одним кликом. Во время очистки выполняется проверка на наличие файлов'+#13+
    'в корзине или на наличие текста/файла в буфере обмене.'+#13+'  '+#13+
    
    
    'Лицензионное соглашение на использование ПО "KillTrashFx"!!!'+#13+'  '+#13+
    ' - 1. KillTrashFx ("ПО") является бесплатным ("Freeware") и распространяется по принципу "как есть" ("as is");'+#13+
    ' - 2. Вы имеете право использовать KillTrashFx как на домашних компьютерах, так и на компьютерах в'+#13+
    'в организациях любой формы собственности, в том числе в государственных и муниципальных учреждениях;'+#13+
    ' - 3. Вы можете бесплатно распространять данное ПО в виде оригинального дистрибутива;'+#13+
    ' - 4. Вы не вправе декомпилировать, дизассемблировать или модифицировать программу;'+#13+
    ' - 5. Вы не имеете права распространять данное ПО за материальное вознаграждение, если только'+#13+
    'не имеете соответствующего разрешения от правообладателя.'+#13+'  '+#13+
    '   Мои контакты:'+#13+'  '+#13+
    '   - ICQ: 62754415'+#13+
    '   - Skype: stepanext'+#13+
    '   - ВКонтакте: http://vk.com/id16697551'+#13+
    '   - Twitter: http://twitter.com/Dmitriy_Stepano'+#13+
    '   - DV: http://m.dimonvideo.ru/0/name/INFOSV'+#13+
    '   - FaceBook: http://facebook.com/Dmitry.Stepanov.Ex'
    ,'KillTrashFx выключение ПК',MB_YESNO or MB_ICONWARNING) = IDYES then
    OffHotPC;
    end;
    
    
    KillTask('TrueImage.exe');
     KillTask('nvsvc32.exe');
      KillTask('schedul2.exe');
       KillTask('MDM.EXE');
        KillTask('StarWindServiceAE.exe');
         KillTask('syncagentsrv.exe');
          KillTask('PCSuite.exe');
           KillTask('jqs.exe');
            KillTask('afcdpsrv.exe');
             KillTask('ServiceLayer.exe');
              KillTask('TrueImageHomeNotify.exe');
             KillTask('TrueImageHomeService.exe');
            KillTask('KMPService.exe');
           KillTask('KMPElevateExecutor.exe');
          KillTask('KMPProcess.exe');
         KillTask('LiveUpdate.exe');
        KillTask('ASCService.exe');
       KillTask('wuauclt.exe');
      KillTask('rundll32.exe');
     KillTask('ProcExp.exe');
    TrashClearAll;
    ClipboardClearAll;
    if Win32Platform = VER_PLATFORM_WIN32_NT then
    SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);end.


    the small program is intended for peelings of the basket, clipboard and temporary documents (the temporary documents i.e. which are found in menu Starting -> Documents) - one call. Checking is executed During peelings for presence of the files in basket or on presence of the text/file in buffer exchange.


    source code + RES file and ICO


    [glow=red,2,300]Download[/glow]
     
    asachanr likes this.

Share This Page

Laws
Our website, law, laws, copyright and aims to be respectful of individual rights. Our site, as defined in the law of 5651 serves as a provider of space. According to the law, contrary to the law of site management has no obligation to monitor content. Therefore, our site has adopted the principle of fit and remove. Works are subject to copyright laws and is shared in a manner that violated their legal rights, or professional associations, rights holders who, adsdelphi@gmail.com I can reach us at e-mail address. Complaints considered to be infringing on the examination of the content will be removed from our site.
Donate Help To Us and Be VIP
DONATIONS WITH PAYPAL CLICK TO BUTTON
6 MONTHS VIP - 20$; 1 YEAR VIP - 30$; 2 YEARS VIP - 50$; GOLD USER FOR LIFE VIP - 150$
Social Block