Script that e-mails the office when someone wins at solitaire

[kharnal]

I hope to edit this post with a link to one at some future date.

Until then, any other awesome things done in the office by my fellow IT professionals when encountered by slacking (looking up pr0n on company time).

 

[FOURSTAR]

creepy

 

[NoGodForMe]

Don't surf porn on my computer screen. Maybe a funny picture every now and then that's NSFW from a TW thread. TW is the screen that's up most of the time.

Porn can be done on the iPhone, Guess her Muff, and What Boyz Want are good sites.

 

[TheAnk]

should make it tell everyone how many tries it took too.

also, poop back and forth. forever.

 

[Spxnge]

Don't surf porn on my computer screen. Maybe a funny picture every now and then that's NSFW from a TW thread. TW is the screen that's up most of the time.

Porn can be done on the iPhone, Guess her Muff, and What Boyz Want are good sites.

W

T

F

F

F

F

 

[kharnal]

To: all.office@mycompany.com

[The President and CEO] just won at Solitaire.

It took him 42 tries!

Kind regards,
IT

 

[Hurricane Harold]

When someone leaves their computer unlocked, set their Outlook to automatically send out an e-mail at about the time they come back.

 

[Kray]

What, you've never beat off at work before?

 

[Xcursion]

Don't surf porn on my computer screen. Maybe a funny picture every now and then that's NSFW from a TW thread. TW is the screen that's up most of the time.

Porn can be done on the iPhone, Guess her Muff, and What Boyz Want are good sites.

So TW is up more than any work-related applications or information? You sound like a productive worker.

 

[SL83]

Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")


strDomain = Replace(strDNSDomain, ",DC=",".")
strDomain = Replace(strDomain, "DC=","")


strBase = "<LDAP://" & strDNSDomain & ">"

strFilter = "(&(objectCategory=person)(objectClass=user))"

strFilter = "(objectCategory=computer)"

strAttributes = "displayName,userAccountControl,mail"

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Set oDomain = GetObject("LDAP://" & strDNSDomain)
Set winLossVal = oDomain.Get("WinEvent.Solitaire.Streak")

Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF

Sub sendEmail(strEmail, solitaireWinLoss, msgFlag, Name, domain)
Accept input parameters
Dim email
Dim strMessage
Dim strName
Dim strDomain
Dim strMesagept2
email= strEmail
strMessage= msgFlag
strName = Name
strDomain = domain

If strMessage=1 then
strMessage="has just won "
strMessage2= "Solitaire Champion"
ElseIf strMessage=0 Then
strMessage="has just lost "
strMessage2= "Solitaire Loser"
End If

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Message Alert from Domain Administrator: " & strMessage2
objMessage.From = EMAIL_FROM
objMessage.To = email

objMessage.TextBody = "Hello Everybody!" & strName & ", has just finished a game of Solitaire! The outcome of the game was: "& VbCrLf & VbCrLf _
& solitaireWinLoss & VbCrLf & VbCrLf

'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = EMAIL_SERVER

'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoNTLM

'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "youruserid"

'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yourpassword"

'Server port number(typically 25)
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objMessage.Configuration.Fields.Update

objMessage.Send
Set objMessage = Nothing
End Sub

 

[DMAUL]

sl83 with the delivery

 

[Thingfish]

Somebody doesn't want to have a job any more

 

[dementia]

and ngfm wonders why he's a 55 y/o guy still stuck in a cubicle

 

[Kray]

Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")


strDomain = Replace(strDNSDomain, ",DC=",".")
strDomain = Replace(strDomain, "DC=","")


strBase = "<LDAP://" & strDNSDomain & ">"

strFilter = "(&(objectCategory=person)(objectClass=user))"

strFilter = "(objectCategory=computer)"

strAttributes = "displayName,userAccountControl,mail"

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Set oDomain = GetObject("LDAP://" & strDNSDomain)
Set winLossVal = oDomain.Get("WinEvent.Solitaire.Streak")

Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF

Sub sendEmail(strEmail, solitaireWinLoss, msgFlag, Name, domain)
Accept input parameters
Dim email
Dim strMessage
Dim strName
Dim strDomain
Dim strMesagept2
email= strEmail
strMessage= msgFlag
strName = Name
strDomain = domain

If strMessage=1 then
strMessage="has just won "
strMessage2= "Solitaire Champion"
ElseIf strMessage=0 Then
strMessage="has just lost "
strMessage2= "Solitaire Loser"
End If

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Message Alert from Domain Administrator: " & strMessage2
objMessage.From = EMAIL_FROM
objMessage.To = email

objMessage.TextBody = "Hello Everybody!" & strName & ", has just finished a game of Solitaire! The outcome of the game was: "& VbCrLf & VbCrLf _
& solitaireWinLoss & VbCrLf & VbCrLf

'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = EMAIL_SERVER

'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoNTLM

'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "youruserid"

'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yourpassword"

'Server port number(typically 25)
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objMessage.Configuration.Fields.Update

objMessage.Send
Set objMessage = Nothing
End Sub

Someone was bored, or googled the script.

 

[max]

and ngfm wonders why he's a 55 y/o guy still stuck in a cubicle

He has graduated to having a corner office... wherein he remotes to his cubicle from a meeting room.

 

[NoFiX]

Would be an easy hack, but adding the netcode would be tedious.

 

[NoGodForMe]

Yep, I'm still here, and get as much work done as the programmers who were fired, even if I'm surfing TW.

Great movie came out recently, it's called "The Company Men." You can find it on the torrents or go watch it in the theaters.
The Company Men - Wikipedia, the free encyclopedia

That is happening at my job right now, we're moving to another building, and I'll be in a 5x6 cubicle. But at this time I still have a job. I have many windows up on my computer screen. 2 are telnet windows to the mainframe, 1 is the company e-mail I never use, and 1 is the web.

 

[Validuz]

Company Men was a shit movie.

Are we supposed to feel sorry for the 6-7 figure jobs that were "lost"? Err, I mean, transferred to another company?

 

[Detox.enD]

this is a fucking great idea....

 

[vawlk]

2 telnet sessions to the mainframe.....

Can you not see the writing on your cubicle wall?