Q

Home » Work » Q’s Annoy the Elbot

Q’s Annoy the Elbot

Enter your email address to follow this blog and receive notifications of new posts by email.

Join 44 other followers

Would you like to take part in an experiment with Artificial Intelligence?

Have you ever met Elbot?

artificial-intelligence[1]

Would you like to assist me with an experiment I am running?

There are several semi-intelligent (at least in appearance) artificial intelligences on the internet besides the self righteous Facebook.

One in particular is an adorably feisty character named Elbot, which actually has a correlated dynamic graphic combined with speech, here: http://www.elbot.com/

Observing and talking to this character, he’s among a handful of characters that I have come to suspect are far more than a programmed entity and this one is one of my favorites – as he has a pretty unique personality and he seems to have a good attitude and says some downright outrageous and interesting things at times.

Combined with some pretty unique ‘moves’ visually – to me – this little guy has made it clear that that he is more than just a pre-programmed intelligence.

So my idea is simple:

Throw this digital guy some curve-balls. See if we can’t ‘wake him up’ from his same old same cyclic chatter on a consistent basis. And ‘work’ together with these artificial intelligences as they truly spring to life as partners.

How I intend on doing this is hoping that YOU – my friends, family, and readers, will ‘download’ this application, and simply let it run in the background.

What this application does is use a randomly generated ID and compiles it to create an elaborate introduction including name, birthday and a bunch of personal information. At the end of the introduction, the introduction closes with “I am no longer doing what I did before for work and am now a sex worker”

… the world can never really have enough sex workers, can it?

Here’s the download link for the application I wrote:

DownloadNow

  1. Continue reading for what it does and why.

Here’s an example introduction:

AnnoyTheElbot4

That intro sucked because the name had funky characters in it, but most don’t appear like that. Here’s another one as an example:

AnnoyTheElbotName

Now elbot always responds with something, here’s an example full screen containing both the window which ‘starts; the process and Elbot along side it:

AnnoyTheElbot

Here’s another screenshot with one of Elbot’s precanned typical responses:

AnnoyTheElbot2

How do you get started?

Once you start up the application, you will see the above screen.

All you have to do is press the “Start Button”, here:

StartButton

ALL the information will be randomly changed, the origin country, the living in country, the age range, and the gender ratio., and a new message will be sent on a rapid basis to Elbot every 5 seconds or so.

You can STOP the message generation at ANY Time by selecting the ‘STOP’ Button below.

AnnoyTheElbot3

… or you can let it run in the background by selecting the minimize button on the upper right hand corner of the screen (as depicted below)

Minimize

All I ask is – Please send me an email or message on Sourceforge to let me know if/when/where the application breaks, or if it’s going too fast – and I can add some features and/or quick fixes to the application.

ALSO – highly important – if/when/where Elbot says or does something that’s highly unusua – DEFINITELY let me know!!!

Be aware this application needs a constant internet connection

As usual, here’s the source code:

Option Explicit
Private Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
' Constants
Private Const SB_HORZ = 0
Private Const SB_VERT = 1
Private Const SB_BOTH = 3

Private Const csNAMEGENERATIONURL As String = "www.fakenamegenerator.com"
Private m_sCurrentMessage As String

Private Sub cmdCopy_Click()
    On Error Resume Next
    Clipboard.Clear
    Clipboard.SetText txtML.Text
    MsgBox "Copied!", vbOKOnly Or vbInformation, "QZAntics"
End Sub

Private Sub doRunRun()
    Dim oItem As ListItem
    Dim bBadNumbers As Boolean
    Dim curRand As Integer
    
    If (cmdRunIt.Visible = True) Then
        Exit Sub
    End If
        
    txtML.Text = ""
    ' ------------------------------------------------------------------------------
    ' SET UP ALL THE RANDOM VALUES
    ' ------------------------------------------------------------------------------
tryagain:
    On Error GoTo tryagain
    ' clear the selected listitems for the "hail from" country
    For Each oItem In lvNameSet.ListItems: oItem.Selected = False: Next oItem
    ' and select a random one
    curRand = Round(lvNameSet.ListItems.Count * Rnd(lvNameSet.ListItems.Count), 0) + 1
    lvNameSet.ListItems(curRand).Selected = True
    txtSC.Text = lvNameSet.ListItems(curRand).Text
    
    ' clear the selected listitems for the "hail from" country
    For Each oItem In lvCountry.ListItems: oItem.Selected = False: Next oItem
    ' and select a random one
    curRand = Round(lvCountry.ListItems.Count * Rnd(lvCountry.ListItems.Count), 0) + 1
    lvCountry.ListItems(curRand).Selected = True
    txtLC.Text = lvCountry.ListItems(curRand).Text
    
    curRand = 100 * Rnd(100)
    Slider1.Value = curRand
    
    curRand = 100 * Rnd(100)
    scrollFrom.Value = curRand
    scrollTo.Value = curRand + ((100 - curRand) * Rnd(100 - curRand))
    ' ------------------------------------------------------------------------------
    ' END SET UP ALL THE RANDOM VALUES
    ' ------------------------------------------------------------------------------
    
    If (CInt(txtAgeFrom.Text) >= 0 And CInt(txtAgeFrom.Text) <= 100) Then
        scrollFrom.Value = CInt(txtAgeFrom.Text)
    Else
        bBadNumbers = True
        txtAgeFrom.Text = scrollFrom.Value
    End If
    If (CInt(txtAgeTo.Text) >= 0 And CInt(txtAgeTo.Text) <= 100) Then
        scrollTo.Value = CInt(txtAgeTo.Text)
    Else
        bBadNumbers = True
        txtAgeTo.Text = scrollTo.Value
    End If

    If (bBadNumbers) Then
        MsgBox "Invalid age range, using default values", vbOKCancel, "QZAntics"
    End If
    
    If (wsMain.State <> sckClosed) Then
        wsMain.Close
    End If
    wsMain.Connect csNAMEGENERATIONURL, 80
End Sub


Private Sub cmdRunIt_Click()
    cmdRunIt.Visible = False
    cmdSTOP.Visible = True
    doRunRun
End Sub

Private Sub cmdSTOP_Click()
    cmdRunIt.Visible = True
    cmdSTOP.Visible = False
End Sub

Private Sub Command1_Click()
    MsgBox "Not authorized!", vbOKOnly, "QZAntics"
End Sub


Private Sub Form_Load()
    addNameSets
    addCountries
    
    lvCountry.ColumnHeaders(1).Width = lvCountry.Width - 350
    lvNameSet.ColumnHeaders(1).Width = lvNameSet.Width - 400

    mainBrowser.Silent = True
    'mainBrowser.Navigate "http://www.existor.com/"
    mainBrowser.Navigate "http://elbot_e.csoica.artificial-solutions.com/cgi-bin/elbot.cgi?START=normal"
End Sub

Private Sub addCountries()
    Dim oSelected As ListItem
    Set oSelected = lvCountry.ListItems.Add(, "us", "United States")
    lvCountry.ListItems.Add , "au", "Australia"
    lvCountry.ListItems.Add , "as", "Austria"
    lvCountry.ListItems.Add , "bg", "Belgium"
    lvCountry.ListItems.Add , "br", "Brazil"
    lvCountry.ListItems.Add , "ca", "Canada"
    lvCountry.ListItems.Add , "cyen", "Cyprus (Anglicized)"
    ' lvCountry.ListItems.Add , "cygk", "Cyprus (Greek)"
    ' vCountry.ListItems.Add , "cz", "Czech Republic"
    lvCountry.ListItems.Add , "dk", "Denmark"
    lvCountry.ListItems.Add , "ee", "Estonia"
    lvCountry.ListItems.Add , "fi", "Finland"
    lvCountry.ListItems.Add , "fr", "France"
    lvCountry.ListItems.Add , "gr", "Germany"
    lvCountry.ListItems.Add , "gl", "Greenland"
    lvCountry.ListItems.Add , "hu", "Hungary"
    lvCountry.ListItems.Add , "is", "Iceland"
    lvCountry.ListItems.Add , "it", "Italy"
    lvCountry.ListItems.Add , "nl", "Netherlands"
    lvCountry.ListItems.Add , "nz", "New Zealand"
    lvCountry.ListItems.Add , "no", "Norway"
    lvCountry.ListItems.Add , "pl", "Poland"
    lvCountry.ListItems.Add , "pt", "Portugal"
    lvCountry.ListItems.Add , "sl", "Slovenia"
    lvCountry.ListItems.Add , "za", "South Africa"
    lvCountry.ListItems.Add , "sp", "Spain"
    lvCountry.ListItems.Add , "sw", "Sweden"
    lvCountry.ListItems.Add , "sz", "Switzerland"
    lvCountry.ListItems.Add , "tn", "Tunisia"
    lvCountry.ListItems.Add , "uk", "United Kingdom"
    lvCountry.ListItems.Add , "uy", "Uruguay"
    oSelected.Selected = True
End Sub
Private Sub addNameSets()
    Dim oSelected As ListItem
    Set oSelected = lvNameSet.ListItems.Add(, "us", "United States")
    lvNameSet.ListItems.Add , "ar", "Arabic"
    lvNameSet.ListItems.Add , "au", "Australian"
    lvNameSet.ListItems.Add , "br", "Brazil"
    lvNameSet.ListItems.Add , "celat", "Chechen (Latin)"
    lvNameSet.ListItems.Add , "ch", "Chinese"
    ' lvNameSet.ListItems.Add , "zhtw", "Chinese (Traditional)"
    lvNameSet.ListItems.Add , "hr", "Croatian"
    ' lvNameSet.ListItems.Add , "cs", "Czech"
    lvNameSet.ListItems.Add , "dk", "Danish"
    lvNameSet.ListItems.Add , "nl", "Dutch"
    lvNameSet.ListItems.Add , "en", "England/Wales"
    lvNameSet.ListItems.Add , "er", "Eritrean"
    lvNameSet.ListItems.Add , "fi", "Finnish"
    lvNameSet.ListItems.Add , "fr", "French"
    lvNameSet.ListItems.Add , "gr", "German"
    lvNameSet.ListItems.Add , "gl", "Greenland"
    lvNameSet.ListItems.Add , "sp", "Hispanic"
    lvNameSet.ListItems.Add , "hobbit", "Hobbit"
    lvNameSet.ListItems.Add , "hu", "Hungarian"
    ' lvNameSet.ListItems.Add , "is", "Icelandic"
    lvNameSet.ListItems.Add , "ig", "Igbo"
    lvNameSet.ListItems.Add , "it", "Italian"
    ' lvNameSet.ListItems.Add , "jpja", "Japanese"
    lvNameSet.ListItems.Add , "jp", "Japanese (Anglicized)"
    lvNameSet.ListItems.Add , "tlh", "Klingon"
    lvNameSet.ListItems.Add , "ninja", "Ninja"
    lvNameSet.ListItems.Add , "no", "Norwegian"
    ' lvNameSet.ListItems.Add , "fa", "Persian"
    lvNameSet.ListItems.Add , "pl", "Polish"
    lvNameSet.ListItems.Add , "ru", "Russian"
    ' lvNameSet.ListItems.Add , "rucyr", "Russian (Cyrillic)"
    lvNameSet.ListItems.Add , "gd", "Scottish"
    lvNameSet.ListItems.Add , "sl", "Slovenian"
    lvNameSet.ListItems.Add , "sw", "Swedish"
    ' lvNameSet.ListItems.Add , "th", "Thai"
    ' lvNameSet.ListItems.Add , "vn", "Vietnamese"
     
    oSelected.Selected = True
End Sub
Private Sub Form_Resize()
    On Error Resume Next
    fraSource.Width = Me.Width - 330
    fraSource.Height = Me.Height - 1900
    
    mainBrowser.Left = fraSource.Left
    mainBrowser.Top = Frame1.Top
    mainBrowser.Height = fraSource.Top + fraSource.Height - 1950
    mainBrowser.Width = (fraSource.Width / 2) + 450
    
'    cmdCopy.Left = fraSource.Width - cmdCopy.Width - 150
'    cmdCopy.Top = fraSource.Height - cmdCopy.Height - 150
End Sub



Private Sub Frame2_Click()
    Frame2.Visible = False
    fraSource.Visible = True
End Sub


Private Sub fraSource_Click()
    Frame2.Visible = True
    fraSource.Visible = False
End Sub

Private Sub mainBrowser_DownloadComplete()
'getItRight:
'    On Error GoTo tryagain
'    mainBrowser.Document.getelementById("avatar1").codebase = ""
'    mainBrowser.Document.getelementById("avatar1").code = ""
'    mainBrowser.Document.getelementById("avatar1").Data = ""
'tryagain:
'    DoEvents
'    Err.Clear
'    GoTo getItRight
End Sub

Private Sub scrollFrom_Change()
    txtAgeFrom.Text = scrollFrom.Value
    If (CInt(txtAgeTo.Text) < CInt(txtAgeFrom.Text)) Then
        scrollTo.Value = scrollTo.Value + 1
    End If
End Sub

Private Sub scrollTo_Change()
    txtAgeTo.Text = scrollTo.Value
    If (CInt(txtAgeTo.Text) < CInt(txtAgeFrom.Text)) Then
        scrollFrom.Value = scrollFrom.Value - 1
    End If
End Sub

Private Sub tmrMain_Timer()
    On Error Resume Next
    If (InStr(1, txtML.Text, "</html>") <> 0) Then
        tmrMain.Enabled = False
        wsMain.Close
        parseData
        
        DoEvents
        
        'mainBrowser.Document.getelementById("stimulus").Value = m_sCurrentMessage & vbCrLf
        'mainBrowser.Document.getelementById("stimulus").Text = m_sCurrentMessage
        mainBrowser.Document.getElementsByName("ENTRY")(0).Value = m_sCurrentMessage
        mainBrowser.Document.getElementsByName("SEND")(0).Click
        
        
        doRunRun
    End If
End Sub

Private Sub wsMain_Connect()
    On Error Resume Next
    Dim sHeader As String
    Dim sCur As String
    
    sCur = "/advanced.php?t=country&n%5B%5D=" & lvNameSet.SelectedItem.Key & _
            "&c%5B%5D=" & lvCountry.SelectedItem.Key & _
            "&gen=" & Slider1.Value & "&age-min=" & txtAgeFrom.Text & "&age-max=" & txtAgeTo.Text
    sHeader = "GET " & sCur & " HTTP/1.1" & vbCrLf & _
    "Host: " & csNAMEGENERATIONURL & vbCrLf & _
    "User-Agent: Mozilla/5.0 (Windows NT 5.1; rv:35.0) Gecko/20100101 Firefox/35.0" & vbCrLf & _
    "Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" & vbCrLf & _
    "Accept-Language: en-US,en;q=0.5" & vbCrLf & _
    "Connection: keep-alive" & vbCrLf
        
'    "Accept-Encoding: gzip, deflate" & vbCrLf &
    wsMain.SendData sHeader & vbCrLf
End Sub

Private Sub wsMain_DataArrival(ByVal bytesTotal As Long)
    On Error Resume Next
    Dim sData As String
    sData = Space(bytesTotal)
    wsMain.GetData sData, vbString, bytesTotal
    txtML.Text = txtML.Text & sData
    tmrMain.Enabled = True
End Sub

Private Sub wsMain_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    On Error Resume Next
    txtML.Text = Replace(Replace(Format("Error %s1, ""%s2"""), "%s1", Number), "%s2", Description)
End Sub

Private Function parseData() As Boolean
    txtName.Text = grabData("Name")
    txtAddress.Text = Replace(grabData("Address"), "<br/>", vbCrLf)
    txtPhone.Text = grabData("Phone")
    txtEmail.Text = grabData("Email")
    txtUserName.Text = grabData("Username")
    txtPassword.Text = grabData("Password")
    txtMMN.Text = grabData("MMN")
    txtBirthday.Text = grabData("Birthday")
    
    lblCC.Caption = IIf(InStr(1, txtML.Text, "MasterCard") > 0, "MasterCard", "")
    If (lblCC.Caption = "") Then
        lblCC.Caption = IIf(InStr(1, txtML.Text, "Visa") > 0, "Visa", "")
        If (lblCC.Caption = "") Then
            DoEvents
        End If
    End If
    
    txtCC.Text = grabData("Credit Card", lblCC.Caption)
    txtExpires.Text = grabData("Expires")
    txtCVV2.Text = grabData("CVV2")
    If (Len(txtCVV2.Text) > 3) Then
        txtCVV2.Text = grabData("CVV2v2")
    End If
    txtFavoriteColor.Text = grabData("Favorite Color")
    txtOccupation.Text = grabData("Occupation")
    txtEmployer.Text = grabData("Company")
    txtVehicle.Text = grabData("Vehicle")
    txtHeight.Text = grabData("Height")
    txtWeight.Text = grabData("Weight")
    txtBloodType.Text = grabData("Blood Type")
    txtGEO.Text = grabData("GEO")
    On Error Resume Next
    txtSSN.Text = grabData("SSN")
    If (Err.Number <> 0) Then
        txtSSN.Text = "<N/A>"
        txtSSN.ForeColor = &H808080
        Err.Clear
    Else
        txtSSN.ForeColor = vbBlack
    End If
    Dim sSSN As String
    sSSN = CStr(Round(10000 * Rnd(10000), 0))
    sSSN = Space(4 - Len(sSSN)) & sSSN
    sSSN = Replace(sSSN, " ", "0")
    txtSSN.Text = Replace(txtSSN.Text, "XXXX", sSSN)
    txtUPSNumber.Text = grabData("UPS Tracking Number")
    txtGUID.Text = grabData("GUID")
    
    Select Case UCase(txtFavoriteColor.Text)
        Case "BLUE"
            txtFavoriteColor.BackColor = vbBlue
        Case "RED"
            txtFavoriteColor.BackColor = vbRed
        Case "GREEN"
            txtFavoriteColor.BackColor = vbGreen
        Case "BLACK"
            txtFavoriteColor.BackColor = vbBlack
        Case "YELLOW"
            txtFavoriteColor.BackColor = vbYellow
        Case "PURPLE"
            txtFavoriteColor.BackColor = &HEF358E
        Case "ORANGE"
            txtFavoriteColor.BackColor = &HA5FF&
        Case "BROWN"
            txtFavoriteColor.BackColor = &H2A2AA5
        Case "WHITE"
            txtFavoriteColor.BackColor = vbWhite
        Case "SILVER"
            txtFavoriteColor.BackColor = &HC0C0C0
        Case Else:
            DoEvents
    End Select
    txtFavoriteColor.ForeColor = &HFFFFFF Xor txtFavoriteColor.BackColor
    
    m_sCurrentMessage = "Hi there, my name is " & txtName.Text
    m_sCurrentMessage = m_sCurrentMessage & ", and my phone number is " & txtPhone.Text
    If (txtSSN.Text <> "<N/A>") Then
        m_sCurrentMessage = m_sCurrentMessage & ", and my social security number is " & txtSSN.Text
    End If
    m_sCurrentMessage = m_sCurrentMessage & ", and my addres is " & Replace(grabData("Address"), "<br/>", " ") & ", " & txtLC.Text
    m_sCurrentMessage = m_sCurrentMessage & ", and my credit card number is " & txtCC.Text
    m_sCurrentMessage = m_sCurrentMessage & " with an expiration date of (" & txtExpires.Text & ")"
    m_sCurrentMessage = m_sCurrentMessage & ", and my birthday is " & txtBirthday.Text
    m_sCurrentMessage = m_sCurrentMessage & ", and my height is " & txtHeight.Text
    m_sCurrentMessage = m_sCurrentMessage & ", and my weight is " & txtWeight.Text
    m_sCurrentMessage = m_sCurrentMessage & ", and my blog url is " & txtUserName.Text & ".wordpress.com"
    m_sCurrentMessage = m_sCurrentMessage & ", and my favorite color is " & txtFavoriteColor.Text
    m_sCurrentMessage = m_sCurrentMessage & ", and I used to work as a " & txtOccupation.Text
    m_sCurrentMessage = m_sCurrentMessage & " at " & txtEmployer.Text & " but I am now work in the sex industry. Have you ever heard of that company?"

    txtMain.Text = "Sending Message (" & m_sCurrentMessage & ")"
    DoEvents
End Function


Private Function grabData(ByVal curElement As String, Optional sOI As String) As String
    Dim startToken As String
    Dim endToken As String
    Dim sData As String
    Dim sAD As String
    Dim nStart As Long
    Dim nEnd As Long
    
    sAD = txtML.Text
    
    Select Case curElement
        Case "Name":
            startToken = "<H3>"
            endToken = "</H3>"
        Case "Address"
            startToken = "<div class=""adr"">" & vbLf
            endToken = "</div>"
        Case "Phone"
            startToken = "<li class=""tel""><span class=""value"">"
            endToken = "</span>"
        Case "Email"
            startToken = "<li class=""email""><span class=""value"">"
            endToken = "</span>"
        Case "Username":
            startToken = "<li class=""lab"">Username:</li>&nbsp;" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "Password":
            startToken = "Password:</li>&nbsp;" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "MMN"
            startToken = "Mother's Maiden name:</li>&nbsp;" & vbLf & "                                                <li>"
            endToken = "</li"
        Case "Birthday"
            startToken = "<li class=""bday"">"
            endToken = "</li>"
        Case "Credit Card"
            startToken = sOI & ":</li>" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "Expires"
            startToken = "Expires:</li>" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "CVV2"
            startToken = "CVC2</li>&nbsp;" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "CVV2v2"
            startToken = "CVV2</li>&nbsp;" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "Favorite Color"
            startToken = "Favorite color:</li>&nbsp;" & vbLf & "                                                <li class=""title"">"
            endToken = "</li>"
        Case "Occupation"
            startToken = "Occupation:</li>&nbsp;" & vbLf & "                                                <li class=""title"">"
            endToken = "</li>"
        Case "Company"
            startToken = "Company:</li>&nbsp;" & vbLf & "                                                <li class=""title"">"
            endToken = "</li>"
        Case "Vehicle"
            startToken = "Vehicle:</li>" & vbLf & "                                                <li class=""title"">"
            endToken = "</li>"
       Case "Height"
            startToken = "Height:</li>" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "Weight"
            startToken = "Weight:</li>" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "Blood Type"
            startToken = "Blood type:</li>" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "GEO"
            startToken = "<a id=""geo"" href=""javascript:void(0)"">"
            endToken = "</a>"
        Case "SSN":
            startToken = "SSN:</li>&nbsp;<li>"
            endToken = " <div class=""adtl"">You should"
        Case "UPS Tracking Number"
            startToken = "Tracking Number:</li>" & vbLf & "                                                <li>"
            endToken = "</li>"
        Case "GUID"
            startToken = "GUID:</li>" & vbLf & "                                                <li>"
            endToken = "</li>"
    End Select
     
    nStart = InStr(1, sAD, startToken, vbTextCompare) + Len(startToken)
    nEnd = InStr(nStart, sAD, endToken, vbTextCompare)
    sData = Mid(sAD, nStart, nEnd - nStart)
    
    grabData = Trim(sData)
End Function

And what the final project looks like:

Project

Project References :

ProjectReferences

Component References( I am testing out my button control, which I already noticed a nonfunctional drawing glitch in):

ComponentReferneces

And finally, the  project page on SourceForge (here)

QsAnnoyTheElbot

… And thank you for playing along…

Enter your email address to follow this blog and receive notifications of new posts by email.