File "LAN Scanner.bas"
Path: /LAN Scanner/LAN Scanner.bas
File size: 30.66 KB
MIME-type:
Charset: utf-8
#PBFORMS CREATED V2.00
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly. See the PB/Forms documentation for
' more information.
' Named blocks begin like this: #PBFORMS BEGIN ...
' Named blocks end like this: #PBFORMS END ...
' Other PB/Forms metastatements such as:
' #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'------------------------------------------------------------------------------
#COMPILE EXE "LAN Scanner.exe"
#DIM ALL
#RESOURCE ICON AICO, "icon.ico"
#RESOURCE MANIFEST, 1, "XPTheme.xml"
TYPE ConCheckType
portnumber AS LONG
sipaddress AS STRING * 127
connected AS LONG
END TYPE
GLOBAL protocols(), activeIp() AS STRING
GLOBAL SleepMinimum, TcpPort, sorted AS LONG
'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
'#RESOURCE "LAN Scanner.pbr"
'%USEMACROS = 1
#INCLUDE ONCE "WIN32API.INC"
#INCLUDE ONCE ".\SAVEPOS.INC"
#INCLUDE ONCE ".\RTF.INC"
'#INCLUDE ONCE "COMMCTRL.INC"
'#INCLUDE ONCE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDC_SYSIPADDRESS32_1 = 1001
%IDC_SYSIPADDRESS32_2 = 1002
%IDC_LABEL1 = 1003
%IDC_COMBOBOX1 = 1004
%IDC_LABEL2 = 1005
%IDC_TEXTBOX1 = 1006
%IDC_LABEL3 = 1007
%IDC_LABEL4 = 1008
%IDC_CHECKBOX1 = 1009
%IDC_TEXTBOX2 = 1010
%IDC_LABEL5 = 1011
%IDC_LABEL6 = 1012
%IDC_BUTTON1 = 1013
%IDC_FRAME1 = 1014
%IDC_LISTVIEW1 = 1015
%IDC_LABEL7 = 1016
%IDC_PROGRESSBAR = 1017
%IDC_LABEL8 = 1018
%IDC_CHECKBOX2 = 1019
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Declarations **
'------------------------------------------------------------------------------
'DECLARE CALLBACK FUNCTION ProcMainDialog()
'DECLARE FUNCTION SampleComboBox(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL _
' lCount AS LONG) AS LONG
'DECLARE FUNCTION SampleListView(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL _
' lColCnt AS LONG, BYVAL lRowCnt AS LONG) AS LONG
'DECLARE FUNCTION ShowMainDialog(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
' PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
' %ICC_INTERNET_CLASSES)
LoadLibrary("RICHED32.DLL")
DIM protocols(11)
ARRAY ASSIGN protocols() = "SSH:22", "FTP:21", "Telnet:23", "Echo:7", "SMTP:25", _
"POP3:110", "IMAP:143", "HTTP:80", "HTTPS:443", "NNTP:119", "SQL:156", "Other:"
ShowMainDialog %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ProcMainDialog()
STATIC hThread AS DWORD
LOCAL i, j, lRes AS LONG
LOCAL e AS STRING
CB_SAVEPOS
SELECT CASE AS LONG CB.MSG
CASE %WM_INITDIALOG ' Initialization handler
LoadSession CB.HNDL
CASE %WM_SETCURSOR ' Standard hovering-over-controls message
IF GetDlgCtrlId(CB.WPARAM) = %IDC_LABEL8 THEN ' Change cursor to link-hand when hovering over link
SetCursor LoadCursor(%NULL, BYVAL %IDC_HAND)
SetWindowLong CB.HNDL, %dwl_msgresult, 1
FUNCTION = 1
END IF
CASE %WM_NOTIFY
IF LOWRD(CB.WPARAM) <> %IDC_LISTVIEW1 THEN EXIT FUNCTION ' only detect events in listview
LOCAL pnmlv AS NM_LISTVIEW PTR
pnmlv = CB.LPARAM
IF @pnmlv.hdr.code = %LVN_COLUMNCLICK THEN ' click on column header
IF @pnmlv.iSubItem <> -1 THEN SortColumn CB.HNDL, @pnmlv.iSubItem + 1
ELSEIF @pnmlv.hdr.code = %NM_DBLCLK THEN ' double click on column line
CONTROL GET TEXT CB.HNDL, %IDC_TEXTBOX1 TO e : TcpPort = VAL(e)
lRes = FREEFILE
OPEN EXE.PATH$ + "LAN Scanner dump.txt" FOR OUTPUT AS #lRes
PRINT #lRes, "Scan on port " + TRIM$(TcpPort) + " finished on " + DATE$ + " at " + TIME$
PRINT #lRes, "-------------------------------------------------"
IF UBOUND(activeIp) < 0 THEN
PRINT #lRes, "No active IP address found"
ELSE
PRINT #lRes, "IP address,MAC address,Protocol,Port,Active"
FOR i = LBOUND(activeIp) TO UBOUND(activeIp)
PRINT #lRes, activeIp(i)
NEXT
END IF
CLOSE #lRes
i = SHELL("notepad " + $DQ + EXE.PATH$ + "LAN Scanner dump.txt" + $DQ)
END IF
CASE %WM_COMMAND ' Process control notifications
SELECT CASE AS LONG CB.CTL
CASE %IDC_COMBOBOX1
IF CB.CTLMSG = %CBN_SELENDOK THEN
COMBOBOX GET SELECT CB.HNDL, CB.CTL TO i
COMBOBOX GET TEXT CB.HNDL, CB.CTL, i TO e
ARRAY SCAN protocols(), FROM 1 TO LEN(e), = e, TO i
e = PARSE$(protocols(i-1), ":", 2)
CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX1, e
IF e <> "" THEN
CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %EM_SETREADONLY, %TRUE, 0
ELSE
CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %EM_SETREADONLY, %FALSE, 0
CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
END IF
END IF
CASE %IDC_BUTTON1
IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
CONTROL GET TEXT CB.HNDL, %IDC_TEXTBOX1 TO e : TcpPort = VAL(e)
CONTROL GET TEXT CB.HNDL, %IDC_TEXTBOX2 TO e : SleepMinimum = VAL(e)
CONTROL DISABLE CB.HNDL, %IDC_BUTTON1
LISTVIEW RESET CB.HNDL, %IDC_LISTVIEW1
CONTROL SHOW STATE CB.HNDL, %IDC_LABEL7, %SW_HIDE
CONTROL SHOW STATE CB.HNDL, %IDC_LABEL8, %SW_HIDE
CONTROL SHOW STATE CB.HNDL, %IDC_PROGRESSBAR, %SW_SHOW
SaveSession CB.HNDL
THREAD CREATE StartScan (CB.HNDL) TO hThread
END IF
CASE %IDC_LABEL8
IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN ShowHelp CB.HNDL
END SELECT
CASE %WM_USER + 501 ' Scan in progress: refresh progressbar and display found IPs
PROGRESSBAR SET POS CB.HNDL, %IDC_PROGRESSBAR, CB.WPARAM
LISTVIEW GET COUNT CB.HNDL, %IDC_LISTVIEW1 TO lRes
FOR i = lRes TO UBOUND(activeIp)
LISTVIEW INSERT ITEM CB.HNDL, %IDC_LISTVIEW1, i+1, 0, TRIM$(i)
FOR j = 1 TO PARSECOUNT(activeIp(i))
LISTVIEW SET TEXT CB.HNDL, %IDC_LISTVIEW1, i+1, j, PARSE$(activeIp(i), j)
NEXT
NEXT
FOR i = 1 TO 5 : LISTVIEW FIT HEADER CB.HNDL, %IDC_LISTVIEW1, i : NEXT
CASE %WM_USER + 502 ' End of thread 'StartScan'
THREAD CLOSE hThread TO lRes : hThread = 0
CONTROL SHOW STATE CB.HNDL, %IDC_PROGRESSBAR, %SW_HIDE
IF UBOUND(activeIp) < 0 THEN
e = "No active IP address on port " + TRIM$(TcpPort)
ELSE
END IF
CONTROL SET TEXT CB.HNDL, %IDC_LABEL7, e
CONTROL SHOW STATE CB.HNDL, %IDC_LABEL7, %SW_SHOW
CONTROL SHOW STATE CB.HNDL, %IDC_LABEL8, %SW_SHOW
CONTROL ENABLE CB.HNDL, %IDC_BUTTON1
CASE %WM_DESTROY
SaveSession CB.HNDL
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB SortColumn (BYVAL hDlg AS DWORD, BYVAL c AS LONG)
LOCAL szBuf AS ASCIIZ * 256
LOCAL tLVI AS LV_ITEM
LOCAL slist() AS STRING
LOCAL nlist() AS DWORD
LOCAL i, j AS LONG
IF UBOUND(activeIp) < 0 THEN EXIT SUB
IF sorted MOD 10 = c THEN ' clicking a 2nd time on same column -> reverse sorting order
sorted = 30 - (sorted-c) + c
ELSE ' clicking a 1st time on a column -> ordered sorting
sorted = 10 + c
END IF
IF c = 1 OR c = 4 THEN ' sort on IP or Port (numbers)
DIM nlist(LBOUND(activeIp) TO UBOUND(activeIp))
FOR i = LBOUND(activeIp) TO UBOUND(activeIp)
nlist(i) = IP_LNG(PARSE$(activeIp(i), c))
NEXT
IF (sorted-c) = 10 THEN
ARRAY SORT nlist(), TAGARRAY activeIp(), ASCEND
ELSE
ARRAY SORT nlist(), TAGARRAY activeIp(), DESCEND
END IF
ELSE ' sort on MAC, status, or protocol (string)
DIM slist(LBOUND(activeIp) TO UBOUND(activeIp))
FOR i = LBOUND(activeIp) TO UBOUND(activeIp)
slist(i) = PARSE$(activeIp(i), c)
NEXT
IF (sorted-c) = 10 THEN
ARRAY SORT slist(), TAGARRAY activeIp(), ASCEND
ELSE
ARRAY SORT slist(), TAGARRAY activeIp(), DESCEND
END IF
END IF
LISTVIEW RESET hDlg, %IDC_LISTVIEW1
FOR i = LBOUND(activeIp) TO UBOUND(activeIp)
LISTVIEW INSERT ITEM hDlg, %IDC_LISTVIEW1, i+1, 0, TRIM$(i)
FOR j = 1 TO PARSECOUNT(activeIp(i))
LISTVIEW SET TEXT hDlg, %IDC_LISTVIEW1, i+1, j, PARSE$(activeIp(i), j)
NEXT
NEXT
FOR i = 1 TO 5 : LISTVIEW FIT HEADER hDlg, %IDC_LISTVIEW1, i : NEXT
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION IP_STR(ip AS DWORD) AS STRING
LOCAL p AS BYTE PTR
p = VARPTR(ip)
FUNCTION = USING$("#_.#_.#_.#", @p, @p[1], @p[2], @p[3])
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION IP_LNG(ip AS STRING) AS DWORD
FUNCTION = 256^3 * VAL(PARSE$(ip, ".", 1)) _
+ 256^2 * VAL(PARSE$(ip, ".", 2)) _
+ 256^1 * VAL(PARSE$(ip, ".", 3)) _
+ 256^0 * VAL(PARSE$(ip, ".", 4))
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION IP_REV(ip AS DWORD) AS DWORD
LOCAL p AS BYTE PTR
p = VARPTR(ip)
FUNCTION = 256^3*@p[0] + 256^2*@p[1] + 256^1*@p[2] + @p[3]
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
THREAD FUNCTION StartScan (BYVAL hDlg AS LONG) AS LONG
LOCAL showall, udptest, tot, crt AS LONG
LOCAL pbIP1, pbIP2 AS BYTE PTR
LOCAL dwIP1, dwIP2 AS DWORD
LOCAL udt AS ConCheckType
LOCAL i, j, k, l AS LONG
LOCAL sIP AS STRING
CONTROL GET CHECK hDlg, %IDC_CHECKBOX1 TO showall : showall = 1 - showall
CONTROL GET CHECK hDlg, %IDC_CHECKBOX2 TO udptest
ERASE activeIp()
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_1, %IPM_GETADDRESS, 0, VARPTR(dwIP1) : pbIP1 = VARPTR(dwIP1)
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_2, %IPM_GETADDRESS, 0, VARPTR(dwIP2) : pbIP2 = VARPTR(dwIP2)
tot = (@pbIP2[3] - @pbIP1[3] + 1) * (@pbIP2[2] - @pbIP1[2] + 1) * (@pbIP2[1] - @pbIP1[1] + 1) * (@pbIP2[0] - @pbIP1[0] + 1)
IF tot <= 0 THEN DIALOG POST hDlg, %WM_USER + 502, 0, 0 : EXIT FUNCTION
FOR l = @pbIP1[3] TO @pbIP2[3]
FOR k = @pbIP1[2] TO @pbIP2[2]
FOR j = @pbIP1[1] TO @pbIP2[1]
FOR i = @pbIP1[0] TO @pbIP2[0]
sIP = USING$("#_.#_.#_.#", l, k, j, i) ' TCP test
IF ConCheck(TcpPort, sIP, udt) THEN
IF UBOUND(activeIp) < 0 THEN REDIM activeIp(0) ELSE REDIM PRESERVE activeIp(UBOUND(activeIp)+1)
activeIp(UBOUND(activeIp)) = sIP + "," + GetMACaddress((sIP)) + ",TCP," + TRIM$(TcpPort) + ",Yes"
ELSEIF ISTRUE showall THEN
IF UBOUND(activeIp) < 0 THEN REDIM activeIp(0) ELSE REDIM PRESERVE activeIp(UBOUND(activeIp)+1)
activeIp(UBOUND(activeIp)) = sIP + ",,TCP," + TRIM$(TcpPort) + ",No"
END IF
INCR crt : DIALOG POST hDlg, %WM_USER + 501, INT((crt/tot)*65535), 0 ' update progress
NEXT i ' 192.168.0.__
IF ISTRUE udptest THEN ' UDP test
sIP = USING$("#_.#_.#_.#", l, k, j, 255) ' broadcast IP
IF UdpBroadCast(TcpPort, sIP, udt) THEN
IF UBOUND(activeIp) < 0 THEN REDIM activeIp(0) ELSE REDIM PRESERVE activeIp(UBOUND(activeIp)+1)
activeIp(UBOUND(activeIp)) = TRIM$(udt.sipaddress) + "," + GetMACaddress((udt.sipaddress)) + ",UDP," + TRIM$(TcpPort) + ",Yes"
ELSEIF ISTRUE showall THEN
IF UBOUND(activeIp) < 0 THEN REDIM activeIp(0) ELSE REDIM PRESERVE activeIp(UBOUND(activeIp)+1)
activeIp(UBOUND(activeIp)) = sIP + ",,UDP," + TRIM$(TcpPort) + ",No"
END IF
DIALOG POST hDlg, %WM_USER + 501, INT((crt/tot)*65535), 0
END IF
NEXT j ' 192.168.__.__
NEXT k ' 192.__.__.__
NEXT l ' __.__.__.__
DIALOG POST hDlg, %WM_USER + 502, 0, 0 ' end of thread
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION UdpBroadCast (portnum AS LONG, sip AS STRING, udt AS ConCheckType) AS LONG
LOCAL nUDP, bip, rip, pNum AS DWORD
LOCAL answer AS STRING
bip = IP_REV(IP_LNG(sip))
udt.Connected = 0 ' init required
nUDP = FREEFILE
UDP OPEN AS #nUDP TIMEOUT 125 * SleepMinimum
UDP SEND #nUDP, AT bip, udt.PortNumber, "Ping"
UDP RECV #nUDP, FROM rip, pNum, answer ' remote IP
UDP CLOSE #nUDP
IF ERR = 0 THEN
udt.connected = 1 ' we received an answer
udt.sipaddress = IP_STR(rip)
END IF
FUNCTION = udt.connected
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION ConCheck (portnum AS LONG, sip AS STRING, udt AS ConCheckType) AS LONG
REM http://www.powerbasic.com/support/pb...ad.php?t=29719
REM Never needed to WAITFORSINGLEOBJECT Mike Doty 9/15/13
LOCAL hThread AS DWORD
udt.portnumber = portnum
udt.sipaddress = sip
THREAD CREATE IsConnectThread(VARPTR(udt)) TO hThread
SLEEP SleepMinimum ' milliseconds minimum in testing
THREAD CLOSE hThread TO hThread
FUNCTION = udt.connected
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
THREAD FUNCTION IsConnectThread (BYVAL Udt AS ConCheckType POINTER) AS DWORD
LOCAL nTCP AS LONG
nTCP = FREEFILE
@udt.Connected = 0 ' init required
TCP OPEN PORT @udt.PortNumber AT RTRIM$(@udt.sipaddress) AS nTCP&
IF ERR = 0 THEN
@udt.Connected = 1
TCP CLOSE nTCP
END IF
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION GetMACaddress(szIP AS ASCIIZ) AS STRING
LOCAL Result AS LONG
LOCAL MACbytes AS LONG
DIM ipArray(0) AS DWORD
DIM p AS BYTE PTR
FUNCTION = "Unknown" : IF LEN(TRIM$(szIP)) = 0 THEN EXIT FUNCTION
'The first six bytes of the array receive the physical address for the IP
'address specified by szIP. See "SendARP" in MSDN for more info.
MACbytes = 6
Result = SendARP(inet_addr(szIP), 0, ipArray(0), MACbytes)
IF Result = 0 THEN 'Success
p = VARPTR(ipArray(0))
FUNCTION = HEX$(@p, 2) & "-" & HEX$(@p[1], 2) & "-" & _
HEX$(@p[2], 2) & "-" & HEX$(@p[3], 2) & "-" & _
HEX$(@p[4], 2) & "-" & HEX$(@p[5], 2)
END IF
END FUNCTION
'DECLARE FUNCTION SendARP LIB "iphlpapi.dll" ALIAS "SendARP" _
' (BYVAL DestIP AS DWORD, BYVAL SrcIP AS DWORD, pMacAddr AS DWORD, _
' PhyAddrLen AS DWORD) AS DWORD
'DECLARE FUNCTION inet_addr LIB "wsock32.dll" ALIAS "inet_addr" (cp AS ASCIIZ) AS DWORD
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB LoadSession (BYVAL hDlg AS DWORD)
LOCAL ini AS STRING
LOCAL a AS ASCIIZ * %MAX_PATH
LOCAL i AS LONG
ini = LocalAppdata() + "\" + EXE.NAME$ + ".ini"
GetPrivateProfileString "Pref", "service", "SSH", a, %MAX_PATH, (ini)
COMBOBOX FIND EXACT hDlg, %IDC_COMBOBOX1, 1, (a) TO i
COMBOBOX SELECT hDlg, %IDC_COMBOBOX1, i
IF a = "Other" THEN CONTROL SEND hDlg, %IDC_TEXTBOX1, %EM_SETREADONLY, %FALSE, 0
GetPrivateProfileString "Pref", "port", "22", a, %MAX_PATH, (ini)
CONTROL SET TEXT hDlg, %IDC_TEXTBOX1, (a)
GetPrivateProfileString "Pref", "delay", "2", a, %MAX_PATH, (ini)
CONTROL SET TEXT hDlg, %IDC_TEXTBOX2, (a)
GetPrivateProfileString "Pref", "ip_start", "192.168.0.0", a, %MAX_PATH, (ini)
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_1, %IPM_SETADDRESS, 0, IP_LNG((a)) ' Set an initial IP address
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_1, %IPM_SETFOCUS, 3, 0 ' Set initial focus to last field
GetPrivateProfileString "Pref", "ip_end", "192.168.0.255", a, %MAX_PATH, (ini)
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_2, %IPM_SETADDRESS, 0, IP_LNG((a)) ' Set an initial IP address
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_2, %IPM_SETFOCUS, 3, 0 ' Set initial focus to last field
GetPrivateProfileString "Pref", "hide", "1", a, %MAX_PATH, (ini)
CONTROL SET CHECK hDlg, %IDC_CHECKBOX1, VAL(a)
GetPrivateProfileString "Pref", "udp", "0", a, %MAX_PATH, (ini)
CONTROL SET CHECK hDlg, %IDC_CHECKBOX2, VAL(a)
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB SaveSession (BYVAL hDlg AS DWORD)
LOCAL ini, e AS STRING
LOCAL ip AS DWORD
LOCAL i AS LONG
ini = LocalAppdata() + "\" + EXE.NAME$ + ".ini"
CONTROL GET TEXT hDlg, %IDC_COMBOBOX1 TO e
WritePrivateProfileString "Pref", "service", (e), (ini)
CONTROL GET TEXT hDlg, %IDC_TEXTBOX1 TO e
WritePrivateProfileString "Pref", "port", (e), (ini)
CONTROL GET TEXT hDlg, %IDC_TEXTBOX2 TO e
WritePrivateProfileString "Pref", "delay", (e), (ini)
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_1, %IPM_GETADDRESS, 0, VARPTR(ip)
WritePrivateProfileString "Pref", "ip_start", IP_STR(IP_REV(ip)), (ini)
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_2, %IPM_GETADDRESS, 0, VARPTR(ip)
WritePrivateProfileString "Pref", "ip_end", IP_STR(IP_REV(ip)), (ini)
CONTROL GET CHECK hDlg, %IDC_CHECKBOX1 TO i
WritePrivateProfileString "Pref", "hide", TRIM$(i), (ini)
CONTROL GET CHECK hDlg, %IDC_CHECKBOX2 TO i
WritePrivateProfileString "Pref", "udp", TRIM$(i), (ini)
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Sample Code **
'------------------------------------------------------------------------------
FUNCTION SampleComboBox(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG
LOCAL i AS LONG
CONTROL SEND hDlg, lID, %CB_SETEXTENDEDUI, %TRUE, 0
FOR i = LBOUND(protocols) TO UBOUND(protocols)
COMBOBOX ADD hDlg, lID, PARSE$(protocols(i), ":", 1)
NEXT
COMBOBOX SELECT hDlg, %IDC_COMBOBOX1, 1
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION SampleListView(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG
LOCAL lCol AS LONG
LOCAL lRow AS LONG
LOCAL lStyle AS LONG
LISTVIEW GET STYLEXX hDlg, lID TO lStyle
LISTVIEW SET STYLEXX hDlg, lID, lStyle OR %LVS_EX_FULLROWSELECT OR _
%LVS_EX_GRIDLINES
' Load column headers.
LISTVIEW INSERT COLUMN hDlg, lID, 1, "IP address", 0, 0
LISTVIEW INSERT COLUMN hDlg, lID, 2, "MAC address", 0, 0
LISTVIEW INSERT COLUMN hDlg, lID, 3, "Protocol", 0, 0
LISTVIEW INSERT COLUMN hDlg, lID, 4, "Port", 0, 0
LISTVIEW INSERT COLUMN hDlg, lID, 5, "Active", 0, 0
' Load sample data.
' FOR lRow = 1 TO 10
' LISTVIEW INSERT ITEM hDlg, lID, lRow, 0, USING$("Column # Row #", lCol, lRow)
' LISTVIEW SET TEXT hDlg, lID, lRow, 1, trim$(rnd(0,255))+"."+TRIM$(RND(0,255))+"."+TRIM$(RND(0,255))+"."+TRIM$(RND(0,255))
' LISTVIEW SET TEXT hDlg, lID, lRow, 2, lcase$(hex$(rnd(0,255)))+"-"+LCASE$(HEX$(RND(0,255)))+"-"+LCASE$(HEX$(RND(0,255)))+"-"+ _
' LCASE$(HEX$(RND(0,255)))+"-"+LCASE$(HEX$(RND(0,255)))+"-"+LCASE$(HEX$(RND(0,255)))
' LISTVIEW SET TEXT hDlg, lID, lRow, 3, iif$(rnd(0,1), "Yes", "No")
' NEXT lRow
' Auto size columns.
FOR lCol = 1 TO 5
LISTVIEW FIT HEADER hDlg, lID, lCol
NEXT lCol
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowMainDialog(BYVAL hParent AS DWORD) AS LONG
LOCAL lRes AS LONG
#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
LOCAL hDlg AS DWORD
DIALOG NEW PIXELS, hParent, "LAN Scanner v0.2", , , 336, 386, %WS_POPUP _
OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
DIALOG SET ICON hDlg, "AICO"
CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Scan for service :", 8, 8, 96, 16
CONTROL ADD COMBOBOX, hDlg, %IDC_COMBOBOX1, , 104, 4, 96, 16, %WS_CHILD _
OR %WS_VISIBLE OR %WS_TABSTOP OR %CBS_DROPDOWNLIST, _
%WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD LABEL, hDlg, %IDC_LABEL2, "port", 242, 8, 30, 16, _
%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR _
%WS_EX_LTRREADING
CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "22", 278, 6, 48, 18, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_LEFT OR %ES_CENTER OR _
%ES_AUTOHSCROLL OR %ES_READONLY OR %ES_NUMBER, %WS_EX_CLIENTEDGE OR _
%WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD LABEL, hDlg, %IDC_LABEL5, "Delay :", 8, 42, 40, 16
CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX2, "2", 48, 40, 30, 18, %WS_CHILD _
OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_CENTER OR %ES_AUTOHSCROLL _
OR %ES_NUMBER, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING _
OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD LABEL, hDlg, %IDC_LABEL6, "ms between each IP address", 80, 42, 144, 16
CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "SCAN", 232, 32, 96, 32
CONTROL ADD FRAME, hDlg, %IDC_FRAME1, "IP address options", 8, 74, 320, 112
CONTROL ADD LABEL, hDlg, %IDC_LABEL3, "Start at IP address", 24, 100, 88, 14
CONTROL ADD "SysIPAddress32", hDlg, %IDC_SYSIPADDRESS32_1, "192.168.0.0", _
120, 98, 192, 20, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
%WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_1, %IPM_SETADDRESS, 0, IP_LNG("192.168.0.0") ' Set an initial IP address
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_1, %IPM_SETFOCUS, 3, 0 ' Set initial focus to last field
CONTROL ADD LABEL, hDlg, %IDC_LABEL4, "and End at", 56, 125, 56, 17, _
%WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT, %WS_EX_LEFT OR %WS_EX_LTRREADING
CONTROL ADD "SysIPAddress32", hDlg, %IDC_SYSIPADDRESS32_2, _
"192.168.0.255", 120, 122, 192, 20, %WS_CHILD OR %WS_VISIBLE OR _
%WS_TABSTOP, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING _
OR %WS_EX_RIGHTSCROLLBAR
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_2, %IPM_SETADDRESS, 0, IP_LNG("192.168.0.255") ' Set an initial IP address
CONTROL SEND hDlg, %IDC_SYSIPADDRESS32_2, %IPM_SETFOCUS, 3, 0 ' Set initial focus to last field
CONTROL ADD CHECKBOX, hDlg, %IDC_CHECKBOX1, "Hide inactive IP addresses", 24, 154, 162, 16
CONTROL SET CHECK hDlg, %IDC_CHECKBOX1, 1
CONTROL ADD CHECKBOX, hDlg, %IDC_CHECKBOX2, "Test UDP broadcast", 194, 154, 122, 16
CONTROL SET CHECK hDlg, %IDC_CHECKBOX2, 0
CONTROL ADD LISTVIEW, hDlg, %IDC_LISTVIEW1, "Listview1", 8, 192, 320, 176
CONTROL ADD LABEL, hDlg, %IDC_LABEL8, "[About / Help]", 8, 370, 98, 17, _
%WS_CHILD OR %WS_VISIBLE OR %SS_NOTIFY, %WS_EX_LEFT OR %WS_EX_LTRREADING
CONTROL SET COLOR hDlg, %IDC_LABEL8, %BLUE, -1
CONTROL ADD LABEL, hDlg, %IDC_LABEL7, "Ready", 108, 370, 218, 17, _
%WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT, %WS_EX_LEFT OR %WS_EX_LTRREADING
CONTROL ADD PROGRESSBAR, hDlg, %IDC_PROGRESSBAR, "ProgressBar1", 8, 368, 320, 15
PROGRESSBAR SET RANGE hDlg, %IDC_PROGRESSBAR, 0, 65535
CONTROL SHOW STATE hDlg, %IDC_PROGRESSBAR, %SW_HIDE
#PBFORMS END DIALOG
SampleComboBox hDlg, %IDC_COMBOBOX1
SampleListView hDlg, %IDC_LISTVIEW1
DIALOG SHOW MODAL hDlg, CALL ProcMainDialog TO lRes
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP
FUNCTION = lRes
END FUNCTION
'------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------------------------------
FUNCTION ShowHelp (hParent AS DWORD) AS LONG
LOCAL hDlg AS DWORD
LOCAL w, h AS LONG
w = 336 : h = 320
DIALOG NEW PIXELS, hParent, EXE.NAME$ + " Help",,, w, h, %WS_POPUP OR %WS_CAPTION _
OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX _
OR %WS_VISIBLE OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT _
,%WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR _
, TO hDlg
CONTROL ADD "RichEdit", hDlg, 1000, "", 8, 2, w-16-16, h-70, _
%WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_READONLY _
OR %WS_VSCROLL CALL HelpProc
' Set RichEdit control background color as the Windows default background color for Dialogs:
SendMessage GetDlgItem(hDlg, 1000), %EM_SETBKGNDCOLOR, %FALSE, GetSysColor(%COLOR_3DFACE)
CONTROL ADD BUTTON, hDlg, %IDOK, "OK", (w-62-16)\2, h-64, 62, 24
SetParentIconAndCenter hDlg, hParent
DIALOG SHOW MODAL hDlg, CALL HelpProc
END FUNCTION
'---------------------------------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------------------------------
CALLBACK FUNCTION HelpProc
LOCAL richtext AS STRING
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
richtext += "[black][font:o,10]"
richtext += "[b]LAN Scanner[/b] is a free Windows utility that scans your local network by sending ARP packets and waiting response"
richtext += " to identify the devices (IP + MAC address) offering a service on a certain port." + $LF
richtext += "This tool works even when devices are behind a firewall, but it only allows to reach local devices" + $LF
richtext += " (the ARP packets do not go beyond your router)." + $LF
richtext += $LF
richtext += "[blue]After a scan, you can double-click the list to dump it into Notepad. Or click a column header to sort it.[black]" + $LF
richtext += $LF
richtext += "[b]LAN Scanner[/b] is a freeware developed by Nicolas Mougin on 14th November 2015." + $LF
richtext += $LF
richtext += "Find more at http://mougino.free.fr"
RTF_SET CB.HNDL, 1000, STRREPLACE(richtext, $LF, "[eol]") + "[eol][eop]"
CASE %WM_SIZE ' User resized the dialog
IF CB.WPARAM = %SIZE_MAXIMIZED OR CB.WPARAM = %SIZE_RESTORED THEN
LOCAL w, h AS LONG
DIALOG GET SIZE CB.HNDL TO w, h
CONTROL SET SIZE CB.HNDL, 1000, w-16-16, h-70
CONTROL SET LOC CB.HNDL, %IDOK, (w-62-16)\2, h-64
DIALOG REDRAW CB.HNDL
END IF
CASE %WM_NOTIFY
IF CB.NMCODE = %EN_LINK THEN RTF_hyperlink (CB.HNDL, CB.CTL, CB.LPARAM) ' Process Richedit hyperlinks
CASE %WM_COMMAND
IF CB.CTL = %IDOK AND (CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1) THEN DIALOG END CB.HNDL
END SELECT
END FUNCTION
'---------------------------------------------------------------------------------------------------------------------------