program Portscan;
(*
1.10d - Okay, upon request the whole file moves out of the EXE again to be
able to customize the port descriptions ;)
1.10c - now the programmer can optionally include the short names for the
ports as string table resource using the PORTNAMES compiler switch.
(A Perl script in the \SOURCE directory can be used to extract the
names. Just put a file called "port-numbers.txt" into the directory
and then execute the .CMD file to extract the names - get the file
from: http://www.iana.org/assignments/port-numbers)
1.10b - can be minimized to tray now by double clicking the caption
1.10a - small enhancements
1.10 - sports new scheduling scheme. Thanks to Hagen for pointing it out to me.
1.00 - initial release
The program can definitely be compiled with Delphi 3 through 5!
The program will start and maybe run on Windows 9x. But when reaching a limit
of 32K items in the listbox it will hang or whatever. I don't know. I just
want you to notice it. It's a limitation of Windows 9x I am not willing to
work around, since Windows 9x hopefully will disappear from PCs soon.
*)
uses
Windows,
Messages,
ShellApi,
CommCtrl,
CommDlg,
WinSock;
function EnumChildSetFonts(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
(*
Iterates through all dialog child controls and sets fonts and text length limit.
*)
begin
result := True;
// For any of the controls here, let's set the font :)
case GetDlgCtrlID(hwnd) of
IDC_LIST1,
IDC_EDITIP,
IDC_EDITPORT_FROM,
IDC_EDITPORT_TO:
SendMessage(hwnd, WM_SETFONT, lParam, ord(TRUE));
end;
case GetDlgCtrlID(hwnd) of
IDC_LIST1,
IDC_EDITIP:
SendMessage(hwnd, EM_SETLIMITTEXT, 20, 0);
IDC_EDITPORT_FROM,
IDC_EDITPORT_TO:
SendMessage(hwnd, EM_SETLIMITTEXT, 5, 0);
end;
end;
function GetIP(hwnd: HWND): DWORD;
// Get's an IP address in host byte order from the text of the IDC_EDITIP control
var
IP: DWORD;
pc: PChar;
begin
result := 0;
IP := GetWindowTextLength(GetDlgItem(hwnd, IDC_EDITIP)) + 2;
GetMem(pc, IP);
if Assigned(pc) then
try
ZeroMemory(pc, IP);
GetWindowText(GetDlgItem(hwnd, IDC_EDITIP), pc, IP);
result := ntohl(inet_addr(pc));
finally
FreeMem(pc);
end;
end;
function ScanTCPPort(IP, Port: DWORD): Boolean;
// Scans a specific TCP port and on a specific IP
var
OPTON: DWORD;
TCPsock: TSocket;
A: TSockAddrIn;
begin
result := False;
// Create/open a socket (stream, not datagram)
TCPsock := socket(AF_INET, SOCK_STREAM, 0);
if TCPsock <> INVALID_SOCKET then
try
// Set socket options
OPTON := 0;
setsockopt(TCPsock, SOL_SOCKET, SO_KEEPALIVE, @OPTON, sizeof(OPTON));
OPTON := 1;
setsockopt(TCPsock, SOL_SOCKET, SO_DONTLINGER, @OPTON, sizeof(OPTON));
// Only for compatibility with WinSock 1.1! It's default on newer versions.
setsockopt(TCPsock, IPPROTO_TCP, TCP_NODELAY, @OPTON, sizeof(OPTON));
// Reset and init address structure
ZeroMemory(@A, sizeof(A));
A.sin_family := AF_INET;
A.sin_addr.S_addr := ntohl(IP);
A.sin_port := htons(Port);
// Try to connect and return result
result := connect(TCPsock, A, sizeof(A)) = 0;
finally
// Close the socket
closesocket(TCPsock);
end;
end;
function BeepThread(unused: DWORD): DWORD; stdcall;
// Does a long beep
begin
result := 0;
Windows.Beep(200, 100);
Windows.Beep(400, 100);
Windows.Beep(600, 100);
Windows.Beep(800, 100);
Windows.Beep(1000, 100);
Windows.Beep(1200, 100);
Windows.Beep(1400, 100);
Windows.Beep(1600, 100);
Windows.Beep(1800, 100);
Windows.Beep(2000, 100);
end;
function ScanThread(unused: DWORD): DWORD; stdcall;
// Does the job for ONE port each time. It loops in a loop that increases a global
// port counter. The next unscanned port is scanned by the next free thread
var
lPort: DWORD;
begin
result := 0;
// Thread counter
InterLockedIncrement(IP.ThreadCounter);
// Post updated number of threads
PostMessage(hDlg, WM_SETCOUNTER, IP.ThreadCounter, 0);
// Set lower thread priority
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_IDLE);
// Loop while the current port number is smaller or equal the end port number
while True do
begin
asm
// Atomic operation
MOV EAX, 1
XADD gPortCounter, EAX
MOV lPort, EAX
end;
// Exit condition
if lPort > IP.EndPort then
Break;
// Scan ports ...
if ScanTCPPort(IP.IP, lPort) then
PostMessage(hDlg, WM_ADDIP_TCPCONNPORT, IP.IP, lPort)
else
PostMessage(hDlg, WM_ADDIP_TCPPORT, IP.IP, lPort);
end;
// Atomic operation ... decreases thread counter
InterLockedDecrement(IP.ThreadCounter);
// Post updated number of threads
PostMessage(hDlg, WM_SETCOUNTER, IP.ThreadCounter, 0);
end;
procedure TryPortscan(hwnd: HWND);
// Retrieves all necessary values from the dialog and starts scanning.
var
i, TID: DWORD;
trans: BOOL;
begin
IP.IP := GetIP(hwnd);
if (IP.IP <> INADDR_NONE) then
begin
SetDlgItemInt(hwnd, IDC_STATIC_NUMITEMS, 0, False);
i := SendDlgItemMessage(hwnd, IDC_SPIN_NUMTHREADS, UDM_GETPOS, 0, 0);
IP.StartPort := GetDlgItemInt(hwnd, IDC_EDITPORT_FROM, trans, False);
IP.EndPort := GetDlgItemInt(hwnd, IDC_EDITPORT_TO, trans, False);
// If the ports have wrong order (max < min) then change them
if IP.StartPort > IP.EndPort then
begin
TID := IP.StartPort;
IP.StartPort := IP.EndPort;
IP.EndPort := TID;
if IP.EndPort > maxports then
SetDlgItemInt(hwnd, IDC_EDITPORT_FROM, IP.StartPort, False);
SetDlgItemInt(hwnd, IDC_EDITPORT_TO, IP.EndPort, False);
end;
// Prevent thread switching
if i > (IP.EndPort - IP.StartPort) then
i := (IP.EndPort - IP.StartPort) + 1;
SendDlgItemMessage(hwnd, IDC_LIST1, LB_RESETCONTENT, 0, 0);
gPortCounter := IP.StartPort;
IP.ThreadCounter := 0;
// Set lower thread priority
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_BELOW_NORMAL);
// Start a whole lott of threads ...
for i := 0 to i - 1 do
// Parameter is the current counter value
CreateThread(nil, $FFFF, @ScanThread, nil, 0, TID);
end
else
MessageBox(hwnd, 'Please give a valid IP address and number of threads!', nil, 0);
end;
procedure EnableWindows(hwnd: HWND; b: BOOL);
// Enables or disables controls that might disturb while scanning
begin
EnableWindow(GetDlgItem(hwnd, IDOK), b);
EnableWindow(GetDlgItem(hwnd, IDC_EDIT_NUMTHREADS), b);
EnableWindow(GetDlgItem(hwnd, IDC_EDITIP), b);
EnableWindow(GetDlgItem(hwnd, IDC_EDITPORT_FROM), b);
EnableWindow(GetDlgItem(hwnd, IDC_EDITPORT_TO), b);
EnableWindow(GetDlgItem(hwnd, IDC_SPIN_NUMTHREADS), b);
// EnableWindow(GetDlgItem(hwnd, IDC_BUTTON_SAVE), b);
end;
procedure SetIcon(hwnd: HWND; handle: HICON);
// Sets the main window's icon
begin
SendMessage(hwnd, WM_SETICON, ICON_BIG, handle);
SendMessage(hwnd, WM_SETICON, ICON_SMALL, handle);
end;
function GetFileName(hwnd: HWND; default: string; var returnname: string): Boolean;
// Gets the name for the file to save the report
var
ofn: TOpenFilename;
ofn_buffer: array[0..MAX_PATH] of Char;
begin
ZeroMemory(@ofn_buffer, sizeof(ofn_buffer));
ZeroMemory(@ofn, sizeof(ofn));
lstrcpyn(@ofn_buffer[0], @default[1], sizeof(ofn_buffer));
ofn.lStructSize := sizeof(ofn);
ofn.lpstrFile := @ofn_buffer;
ofn.hWndOwner := hwnd;
ofn.hInstance := hInstance;
ofn.lpstrFilter := @allfiles_filterstring[1];
ofn.nMaxFile := sizeof(ofn_buffer);
ofn.Flags := OFN_PATHMUSTEXIST or OFN_LONGNAMES or OFN_EXPLORER or OFN_HIDEREADONLY;
result := GetSaveFileName(ofn);
if result then
SetString(returnname, PChar(@ofn_buffer), lstrlen(@ofn_buffer[0]));
end;
function GetLBItem(hwnd: HWND; idx: Integer): string;
// Gets one listbox item in a string (by index)
var
i: Integer;
pc: PChar;
begin
result := '';
i := SendMessage(hwnd, LB_GETTEXTLEN, idx, 0) + 2;
GetMem(pc, i);
if Assigned(pc) then
try
ZeroMemory(pc, i);
SendMessage(hwnd, LB_GETTEXT, idx, LPARAM(pc));
SetString(result, pc, lstrlen(pc));
finally
FreeMem(pc);
end;
end;
procedure DestroyTrayIcon;
// Destroys the tray icon
begin
Shell_NotifyIcon(NIM_DELETE, @note);
end;
procedure ModifyTrayIconText;
// Modifies the tray icon
begin
Shell_NotifyIcon(NIM_MODIFY, @note);
end;
procedure BlinkTrayIcon;
// Actually blinks the tray icon
begin
note.hIcon := icons[ord(ct)];
ModifyTrayIconText;
end;
procedure TimerFunc(hwnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD); stdcall;
// Makes the tray icon blink when finished
begin
ct := not ct;
BlinkTrayIcon;
end;
function GetTCPPortDescription(IP: DWORD; Port: Word; ports: PPortArray): string;
begin
result := Format('%3d.%3d.%3d.%3d:%5d [TCP] open', [
Byte(IP shr 24),
Byte(IP shr 16),
Byte(IP shr 8),
Byte(IP),
Port]);
if Assigned(ports) then
if ports^[Port] <> '' then
result := Format('%s -> %s', [result, ports^[Port]]);
end;
function DlgFunc(hwnd: HWND; umsg: UINT; wparam: WPARAM; lparam: LPARAM): BOOL; stdcall;
var
s: string;
hFile: THandle;
written: DWORD;
i: Integer;
se: servent;
pse: PServEnt absolute se;
x,y:integer;
begin
Result := True;
case umsg of
WM_INITDIALOG:
begin
hDlg := hwnd;
SetIcon(hwnd, icons[0]);
// Set fixed font for all edit fields
EnumChildWindows(hwnd, @EnumChildSetFonts, GetFont(hwnd, 8, FW_NORMAL, True));
// Set initial IP address
begin
for x:=52 to 54 do
for y:=77 to 79 do
SetDlgItemText(hwnd, IDC_EDITIP, '172.26.x.y');
end;
SendDlgItemMessage(hwnd, IDC_SPIN_NUMTHREADS, UDM_SETRANGE, 0, MAKELONG(numthreads, 1));
SendDlgItemMessage(hwnd, IDC_SPIN_NUMTHREADS, UDM_SETPOS, 0, MAKELONG(numthreads, 0));
// Set initial port range
SetDlgItemInt(hwnd, IDC_EDITPORT_FROM, 0, False);
SetDlgItemInt(hwnd, IDC_EDITPORT_TO, maxports, False);
SetDlgItemInt(hwnd, IDC_STATIC_NUMTHREADS, 0, False);
SetDlgItemInt(hwnd, IDC_STATIC_NUMITEMS, 0, False);
// Register the message
MsgTaskbarcreated := RegisterWindowMessage('TaskbarCreated');
end;
WM_TIMER:
case wParam of
IDD_DIALOG1:
begin
ct := not ct;
SetIcon(hwnd, icons[ord(ct)]);
end;
end;
WM_SETCOUNTER:
begin
SetDlgItemInt(hwnd, IDC_STATIC_NUMTHREADS, wParam, False);
if wParam > 0 then
EnableWindows(hwnd, False)
else
begin
EnableWindows(hwnd, True);
// Remove timer
KillTimer(hwnd, IDD_DIALOG1);
// Reset icon
SetIcon(hwnd, icons[0]);
// Set lower thread priority
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
if not IsWindowVisible(hwnd) then
begin
// Make the tray icon blink
SetTimer(hwnd, SC_TRAY, 350, @TimerFunc);
// Make a long beeeeep ;)
CreateThread(nil, $FFFF, @BeepThread, nil, 0, PDWORD(nil)^);
end;
end;
end;
WM_ADDIP_TCPCONNPORT:
begin
// s := Format('%3.3d.%3.3d.%3.3d.%3.3d:%5.5d - ', [
s := GetTCPPortDescription(wParam, lParam, portdesc);
SendDlgItemMessage(hwnd, IDC_LIST1, LB_ADDSTRING, 0, Integer(@s[1]));
if IsDlgButtonChecked(hwnd, IDC_CHECK1) = BST_CHECKED then
SendDlgItemMessage(hwnd, IDC_LIST1, LB_SETTOPINDEX,
SendDlgItemMessage(hwnd, IDC_LIST1, LB_GETCOUNT, 0, 0) - 1, 0);
SetDlgItemInt(hwnd, IDC_STATIC_NUMITEMS, gPortCounter, False);
end;
WM_ADDIP_TCPPORT:
SetDlgItemInt(hwnd, IDC_STATIC_NUMITEMS, gPortCounter, False);
WM_CTLCOLOREDIT:
case GetDlgCtrlID(lParam) of
IDC_EDITIP:
begin
SetTextColor(wParam, RGB($00, $80, $00));
SetBkColor(wParam, GetSysColor(COLOR_INFOBK));
result := BOOL(GetSysColorBrush(COLOR_INFOBK));
end;
IDC_EDITPORT_FROM,
IDC_EDITPORT_TO:
begin
SetTextColor(wParam, RGB($00, $00, $80));
SetBkColor(wParam, GetSysColor(COLOR_INFOBK));
result := BOOL(GetSysColorBrush(COLOR_INFOBK));
end;
IDC_EDIT_NUMTHREADS:
begin
SetTextColor(wParam, RGB($80, $00, $00));
SetBkColor(wParam, GetSysColor(COLOR_INFOBK));
result := BOOL(GetSysColorBrush(COLOR_INFOBK));
end;
else
result := False;
end;
WM_CTLCOLORLISTBOX:
case GetDlgCtrlID(lParam) of
IDC_LIST1:
begin
SetTextColor(wParam, RGB($00, $00, $80));
SetBkColor(wParam, GetSysColor(COLOR_BTNFACE));
result := BOOL(GetSysColorBrush(COLOR_BTNFACE));
end;
else
result := False;
end;
WM_CLOSE:
EndDialog(hwnd, 0);
WM_COMMAND:
if HiWord(WParam) = BN_CLICKED then
case LOWORD(wParam) of
IDOK:
begin
SetTimer(hwnd, IDD_DIALOG1, 400, nil);
TryPortScan(hwnd);
end;
IDCANCEL:
SendMessage(hwnd, WM_CLOSE, 0, 0);
IDC_BUTTON_OPENPORTS:
// Open the IANA website with port number assignments
ShellExecute(hwnd,
'open',
'http://www.iana.org/assignments/port-numbers',
nil,
nil,
SW_SHOW);
IDC_BUTTON_SAVE:
begin
i := SendDlgItemMessage(hwnd, IDC_LIST1, LB_GETCOUNT, 0, 0);
if i > 0 then
if GetFileName(hwnd, 'ScanReport.txt', s) then
begin
hFile := CreateFile(@s[1], GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if ((hFile <> INVALID_HANDLE_VALUE) and (i <> LB_ERR)) then
try
for i := 0 to i do
begin
s := GetLBItem(GetDlgItem(hwnd, IDC_LIST1), i) + #13#10;
WriteFile(hFile, PChar(@s[1])^, length(s), written, nil);
end;
finally
CloseHandle(hFile);
end
else
MessageBox(hwnd, 'Could not create file.', nil, 0);
end;
end;
end;
(******************************************************************************
Handle: minimize to tray
******************************************************************************)
WM_SIZE:
if wParam = SIZE_MINIMIZED then
CreateTrayIcon(hwnd);
WM_SHELLNOTIFY:
case wParam of
SC_TRAY:
case lParam of
WM_LBUTTONDBLCLK:
begin
DestroyTrayIcon;
ShowWindow(hWnd, SW_RESTORE);
SetForeGroundWindow(hwnd);
end;
end;
end;
WM_NCLBUTTONDBLCLK:
case wParam = HTCAPTION of
TRUE: Showwindow(hwnd, SW_MINIMIZE);
end;
else
if ((MsgTaskbarcreated <> 0) and (uMsg = MsgTaskbarcreated)) then
begin
DestroyTrayIcon;
CreateTrayIcon(hwnd);
end
else
Result := False;
end;
end;
function InitPortArray(fname: string): PPortArray;
var
f: Textfile;
s: string;
Port: Word;
Code: Integer;
begin
result := nil;
AssignFile(f, fname);
{$I-}
Reset(f);
{$I+}
if IOResult = 0 then
try
GetMem(result, sizeof(result^));
if Assigned(result) then
begin
ZeroMemory(result, sizeof(result^));
while not EOF(f) do
begin
Readln(f, s);
if s[1] = '#' then
continue;
val(copy(s, 1, 5), Port, Code);
if Code = 0 then
result^[Port] := copy(s, 7, length(s));
end;
end;
finally
CloseFile(f);
end;
end;
begin
// Warning on Win9x
if GetVersion and $80000000 <> 0 then
begin
MessageBox(0, 'Note: There are certain limitations on Windows 9x/Me which might' +
' cause the program to hang or not work at all! Be warned! You use it at your own risk.', 'Information', MB_ICONWARNING);
numthreads := $F;
end;
// Create critical section
InitializeCriticalSection(cs);
// Init comctl library
InitCommonControls;
try
// Init WinSock (v 1.1)
if WSAStartup(MAKEWORD(1, 1), wsa) = 0 then
try
icons[0] := LoadIcon(hInstance, MAKEINTRESOURCE(IDI_ICON1));
icons[1] := LoadIcon(hInstance, MAKEINTRESOURCE(IDI_ICON2));
// Init port list
portdesc := InitPortArray(portfile);
// Start main window
DialogBoxParam(hInstance, MAKEINTRESOURCE(IDD_DIALOG1), 0, @dlgfunc, 0);
finally
// Finit WinSock
WSACleanup;
end
else
MessageBox(0, 'Found no appropriate WinSock support. Version 1.1 needed.', nil, 0);
finally
// Remove critical section
DeleteCriticalSection(cs);
// Free the port list
if Assigned(portdesc) then
FreeMem(portdesc);
end;
end.
( 粤ICP备18085999号-1 | 粤公网安备 44051102000585号)
狗仔卡
发表于 2012-4-14 11:18:30
置顶卡
千斤顶
显身卡