Difficulty: Medium 3/5
What this does-
This code will create a Statis.htm file that will display whether the server is up or down. The server will then send the file via FTP to a webserver. It is rilly easy to customise the file that the server makes to whatever you wan't, the main purpos of this code is the sending of the file to the webserver.
What you need-
A FTP accessable webserver.
The code-
All of this code is Server side.
First add the folowing code to the top of any module, I created a new modual called modStatis for this code. All of this code must go into the same modual!
Dim Statis As String
Dim ServerStatis As String
Dim ServerTime As String
Dim InternetConnection As Long
Dim FTPConnection As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
The last part of this code contains the functions that do the "dirty" woork. You'll see what they do in a second.
Now add this to the modual
Sub SaveStatis(Stat As Byte)
Dim SS As String
Dim SS0 As String
Dim SS1 As String
Dim SS2 As String
Dim Time As String
Dim Color As String
Dim CurrentTime As Variant
Dim FileName As String
Dim SaveFile As Boolean
Dim CloseFTP As Integer
FileName = App.Path & "\Statis.htm"
CurrentTime = Now '3:00 PM Jan 16, 2005
Time = Format(CurrentTime, "h:mm AMPM d, yyyy")
If Stat = 0 Then
SS = "Offline"
Color = "FF0000"
ElseIf Stat = 1 Then
SS = "Online"
Color = "00FF00"
ElseIf Stat = 2 Then
SS = "loading"
Color = "0000FF"
End If
SS0 = "<!-- " & Stat & " -->"
SS1 = " <td width='53%'><font color='#" & Color & "' face='Courier New, Courier, mono'>" & SS & "</font></td>"
SS2 = " <td width='72%'><font color='#999999' face='Courier New, Courier, mono'>" & Time & " (GMT -4:00)</font></td>"
Open FileName For Output As #1
Print #1, "<HTML>"
Print #1, "<HEAD>"
Print #1, "<TITLE>Server Statis</TITLE>"
Print #1, "</HEAD>"
Print #1, "<BODY>"
Print #1, SS0
Print #1, "<h1 align='center'><font color='#333399'>Server Statis</font></h1>"
Print #1, "<br></br><table width='18%' border='1' align='center'>"
Print #1, " <tr>"
Print #1, " <td width='47'>The server is</td>"
Print #1, SS1
Print #1, " </tr>"
Print #1, "</table>"
Print #1, "<table width='31%' border='1' align='center'>"
Print #1, " <tr>"
Print #1, " <td width='28%'>Last Changed</td>"
Print #1, SS2
Print #1, " </tr>"
Print #1, "</table>"
Print #1, "</BODY>"
Print #1, "</HTML>"
Close #1
If Stat >= 2 Then Exit Sub
If FileExist("DontUpdateStatis") = True Then Exit Sub
InternetConnection = InternetOpen("FTPControl", 1, vbNullString, vbNullString, 0)
If InternetConnection = 0 Then
MsgBox ("Error opening internet connection!")
Else
FTPConnection = InternetConnect(InternetConnection, "<FTP SERVER>", 0, "<USERNAME>", "<PASSWORD>", 1, 0, 0)
If FTPConnection = 0 Then MsgBox ("Error connecting to FTP server!")
End If
If FTPConnection <> 0 Then
SaveFile = FtpPutFile(FTPConnection, FileName, "Statis.htm", 1, 0)
If SaveFile = False Then MsgBox ("Error sending Statis.htm file to FTP server!")
CloseFTP = InternetCloseHandle(FTPConnection)
If CloseFTP = False Then MsgBox ("Error closing FTP connection!")
CloseFTP = InternetCloseHandle(InternetConnection)
If CloseFTP = False Then MsgBox ("Error closing internet connection!")
End If
End Sub
What this code does-
CurrentTime = Now
Time = Format(CurrentTime, "h:mm AMPM d, yyyy")
This code get's the current time and gives it a 2:00 PM June 16, 2005 format.
If Stat = 0 Then
SS = "Offline"
Color = "FF0000"
ElseIf Stat = 1 Then
SS = "Online"
Color = "00FF00"
ElseIf Stat = 2 Then
SS = "loading"
Color = "0000FF"
End If
Simple enough, this code uses the number that was passed into Sub SaveStatis to dertermin weather the server is Online, Offline, Or Loading and assigns the color that will be used to display the statis. (For ex, if the server is Online then "Online" will be colored green in the Statis.htm file.
SS0 = "<!-- " & Stat & " -->"
This is used so other programs can easly determin the server's statis
SS1 = " <td width='53%'><font color='#" & Color & "' face='Courier New, Courier, mono'>" & SS & "</font></td>"
SS2 = " <td width='72%'><font color='#999999' face='Courier New, Courier, mono'>" & Time & " (GMT -4:00)</font></td>"
The two most inprotant lines in the statis.htm file, they are the lines that display the server's statis and the time the file was updated.
Open FileName For Output As #1
Print #1, "<HTML>"
Print #1, "<HEAD>"
Print #1, "<TITLE>Server Statis</TITLE>"
Print #1, "</HEAD>"
Print #1, "<BODY>"
Print #1, SS0
Print #1, "<h1 align='center'><font color='#333399'>Server Statis</font></h1>"
Print #1, "<br></br><table width='18%' border='1' align='center'>"
Print #1, " <tr>"
Print #1, " <td width='47'>The server is</td>"
Print #1, SS1
Print #1, " </tr>"
Print #1, "</table>"
Print #1, "<table width='31%' border='1' align='center'>"
Print #1, " <tr>"
Print #1, " <td width='28%'>Last Changed</td>"
Print #1, SS2
Print #1, " </tr>"
Print #1, "</table>"
Print #1, "</BODY>"
Print #1, "</HTML>"
Close #1
This is the code that creates the Server.htm file, The file is in HTML format. This may look a little confusing at first, but It's not too bad when you look at it line by line.
If Stat >= 2 Then Exit Sub
You may have noticed that there is a "Loading" statis, this is mainly for the benifit of external programs. This line of code keeps the "Loading" statis from being sent to the webserver, mainly to save on the time it takes for the server to load.
If FileExist("DontUpdateStatis") = True Then Exit Sub
I'll get to this latter.
InternetConnection = InternetOpen("FTPControl", 1, vbNullString, vbNullString, 0)
This line opens an internet connection and saves the handel to "InternetConnection" This handel is required to open the FTP connection, and later close the internet connection.
If InternetConnection = 0 Then MsgBox ("Error opening internet connection!") Else FTPConnection = InternetConnect(InternetConnection, "<FTP SERVER>", 0, "<USERNAME>", "<PASSWORD>", 1, 0, 0) If FTPConnection = 0 Then MsgBox ("Error connecting to FTP server!") End If
As long as there is an internet connection this code will make a connection to the FTP server and save the handel to "FTPConnection", this handel is needed so the next bit of code can send the file. And so the FTP connection can be closed.
[size=18px]VERY INPORTANT!
Make shour that you change <FTP SERVER> to the FTP server's URL, <USERNAME> to you'r username, and <PASSWORD> to you'r password.
If FTPConnection <> 0 Then
SaveFile = FtpPutFile(FTPConnection, FileName, "Statis.htm", 1, 0)
If SaveFile = False Then MsgBox ("Error sending Statis.htm file to FTP server!")
This bit of code will send the Statis.htm file to the FTP server as long as there is a FTP connection.
CloseFTP = InternetCloseHandle(FTPConnection)
If CloseFTP = False Then MsgBox ("Error closing FTP connection!")
CloseFTP = InternetCloseHandle(InternetConnection)
If CloseFTP = False Then MsgBox ("Error closing internet connection!")
End If
End Sub
This code just cleans up so to speek, It closes the FTP connection and then the internet connection, in that order.
Ok, so now we are left with a sup that will send the server's Online/Offline statis to a FTP server. All that is left is to put in the sub's call's.
Att the very bottom of Sub InitServer() (In modGeneral) add:
Call SaveStatis(1)
At the top add:
Call SaveStatis(2)
And at the very bottom of Sub DestroyServer(), but BEFORE "End" add:
Call SaveStatis(0)
That's about it. If you rember befor I mentioned this bit of code:
If FileExist("DontUpdateStatis") = True Then Exit Sub
If you make a file called "DontUpdateStatis" (no extenshion) and put it in the server's directory the server won't send the Statis.htm file to the webhost, this is usfull during debugging, to save time starting and stopping the server.
I also highly recomend adding the following code to frmServer if is isn't allready there (CHECK, it might be there allready).
Private Sub Form_Terminate()
Call DestroyServer
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call DestroyServer
End Sub
One last thing, if you wan't to get a file from a FTP server, or if you wan't to deleat a file off of a FTP server you can use theas functions: (How they are use I'll leave up to you)
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Anyway, I hope this helps. :D
|