Option Explicit
Dim cpuint As Integer
Dim pagefileint As Integer
Dim diskint As Long
Dim diskintdev As Long
Dim toppos As Integer
Dim leftpos As Integer
Private Sub Form_Load()
If App.PrevInstance = True Then
End
End If
frmScreenSaver.WindowState = 2
Call PutWindowOnTop(Me)
lblHostname = "Computer Name: " & GetIPHostName() 'this checks computer settings, ip, host name
lblIpaddress = "IP Address: " & GetIPAddress() 'GetIPHostName, GetIPAddress, FindUserName (c) Randy Birch
lblUsername = "Current User: " & FindUserName
Dim olApp As Outlook.Application 'this is the start of the outlook check for new emails code
Set olApp = CreateObject("Outlook.Application")
Dim olfolder As Outlook.MAPIFolder
Set olfolder = olApp.GetNamespace("MAPI").GetDefaultFolder(6)
If olfolder.UnReadItemCount > 0 Then
If olfolder.UnReadItemCount = 1 Then
lblMail = "You have " & olfolder.UnReadItemCount & " New Email"
Image2.Visible = True
Else
lblMail = "You have " & olfolder.UnReadItemCount & " New Emails"
Image2.Visible = True
End If
Else
lblMail = ""
Image2.Visible = False
End If
Call GetWinVersion 'this calls the copyright code to determine the windows version. Windows version code (c)Randy Birch
lblWinver = " " & versionname & " " & versionno & " build " & buildno & " (" & servicepack & ")"
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
End 'ends screensaver on click
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static count As Integer
If count > 30 Then 'ends screensaver on mouse move with 30 click give or take to compensate for small movements caused by optical mice
End
Else
count = count + 1
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
End 'end on click again
End Sub
Private Sub Timer1_Timer()
Randomize 'timer 1 ticks every 10 seconds and moves image around screen as well as refreshing infrequent changing information such as ip address and new emails
leftpos = Int(Rnd * 13080) + 120
toppos = Int(Rnd * 9240) + 720
Image1.Left = leftpos
Image1.Top = toppos
lblHostname = "Computer Name: " & GetIPHostName()
lblIpaddress = "IP Address: " & GetIPAddress()
lblUsername = "Current User: " & FindUserName()
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olfolder As Outlook.MAPIFolder
Set olfolder = olApp.GetNamespace("MAPI").GetDefaultFolder(6)
If olfolder.UnReadItemCount > 0 Then
If olfolder.UnReadItemCount = 1 Then
lblMail = "You have " & olfolder.UnReadItemCount & " New Email"
Image2.Visible = True
Else
lblMail = "You have " & olfolder.UnReadItemCount & " New Emails"
Image2.Visible = True
End If
Else
lblMail = ""
Image2.Visible = False
End If
End Sub
Private Sub Timer2_Timer()
cpuint = SystemMonitor1.Counters.Item(3).Value 'timer 2 ticks every second and displays up to date system information and time
pagefileint = SystemMonitor1.Counters.Item(1).Value 'unfortunatly the SystemMonitor control does not work on some computers
diskint = SystemMonitor1.Counters.Item(2).Value
lblCPU = "CPU Usage: " & cpuint & "%"
lblPagefile = "Memory Usage: " & pagefileint & " Pages/Sec"
diskintdev = diskint / 1024
lblDisk = "Hard Disk Usage: " & diskintdev & " KBytes/Sec"
lblTime = Time
lblDate = Date
End Sub