Код:
unit antivir_detect;
{
Antivirus Detector v0.2 [Beta]
Author: FlipLab Software© 2006-2009
E-mail: fliplab@gmail.com, fliplab@ya.ru
URL: http://www.fls.com/
About: Вспомогательный модуль для обнаружения установленных
антивирусных программ, а также фаерволов. В текщей версии
поддерживаются:
+ ESET SysInspector
+ ESET Nod32 Antivirus
+ ESET Personal Firewall
+ Trend Micro Internet Security
+ Kaspersky Internet Security 2008 & WorkStation
+ Agnitum Outpost Firewall
+ Agnitum Anti-Spyware
+ Agnitum Host Protection
+ Malwarebytes' Anti-Malware
+ Zillya! Антивирус
+ Advanced SystemCare
+ Антивирус Stop!
+ USBGuard
+ AnVir Task Manager
+ Lavasoft Ad-Aware
+ Microsoft Security Essentials
+ McAfee
+ McAfee Personal Firewall
+ SpyHunter
}
interface
uses
Windows;
function IsEsetAntivir: Boolean;
function IsEsetSysInsp: Boolean;
function IsEsetFire: Boolean;
function IsTrendMicro: Boolean;
function IsKIS2008: Boolean;
function IsOutpostFire: Boolean;
function IsOutpostAntiSpy: Boolean;
function IsOutpostHostProt: Boolean;
function IsAntiMalware: Boolean;
function IsZillya: Boolean;
function IsAdvancedSysCare: Boolean;
function IsAvirStop: Boolean;
function IsUSBGuard: Boolean;
function IsAnvitTaskMgr: Boolean;
function IsAdAware: Boolean;
function IsMSecEssentials: Boolean;
function IsMcAfee: Boolean;
function IsMcAfeeeFire: Boolean;
function IsSpyHunter: Boolean;
implementation
function ImportKernelFunc(const Name: String): Pointer;
var
KernelModule: THandle;
begin
KernelModule := GetModuleHandle('kernel32.dll');
Result := GetProcAddress(KernelModule, PChar(Name));
end;
function UpperCase(const S: string): string;
asm
push ebx
push esi
push edi
mov esi, eax // s
mov eax, edx
test esi, esi
jz @Nil
mov edx, [esi-4] // Length(s)
mov edi, eax // @Result
test edx, edx
jle @Nil
mov ecx, [eax]
mov ebx, edx
test ecx, ecx
jz @Realloc // Jump if Result not allocated
test edx, 3
jnz @Length3
xor edx, [ecx-4]
cmp edx, 3
jbe @TestRef
jmp @Realloc
@Length3:
or edx, 2
xor edx, [ecx-4]
cmp edx, 1
ja @Realloc
@TestRef:
cmp [ecx-8], 1
je @LengthOK // Jump if Result RefCt=1
@Realloc:
mov edx, ebx
or edx, 3
call System.@LStrSetLength
@LengthOK:
mov edi, [edi] // Result
mov [edi-4], ebx // Correct Result length
mov byte ptr [ebx+edi], 0
add ebx, -1
and ebx, -4
mov eax, [ebx+esi]
@Loop: mov ecx, eax
or eax, $80808080 // $E1..$FA
mov edx, eax
sub eax, $7B7B7B7B // $66..$7F
xor edx, ecx // $80
or eax, $80808080 // $E6..$FF
sub eax, $66666666 // $80..$99
and eax, edx // $80
shr eax, 2 // $20
xor eax, ecx // Upper
mov [ebx+edi], eax
mov eax, [ebx+esi-4]
sub ebx, 4
jge @Loop
pop edi
pop esi
pop ebx
ret
@Nil: pop edi
pop esi
pop ebx
jmp System.@LStrClr // Result:=''
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;