Показать сообщение отдельно

Antivirus Detector v0.3[Beta] (Delphi Module)
  #27  
Старый 24.02.2010, 14:47
Fliplab
Участник форума
Регистрация: 29.07.2008
Сообщений: 128
С нами: 9360320

Репутация: 34
По умолчанию Antivirus Detector v0.3[Beta] (Delphi Module)

Код:
function IsService(const ServiceName: String): Boolean;
type
  _SERVICE_STATUS = record
    dwServiceType: DWORD;
    dwCurrentState: DWORD;
    dwControlsAccepted: DWORD;
    dwWin32ExitCode: DWORD;
    dwServiceSpecificExitCode: DWORD;
    dwCheckPoint: DWORD;
    dwWaitHint: DWORD;
  end;
  SERVICE_STATUS = _SERVICE_STATUS;
  PENUM_SERVICE_STATUS = ^ENUM_SERVICE_STATUS;
  ENUM_SERVICE_STATUS = packed record
    lpServiceName : PChar;
    lpDisplayName : PChar;
    ServiceStatus : SERVICE_STATUS;
  end;
  TcsEnumServicesStatus = function(
    const hSCManager         : DWord;                // handle to SCM database
    const dwServiceType      : DWord;                // service type
    const dwServiceState     : DWord;                // service state
    const lpServices         : PENUM_SERVICE_STATUS; // status buffer
    const cbBufSize          : DWord;                // size of status buffer
    const pcbBytesNeeded     : PDWORD;               // buffer size needed
    const lpServicesReturned : PDWord;               // number of entries returned
    const lpResumeHandle     : PDWord                // next entry
    ): Boolean; stdcall;
  TcsOpenSCManager = function(
    const lpMachineName   : PChar;
    const lpDatabaseName  : PChar;
    const dwDesiredAccess : DWord
    ): DWord; stdcall;
var
  EnumServicesStatus: TcsEnumServicesStatus;
  OpenSCManager: TcsOpenSCManager;
  hSC, hLib: Cardinal;
  pStatus: PENUM_SERVICE_STATUS;
  pWork: PENUM_SERVICE_STATUS;
  cbBufSize: DWord;
  pcbBytesNeeded: DWord;
  lpServicesReturned: DWord;
  lpResumeHandle: DWord;
  i: Integer;
  s, s1: String;
begin
  Result := False;
  hLib := LoadLibrary('ADVAPI32.DLL');
  if hLib <> 0 then
    begin
      @EnumServicesStatus := GetProcAddress(hLib, 'EnumServicesStatusA');
      if @EnumServicesStatus = nil then
        Exit;
      @OpenSCManager := GetProcAddress(hLib, 'OpenSCManagerA');
      if @OpenSCManager = nil then
        Exit;
    end;
  hSC := OpenSCManager(nil, nil, $0004);
  if hSC <> 0 then
    try
      cbBufSize := 0;
      pStatus := nil;
      lpResumeHandle := 0;
      EnumServicesStatus(hSC, SERVICE_WIN32, SERVICE_STATE_ALL, pStatus,
        cbBufSize, @pcbBytesNeeded, @lpServicesReturned, @lpResumeHandle);
      pStatus := AllocMem(pcbBytesNeeded);
      try
        cbBufSize := pcbBytesNeeded;
        EnumServicesStatus(hSC, SERVICE_WIN32, SERVICE_STATE_ALL, pStatus,
          cbBufSize, @pcbBytesNeeded, @lpServicesReturned, @lpResumeHandle);
        pWork := pStatus;
        for i := 0 to lpServicesReturned - 1 do
          begin
            s := pWork.lpServiceName;
            s1 := pWork.lpDisplayName;
            if (UpperCase(ServiceName) = UpperCase(s)) or (UpperCase(ServiceName) = UpperCase(s1)) then
              begin
                Result := True;
                Exit;
              end;
            Inc(pWork);
          end;
      finally
        if Assigned(pStatus) then
          FreeMem(pStatus, pcbBytesNeeded);
      end;
    finally
      CloseServiceHandle(hSC);
    end;
  if hLib <> 0 then
    FreeLibrary(hLib);
end;

function IsProcess(const ProcessName: String): Boolean;
type
  tagPROCESSENTRY32 = packed record
    dwSize: DWORD;
    cntUsage: DWORD;
    th32ProcessID: DWORD;       // this process
    th32DefaultHeapID: DWORD;
    th32ModuleID: DWORD;        // associated exe
    cntThreads: DWORD;
    th32ParentProcessID: DWORD; // this process's parent process
    pcPriClassBase: Longint;    // Base priority of process's threads
    dwFlags: DWORD;
    szExeFile: array[0..MAX_PATH - 1] of Char;// Path
  end;
  TProcessEntry32 = tagPROCESSENTRY32;
var
  CreateToolhelp32Snapshot: function(dwFlags, th32ProcessID: DWORD): THandle; cdecl;
  Process32First: function(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; cdecl;
  Process32Next: function (hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; cdecl;
  ProcessEntry: TProcessEntry32;
  SHandle: THandle;
  Next: Boolean;
  Handles: Integer;
  ExeFile: String;
begin
  Result := False;
  ProcessEntry.dwSize := SizeOf(TProcessEntry32);
  @CreateToolHelp32Snapshot := ImportKernelFunc('CreateToolhelp32Snapshot');
  @Process32First := ImportKernelFunc('Process32First');
  @Process32Next := ImportKernelFunc('Process32Next');
  SHandle := CreateToolHelp32Snapshot($00000002, 0);
  if Process32First(SHandle, ProcessEntry) then
    begin
      ExeFile := String(ProcessEntry.szExeFile);
      if UpperCase(ExeFile) = UpperCase(ProcessName) then
        begin
          Result := True;
          Exit;
        end;
      repeat
        Next := Process32Next(SHandle, ProcessEntry);
        if UpperCase(ExeFile) = UpperCase(ProcessName) then
          begin
            Result := True;
            Exit;
          end;
      until not Next;
    end;
  CloseHandle(SHandle);
end;

function IsUninstall(const ProgramName: String): Boolean;
var
  Str, MBuf, DisplayName: String;
    function RegEnum(RootKey: HKEY; Name: String; var ResultList: String; const DoKeys: Boolean): Boolean;
  var
    I, iRes: Integer;
    S: String;
    hTemp: HKEY;
    Buf: Pointer;
    BufSize: Cardinal;
  begin
    Result := False;
    ResultList := '';
    if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
      begin
        Result := True;
        BufSize := 1024;
        GetMem(buf, BufSize);
        I := 0;
        iRes := ERROR_SUCCESS;
        while iRes = ERROR_SUCCESS do
          begin
            BufSize := 1024;
            if DoKeys then
              iRes := RegEnumKeyEx(hTemp, I, buf, BufSize, nil, nil, nil, nil)
            else
              iRes := RegEnumValue(hTemp, I, buf, BufSize, nil, nil, nil, nil);
            if iRes = ERROR_SUCCESS then
              begin
                SetLength(S, BufSize);
                Move(buf^, S[1], BufSize);
                ResultList := Concat(S, #13#10, ResultList);
                Inc(i);
              end;
          end;
        FreeMem(Buf);
        RegCloseKey(hTemp);
      end;
  end;
  function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): Boolean;
  begin
    Result := RegEnum(RootKey, Name, KeyList, True);
  end;
  function LastPos(Needle: Char; Haystack: String): Integer;
  begin
    for Result := Length(Haystack) downto 1 do
      if Haystack[Result] = Needle then
        Break;
  end;
  function RegValueExists(RootKey: HKEY; Name: String): Boolean;
  var
    SubKey: String;
    n: Integer;
    hTemp: HKEY;
  begin
    Result := False;
    n := LastPos('\', Name);
    if n > 0 then
      begin
        SubKey := Copy(Name, 1, n - 1);
        if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
          begin
            SubKey := Copy(Name, n + 1, Length(Name) - n);
            Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) = ERROR_SUCCESS);
            RegCloseKey(hTemp);
          end;
      end;
  end;
  function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer; var ValSize: Cardinal): Boolean;
  var
    SubKey: String;
    n: Integer;
    MyValType: DWORD;
    hTemp: HKEY;
    Buf: Pointer;
    BufSize: Cardinal;
    PKey: PChar;
  begin
    Result := False;
    n := LastPos('\', Name);
    if n > 0 then
      begin
        SubKey := Copy(Name, 1, n - 1);
        if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
          begin
            SubKey := Copy(Name, n + 1, Length(Name) - n);
            if SubKey = '' then
              PKey := nil
            else
              PKey := PChar(SubKey);
            if RegQueryValueEx(hTemp, PKey, nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then
              begin
                GetMem(Buf, BufSize);
                if RegQueryValueEx(hTemp, PKey, nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then
                  begin
                    if ValType = MyValType then
                      begin
                        PVal := Buf;
                        ValSize := BufSize;
                        Result := True;
                      end
                    else
                      FreeMem(Buf)
                  end
                else
                  FreeMem(Buf);
              end;
            RegCloseKey(hTemp);
          end;
      end;
  end;
  function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean;
  var
    Buf: Pointer;
    BufSize: Cardinal;
  begin
    Result := False;
    Value := '';
    if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then
      begin
        Dec(BufSize);
        SetLength(Value, BufSize);
        if BufSize > 0 then
          Move(Buf^, Value[1], BufSize);
        FreeMem(Buf);
        Result := True;
      end;
  end;
begin
  Result := False;
  if RegEnumKeys(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall', Str) then
    while Length(Str) > 0 do
      begin
        MBuf := Copy(Str, 1, Pos(#13#10, Str) - 1);
        Delete(Str, 1, Pos(#13#10, Str) + 1);
        if RegValueExists(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + MBuf + '\DisplayName') then
          begin
            RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + MBuf + '\DisplayName', DisplayName);
            DisplayName := UpperCase(DisplayName);
            if Pos(UpperCase(ProgramName), DisplayName) > 0 then
              begin
                Result := True;
                Exit;
              end;
          end;
      end;
end;

// ESET NOD32 Integrity Issue
function IsNod32Integrity: Boolean;
begin
  if (IsService('nod32krn')) or (IsService('ekrn')) then
    Result := True
  else
    Result := False;
end;

// ESET NOD32 On-Access Issue
function IsNod32OnAccess: Boolean;
begin
  if (DriveExist('drivers\amon.sys')) or (DriveExist('drivers\eamon.sys')) then
    Result := True
  else
    Result := False;
end;

// ESET SysInspector Issue
function IsEsetSysInspector: Boolean;
begin
  if IsRing0('\\.\ESIASDRV') then
    Result := True
  else
    Result := False;
end;
 
Ответить с цитированием