Q

Home » Work » Q’s Identity Creation Toolkit

Q’s Identity Creation Toolkit

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

Join 45 other followers

On the lam and need a new identity?

Have a customer database which looks lonely?

Looking to legitimize your business customer assets?

Look no further!

Simply install “Q’s Identity Creation Toolkit”

Select which country you want your identity to ‘hail’ from, and what country you want to ‘live in’, select your gender – which can range from more masculine than feminine – and then select your age range…

Hit the button clearly labelled “Go Get  IT” and presto!

A new ID complete with personal information, including career, car, social security number, birthday, favorite color – even credit card, – and more – enough support information to bamboozle even the most scrutinizing authority!

How you use this program is COMPLETELY up to you.

Here’s the download link:

DownloadNow

Here’s a few screen shots depicting six separate example identities generated, with literally an infinite number of identities possible!

QS Identity Creation Tool

QS Identity Creation Tool2

QS Identity Creation Tool3

QS Identity Creation Tool4

QS Identity Creation Tool5

QS Identity Creation Tool6

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 Sub cmdCopy_Click()
    On Error Resume Next
    Clipboard.Clear
    Clipboard.SetText txtML.Text
    MsgBox "Copied!", vbOKOnly Or vbInformation, "QZAntics"
End Sub

Private Sub cmdRunit_Click()
    Dim bBadNumbers As Boolean
    
    txtML.Text = ""
    
    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 Form_Load()
    addNameSets
    addCountries
    
    lvCountry.ColumnHeaders(1).Width = lvCountry.Width - 350
    lvNameSet.ColumnHeaders(1).Width = lvNameSet.Width - 400
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)"
    lvCountry.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
'    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 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()
    If (InStr(1, txtML.Text, "</html>") <> 0) Then
        tmrMain.Enabled = False
        wsMain.Close
        parseData
    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
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:

QSProject

And the project page on SourceForge (here)

MainScreenOnsourceForge

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