#include "fivewin.ch"#DEFINE RDD_SYS
"DBFCDX"#DEFINE RDD_ACCT
"DBFCDX"REQUEST DBFCDX
#define nWaitTime
1000static oWnd, oSocket, oTimer, nTry, nTries, cIPAddress, lConnectOK, lGoOn
static lDialog, lSendEmail, lStatusUpdate, lEmailToMe
static cFileName
static lDebug
function main
( cParam1, cParam2, cParam3, cParam4
) local oDlg
local cAddress :=
' ' local nCounter
local cPath
local aResults
local oMail, cSubject, cMsg
local lUseHtml
local cParams
local aDir
lSendEmail := .f.
lUseHtml := .t.
lDebug := upper
( getenv
("clipdebug") ) =
'ON' if lDebug
ALTD
(1) wait
else ALTD
(0) endif set epoch
to year(date
())-50 rddsetdefault
( RDD_SYS
) if cParam1 ==
nil cParam1 :=
'' endif if cParam2 ==
nil cParam2 :=
'' endif if cParam3 ==
nil cParam3 :=
'' endif if cParam4 ==
nil cParam4 :=
'' endif cParams := upper
(cParam1+cParam2+cParam3+cParam4
) lDialog := .f.
cFileName :=
'testip' if '/DIALOG' $ cParams
lDialog := .t.
endif if '/FORCEEMAIL' $ cParams
lSendEmail := .t.
else lSendEmail := .f.
endif if '/STATUS' $ cParams
lStatusUpdate := .t.
else lStatusUpdate := .f.
endif if '/TOME' $ cParams
lEmailToMe := .t.
else lEmailToMe := .f.
endif nTries :=
10 // # tries to connect before giving up lGoOn := .t.
DEFINE WINDOW oWnd
TITLE "Test IP socket" from 2,
2 to 25,
70 // DEFINE BUTTONBAR oBar OF oWnd _3D //DEFINE BUTTON OF oBar ACTION Client() TOOLTIP "Connect" if lDialog
@
1.2,
2 SAY "IP Address:" OF oWnd
@
1.4,
10 GET cAddress
OF oWnd
PICTURE "@!K" SIZE 200,
20 @
4,
2 BUTTON "&Ok" OF oWnd
SIZE 50,
20 default ;
ACTION Test1Ip
( cAddress
) @
4,
15 BUTTON "&Cancel" OF oWnd
SIZE 50,
20 ACTION (lGoOn := .f., oWnd:
end()) else @
1.2,
2 SAY "Running preset tests" OF oWnd
@
4,
15 BUTTON "&Cancel" OF oWnd
SIZE 50,
20 ACTION (lGoOn := .f.
) endif if lDialog
ACTIVATE WINDOW oWnd
else ACTIVATE WINDOW oWnd
on init TestAllIp
() endifreturn nilfunction TestAllIp
() if .not. file
( cFileName+
'.dbf' ) CreateIpFile
( cFileName
) endif use
( cFileName
) share
if flock
() do while .not. eof
() if rlock
() replace ltestdate with date
() replace ltesttime with time
() if Test1IP
( trim
( IPAddr
) ) replace ltestresu with
'Passed' else replace ltestresu with
'Failed' endif if ( ltestresu =
'Failed' .or. lSendEmail
) .and. !lStatusUpdate
msginfo( 'IP quick check: '+trim
(ltestresu
)+
' for '+trim
(ipname
)+
' IP: '+trim
( IPAddr
) ) // If you setup the email then uncomment below // sendemail() endif endif //tracelog( trim( IPAddr), trim(IPName), ltestresu, ltestdate, ltesttime ) if !lGoOn
go bottom
endif skip
enddo dbunlock
() if lGoOn .and. lStatusUpdate
go top
xbrowse() // If you setup the email then uncomment below // sendemail( lStatusUpdate ) endif else msginfo( 'Cannot lock '+cFileName
) // If you setup the email then uncomment below // senderror( 'Cannot lock '+cFileName) endif oWnd:
end()return nilfunction test1IP
( cAddress
) local lGoOn := .t.
local nCounter
local cPath
local aResults
local lSendEmail
local oMail, cSubject, cMsg
local lUseHtml
local aDir
if oSocket !=
NIL oSocket:
End() endif if oTimer !=
NIL oTimer:
End() endif if val
( cAddress
) =
0 cIPAddress := gethostbyname
( cAddress
) else cIPAddress := trim
( cAddress
) endif //tracelog( val( cAddress ), cAddress, cIPAddress ) lConnectOK := .f.
nTry :=
1 oSocket = TSocket
():
New( 80 ) oSocket:
lDebug := .t.
oSocket:
cLogFile :=
'test.log' //oSocket:bRead = { | oSocket | MsgInfo( oSocket:GetData() ) } // Never use a MsgInfo() here because it hangs Windows!!! oSocket:
bConnect =
{ || lConnectOK := .T.
} oSocket:
bClose =
{ ||
if( lDialog,
MsgInfo( "Server has closed!" ), .t.
) } // oSocket:Connect( cIPAddress ) // use the server IP address here Timer_Connect
() Define Timer oTimer
Interval nWaitTime
Action Timer_Connect
() OF oWnd
Activate Timer oTimer
Do While nTry <= nTries .and. !lConnectOK .and. lGoOn
SysWait
(1) SysRefresh
() Loop
Enddo oTimer:
End() oSocket:
End() if lConnectOK
oWnd:
SetText( "Address "+cIPAddress+
" OK" ) if lDialog
MsgInfo("Connection ESTABLISHED") endif else oWnd:
SetText( "Socket Closed" ) if lDialog
MsgInfo("Connection can NOT be ESTABLISHED") endif endif /*
if lConnectOK
oWnd:SetText( 'Test ok for '+cIPAddress )
msginfo( 'Test ok for '+cIPAddress )
else
oWnd:SetText( 'Test failed for '+cIPAddress )
msginfo( 'Test failed for '+cIPAddress )
endif
*/return( lConnectOK
)function Timer_Connect
() IF nTry <= nTries .and. !lConnectOK
if nTry >
1 oWnd:
SetText("Connection Try : "+ALLTRIM
(STR
(nTry
))) endif oSocket:
Connect( cIPAddress
) nTry++
endifreturn nilfunction senderror
( cMessage
) local oMail, cSubject, cMsg
local cTo
local lWasFailure
cSubject :=
'Error during IP quick check: '+cMessage
// The following code only works with OSSMTP email component oMail := CreateObject
("OSSMTP.SMTPSession") oMail:
Server :=
"smtp.mydomain.com" oMail:
MailFrom :=
"myuser@mydomain.com" oMail:
RaiseError := .f.
oMail:
AuthenticationType :=
2 oMail:
Password :=
'mypassword' oMail:
POPServer :=
'pop.mydomain.com' oMail:
Username :=
'myuser@mydomain.com' if lSendStatus ==
nil lSendStatus := .f.
endif lWasFailure := .f.
cMsg :=
[<html>
]+CRLF
cMsg +=
[<head>
]+CRLF
cMsg +=
[<meta http-equiv =
"Content-Language" content =
"en-us">
]+CRLF
cMsg +=
[<meta http-equiv =
"Content-Type" content =
"text/html; charset=windows-1252">
]+CRLF
cMsg +=
[<title>IP test notification
]+
[</title>
]+CRLF
cMsg +=
[</head>
]+CRLF
cMsg +=
[<body>
]+CRLF
cMsg +=
[Error occurred
when running the IP quick check program<br>
]+CRLF
cMsg +=
[The test could not complete so the status
of the IP address is unknown
at this time<br>
]+CRLF
cMsg +=
[<br> </body>
]+CRLF
cMsg +=
[</html>
] oMail:
MessageSubject := cSubject
oMail:
MessageHTML := cMsg
if lDebug .or. lEmailToMe
cTo := gete
("USERNAME")+
"@mydomain.com" else cTo :=
"Security.Notice@mydomain.com" if !lSendStatus .and. .not. empty
( emailerr
) cTo +=
','+trim
( emailerr
) endif endif oMail:
SendTo := cTo
oMail:
SendEmail()return nilfunction sendemail
( lSendStatus
) local oMail, cSubject, cMsg
local cTo
local lWasFailure
if lSendStatus ==
nil lSendStatus := .f.
endif lWasFailure := .f.
if lSendStatus
go top
do while .not. eof
() if ltestresu =
'Failed' lWasFailure := .t.
exit
endif skip
enddo cSubject :=
'IP Staus Update' if lWasFailure
cSubject +=
' -- Failure(s) found!!' endif else cSubject :=
'IP quick check: '+trim
(ltestresu
)+
' for '+trim
(ipname
)+
' IP: '+trim
( IPAddr
) endif // The following code only works with OSSMTP email component oMail := CreateObject
("OSSMTP.SMTPSession") oMail:
Server :=
"smtp.mydomain.com" oMail:
MailFrom :=
"myuser@mydomain.com" oMail:
RaiseError := .f.
oMail:
AuthenticationType :=
2 oMail:
Password :=
'mypassword' oMail:
POPServer :=
'pop.mydomain.com' oMail:
Username :=
'myuser@mydomain.com' cMsg :=
[<html>
]+CRLF
cMsg +=
[<head>
]+CRLF
cMsg +=
[<meta http-equiv =
"Content-Language" content =
"en-us">
]+CRLF
cMsg +=
[<meta http-equiv =
"Content-Type" content =
"text/html; charset=windows-1252">
]+CRLF
cMsg +=
[<title>IP test notification
]+
[</title>
]+CRLF
cMsg +=
[</head>
]+CRLF
cMsg +=
[<body>
]+CRLF
if lSendStatus
cMsg +=
[<table border=
"1" width=
"600" id=
"table1">
]+CRLF
cMsg +=
[<tr>
]+CRLF
cMsg +=
[ <td align=
"center" width=
"50">Name</td>
]+CRLF
cMsg +=
[ <td align=
"center" width=
"50">IP Address</td>
]+CRLF
cMsg +=
[ <td align=
"center" width=
"40">Status</td>
]+CRLF
cMsg +=
[ <td align=
"center" width=
"50">CheckDate</td>
]+CRLF
cMsg +=
[ <td align=
"center" width=
"50">Time</td>
]+CRLF
cMsg +=
[</tr>
]+CRLF
go top
do while .not. eof
() cMsg +=
[<tr>
]+CRLF
cMsg += HTMLRecord
( trim
(ipname
) ) cMsg += HTMLRecord
( trim
(ipaddr
) ) cMsg += HTMLRecord
( trim
(ltestresu
) ) cMsg += HTMLRecord
( dtoc
(ltestdate
),
'Center' ) cMsg += HTMLRecord
( ltesttime,
'Center' ) cMsg +=
[</tr>
]+CRLF
skip
enddo cMsg +=
[</table>
]+CRLF
else cMsg +=
[Test
of IP Address:
]+trim
(ltestresu
)+
[<br>
]+CRLF
cMsg +=
[When:
]+dtoc
( ltestdate
)+
' at '+ltesttime+
[<br>
]+CRLF
cMsg +=
[Where:
]+trim
( ipname
)+
[<br>
]+CRLF
cMsg +=
[IP Address:
]+trim
( IPAddr
)+
[<br>
]+CRLF
endif cMsg +=
[<br> </body>
]+CRLF
cMsg +=
[</html>
] oMail:
MessageSubject := cSubject
oMail:
MessageHTML := cMsg
if lDebug .or. lEmailToMe
cTo := gete
("USERNAME")+
"@mydomain.com" else cTo :=
"Security.Notice@mydomain.com" if !lSendStatus .and. .not. empty
( emailerr
) cTo +=
','+trim
( emailerr
) endif endif oMail:
SendTo := cTo
oMail:
SendEmail()return nilfunction HTMLRecord
( cData, cAlign
) local cText
if cAlign ==
nil cAlign :=
'Left' endif cText :=
[ <td align=
"]+cAlign+["] if ltestresu =
'Failed' cText +=
[ bgcolor=
"#FF0000"><b>
] else cText +=
[>
] endif cText += cData
if ltestresu =
'Failed' cText +=
[</b>
] endif cText +=
[</td>
]+CRLF
return cText
function CreateIpFile
( cFile
) local aDbf, aHosts, cSub1, cSub2
aDbf :=
{} aadd
( aDbf,
{ "IPADDR",
"C",
20,
0 } ) // IP address or name like aadd
( aDbf,
{ "IPNAME",
"C",
25,
0 } ) // Name of Addressame like aadd
( aDbf,
{ "LTESTDATE",
"D",
8,
0 } ) // Last Test Date aadd
( aDbf,
{ "LTESTTIME",
"C",
8,
0 } ) // Last Test Time aadd
( aDbf,
{ "LTESTRESU",
"C",
20,
0 } ) // Last Test Reslult aadd
( aDbf,
{ "EMAILERR",
"C",
200,
0 } ) // Email errors to seperated by comma's dbcreate
( cFile, aDbf
) // Add 3 records for starters // Current IP address and 1 on each side INETINIT
() aHosts = INETGETHOSTS
( NETNAME
() ) INETCLEANUP
() cSub1 :=
substr( aHosts
[ 1 ],
1, rat
('.',aHosts
[ 1 ]) ) cSub2 :=
substr( aHosts
[ 1 ], rat
('.',aHosts
[ 1 ])+1 ) use
( cFileName
) share
append blank
replace ipaddr with aHosts
[ 1 ] replace ipname with NETNAME
() append blank
replace ipaddr with cSub1+alltrim
(str
(val
(cSub2
)-1)) replace ipname with NETNAME
()+
' -1' //GetHostByAddress(trim(ipaddr)) append blank
replace ipaddr with cSub1+alltrim
(str
(val
(cSub2
)+1)) replace ipname with NETNAME
()+
' +1' //GetHostByAddress(trim(ipaddr)) use
return nil 
