Comunidad Underground Hispana  

Retroceder   Comunidad Underground Hispana > Programacion > Programación > Code

Respuesta Crear Nuevo Tema
 
Compartir en twitter LinkBack Herramientas Desplegado
Antiguo 11-mar-2017, 15:42   #1
Experto
 
Avatar de bigbear
 
Fecha de Ingreso: febrero-2009
Amigos 30
Mensajes: 2.804
Gracias: 0
Agradecido 256 veces en 184 mensajes.
Predeterminado [Delphi] Port Scanner 1.0

Un scanner de puertos usando threads en Delphi.

Una imagen :



El codigo :

Código:
// Port Scanner 1.0
// (C) Doddy Hackman 2016

unit scanner;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
  Vcl.ExtCtrls, IdTCPConnection, IdTCPClient, OtlThreadPool, OtlComm, OtlTask,
  OtlTaskControl, Vcl.Imaging.pngimage;

type
  TFormHome = class(TForm)
    imgLogo: TImage;
    gbEnterConfiguration: TGroupBox;
    lblIP: TLabel;
    lblThreads: TLabel;
    txtIP: TEdit;
    txtThreads: TEdit;
    udThreads: TUpDown;
    gbConsole: TGroupBox;
    mmOutput: TMemo;
    btnStart: TButton;
    btnStop: TButton;
    status: TStatusBar;
    Label1: TLabel;
    txtStart: TEdit;
    udStart: TUpDown;
    lblEnd: TLabel;
    txtEnd: TEdit;
    udEnd: TUpDown;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}
// Functions

function message_box(title, message_text, type_message: string): string;
begin
  if not(title = '') and not(message_text = '') and not(type_message = '') then
  begin
    try
      begin
        if (type_message = 'Information') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end
        else if (type_message = 'Warning') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONWARNING);
        end
        else if (type_message = 'Question') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONQUESTION);
        end
        else if (type_message = 'Error') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONERROR);
        end
        else
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end;
        Result := '[+] MessageBox : OK';
      end;
    except
      begin
        Result := '[-] Error';
      end;
    end;
  end
  else
  begin
    Result := '[-] Error';
  end;
end;

function check_port(ip: string; port: integer): boolean;
var
  socket: TIdTCPClient;
begin
  try
    begin
      socket := TIdTCPClient.Create();
      socket.Host := ip;
      socket.port := port;
      socket.Connect;
      socket.Free();
      Result := True;
    end
  except
    begin
      Result := False;
    end;
  end;
end;

//

procedure TFormHome.btnStartClick(Sender: TObject);
var
  i: integer;
  ip: string;
  port: integer;
begin
  if not(txtIP.Text = '') and not(txtStart.Text = '') and not(txtEnd.Text = '')
    and not(txtThreads.Text = '') then
  begin
    GlobalOmniThreadPool.MaxExecuting := StrToInt(txtThreads.Text) *
      System.CPUCount;
    status.Panels[0].Text := '[+] Scanning ...';
    FormHome.Update;
    for i := StrToInt(txtStart.Text) to StrToInt(txtEnd.Text) do
    begin
      ip := txtIP.Text;
      port := i;
      Application.ProcessMessages;
      Sleep(250);
      CreateTask(
        procedure(const task: IOmniTask)
        var
          ip_to_load: string;
          port_to_load: integer;
        begin

          ip_to_load := task.Param['ip'].AsString;
          port_to_load := task.Param['port'].AsInteger;

          status.Panels[0].Text := 'Checking : ' + ip_to_load + ':' +
            IntToStr(port_to_load) + ' ...';
          FormHome.Update;
          if (check_port(ip_to_load, port_to_load)) then
          begin
            mmOutput.Lines.Add('[+] Port Open : ' + IntToStr(port_to_load));
          end;

        end).SetParameter('ip', ip).SetParameter('port', port)
        .Unobserved.Schedule;

    end;

    while GlobalOmniThreadPool.CountExecuting +
      GlobalOmniThreadPool.CountQueued > 0 do
    begin
      Application.ProcessMessages;
    end;

    status.Panels[0].Text := '[+] Finished';
    FormHome.Update;

    message_box('Port Scanner 1.0', 'Scan Finished', 'Information');

  end
  else
  begin
    message_box('Port Scanner 1.0', 'Complete the configuration', 'Warning');
  end;

end;

procedure TFormHome.btnStopClick(Sender: TObject);
begin
  GlobalOmniThreadPool.CancelAll;
  status.Panels[0].Text := '[+] Stopped';
  FormHome.Update;
  message_box('Port Scanner 1.0', 'Scan Stopped', 'Information');
end;

end.

// The End ?
  
Si quieren bajar el programa lo pueden hacer de aca :

SourceForge.

Eso seria todo.
bigbear está desconectado   Responder Citando
Respuesta

Herramientas
Desplegado

Normas de Publicación
No puedes crear nuevos temas
No puedes responder mensajes
No puedes subir archivos adjuntos
No puedes editar tus mensajes

Los Códigos BB están Activado
Las Caritas están Activado
[IMG] está Activado
El Código HTML está Desactivado
Trackbacks están Activado
Pingbacks están Activado
Refbacks están Activado



Temas Similares
Tema Autor Foro Respuestas Último mensaje
[Python] LHF: A modular Recon tool for Penetration Testing Zephomet Python 2 05-oct-2016 10:19
[sh] Pentmenu: Recon and DOS Attacks Zephomet CodeCommand 0 23-ago-2016 23:46
[Perl] I.C.S.G Port Scanner Tool v2 Zephomet Perl 0 04-sep-2015 23:30
[Delphi] DH Port Scanner 0.2 bigbear Code 5 07-ago-2013 06:41
Descargar Ultra Port Scanner 1.0 soft2010 Top 100 0 09-dic-2011 08:00



Portal Hacker
Powered by vBulletin® Version 3.8.8
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
SEO by vBSEO 3.6.0