home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / TWITTER_FU2155576222009.psc / TweetForm.frm < prev    next >
Text File  |  2009-06-22  |  11KB  |  338 lines
  1. VERSION 5.00
  2. Begin VB.Form TweetForm 
  3.    BackColor       =   &H00B6987B&
  4.    Caption         =   "Twitter like a bird - using Pure Visual Basic 6.0 Code - INCLUDES XMLHTTP POST WITH AUTHENTICATION"
  5.    ClientHeight    =   7485
  6.    ClientLeft      =   120
  7.    ClientTop       =   420
  8.    ClientWidth     =   10890
  9.    Icon            =   "TweetForm.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   7485
  13.    ScaleWidth      =   10890
  14.    StartUpPosition =   2  'CenterScreen
  15.    Begin VB.TextBox Response 
  16.       BeginProperty Font 
  17.          Name            =   "Arial"
  18.          Size            =   12
  19.          Charset         =   0
  20.          Weight          =   400
  21.          Underline       =   0   'False
  22.          Italic          =   0   'False
  23.          Strikethrough   =   0   'False
  24.       EndProperty
  25.       Height          =   3255
  26.       Left            =   120
  27.       MultiLine       =   -1  'True
  28.       ScrollBars      =   2  'Vertical
  29.       TabIndex        =   10
  30.       Top             =   3960
  31.       Width           =   10455
  32.    End
  33.    Begin VB.CommandButton TweetButton 
  34.       BackColor       =   &H00C0C0C0&
  35.       Caption         =   "POST"
  36.       BeginProperty Font 
  37.          Name            =   "Arial"
  38.          Size            =   12
  39.          Charset         =   0
  40.          Weight          =   700
  41.          Underline       =   0   'False
  42.          Italic          =   0   'False
  43.          Strikethrough   =   0   'False
  44.       EndProperty
  45.       Height          =   855
  46.       Left            =   9600
  47.       Style           =   1  'Graphical
  48.       TabIndex        =   9
  49.       Top             =   2640
  50.       Width           =   975
  51.    End
  52.    Begin VB.TextBox YourTweet 
  53.       BeginProperty Font 
  54.          Name            =   "Arial"
  55.          Size            =   12
  56.          Charset         =   0
  57.          Weight          =   400
  58.          Underline       =   0   'False
  59.          Italic          =   0   'False
  60.          Strikethrough   =   0   'False
  61.       EndProperty
  62.       Height          =   390
  63.       Left            =   120
  64.       MaxLength       =   140
  65.       TabIndex        =   7
  66.       Top             =   2880
  67.       Width           =   9375
  68.    End
  69.    Begin VB.PictureBox Picture2 
  70.       BackColor       =   &H00B6987B&
  71.       Height          =   2100
  72.       Left            =   4440
  73.       ScaleHeight     =   2040
  74.       ScaleWidth      =   6075
  75.       TabIndex        =   1
  76.       Top             =   240
  77.       Width           =   6135
  78.       Begin VB.TextBox TheirUsername 
  79.          BeginProperty Font 
  80.             Name            =   "Arial"
  81.             Size            =   12
  82.             Charset         =   0
  83.             Weight          =   400
  84.             Underline       =   0   'False
  85.             Italic          =   0   'False
  86.             Strikethrough   =   0   'False
  87.          EndProperty
  88.          Height          =   390
  89.          Left            =   120
  90.          TabIndex        =   6
  91.          Top             =   1320
  92.          Width           =   2895
  93.       End
  94.       Begin VB.TextBox YourPassword 
  95.          BeginProperty Font 
  96.             Name            =   "Arial"
  97.             Size            =   12
  98.             Charset         =   0
  99.             Weight          =   400
  100.             Underline       =   0   'False
  101.             Italic          =   0   'False
  102.             Strikethrough   =   0   'False
  103.          EndProperty
  104.          Height          =   390
  105.          IMEMode         =   3  'DISABLE
  106.          Left            =   3120
  107.          PasswordChar    =   "*"
  108.          TabIndex        =   5
  109.          Top             =   450
  110.          Width           =   2775
  111.       End
  112.       Begin VB.TextBox YourUserName 
  113.          BeginProperty Font 
  114.             Name            =   "Arial"
  115.             Size            =   12
  116.             Charset         =   0
  117.             Weight          =   400
  118.             Underline       =   0   'False
  119.             Italic          =   0   'False
  120.             Strikethrough   =   0   'False
  121.          EndProperty
  122.          Height          =   390
  123.          Left            =   120
  124.          TabIndex        =   3
  125.          Top             =   450
  126.          Width           =   2895
  127.       End
  128.       Begin VB.Label Label2 
  129.          AutoSize        =   -1  'True
  130.          BackStyle       =   0  'Transparent
  131.          Caption         =   "Recipient's User Name"
  132.          BeginProperty Font 
  133.             Name            =   "Arial"
  134.             Size            =   12
  135.             Charset         =   0
  136.             Weight          =   400
  137.             Underline       =   0   'False
  138.             Italic          =   0   'False
  139.             Strikethrough   =   0   'False
  140.          EndProperty
  141.          ForeColor       =   &H00FFFFFF&
  142.          Height          =   270
  143.          Left            =   120
  144.          TabIndex        =   4
  145.          Top             =   960
  146.          Width           =   2400
  147.       End
  148.       Begin VB.Label Label1 
  149.          AutoSize        =   -1  'True
  150.          BackStyle       =   0  'Transparent
  151.          Caption         =   "Your own Twitter User Name and Password"
  152.          BeginProperty Font 
  153.             Name            =   "Arial"
  154.             Size            =   12
  155.             Charset         =   0
  156.             Weight          =   400
  157.             Underline       =   0   'False
  158.             Italic          =   0   'False
  159.             Strikethrough   =   0   'False
  160.          EndProperty
  161.          ForeColor       =   &H00FFFFFF&
  162.          Height          =   270
  163.          Left            =   120
  164.          TabIndex        =   2
  165.          Top             =   120
  166.          Width           =   4500
  167.       End
  168.    End
  169.    Begin VB.PictureBox Picture1 
  170.       AutoSize        =   -1  'True
  171.       Height          =   2100
  172.       Left            =   120
  173.       Picture         =   "TweetForm.frx":030A
  174.       ScaleHeight     =   2040
  175.       ScaleWidth      =   4170
  176.       TabIndex        =   0
  177.       Top             =   240
  178.       Width           =   4230
  179.    End
  180.    Begin VB.Label Label4 
  181.       AutoSize        =   -1  'True
  182.       BackStyle       =   0  'Transparent
  183.       Caption         =   "XML RESPONSE FROM TWITTER.COM"
  184.       BeginProperty Font 
  185.          Name            =   "Arial"
  186.          Size            =   12
  187.          Charset         =   0
  188.          Weight          =   400
  189.          Underline       =   0   'False
  190.          Italic          =   0   'False
  191.          Strikethrough   =   0   'False
  192.       EndProperty
  193.       ForeColor       =   &H00FFFFFF&
  194.       Height          =   270
  195.       Left            =   120
  196.       TabIndex        =   11
  197.       Top             =   3600
  198.       Width           =   4320
  199.    End
  200.    Begin VB.Label Label3 
  201.       AutoSize        =   -1  'True
  202.       BackStyle       =   0  'Transparent
  203.       Caption         =   "Your ""TWEET"" ( Simple TEXT up to 140 Characters in Length )"
  204.       BeginProperty Font 
  205.          Name            =   "Arial"
  206.          Size            =   12
  207.          Charset         =   0
  208.          Weight          =   400
  209.          Underline       =   0   'False
  210.          Italic          =   0   'False
  211.          Strikethrough   =   0   'False
  212.       EndProperty
  213.       ForeColor       =   &H00FFFFFF&
  214.       Height          =   270
  215.       Left            =   120
  216.       TabIndex        =   8
  217.       Top             =   2520
  218.       Width           =   6510
  219.    End
  220. End
  221. Attribute VB_Name = "TweetForm"
  222. Attribute VB_GlobalNameSpace = False
  223. Attribute VB_Creatable = False
  224. Attribute VB_PredeclaredId = True
  225. Attribute VB_Exposed = False
  226. Private Sub TweetButton_Click()
  227. '================================================================
  228. 'CHECK THE TWITTER API FOR "GET" OPTIONS AND OTHER "POST" OPTIONS
  229. '================================================================
  230.  UN$ = Trim$(YourUserName)
  231.  If UN$ = "" Then
  232.   Beep
  233.   MsgBox "Sorry, you need to enter your Twitter Username.", vbExclamation, "Whoops!"
  234.   Exit Sub
  235.  End If
  236.  PW$ = Trim$(YourPassword)
  237.  If PW$ = "" Then
  238.   Beep
  239.   MsgBox "Sorry, you need to enter your Twitter Password.", vbExclamation, "Whoops!"
  240.   Exit Sub
  241.  End If
  242.  Recipient$ = Trim$(TheirUsername)
  243.  If Recipient$ = "" Then
  244.   Beep
  245.   MsgBox "Sorry, you need to enter your Friend's Username.", vbExclamation, "Whoops!"
  246.   Exit Sub
  247.  End If
  248.  Tweet$ = Trim$(YourTweet)
  249.  If Tweet$ = "" Then
  250.   Beep
  251.   MsgBox "Sorry, a Tweet may be between 1 and 140 characters in length.", vbExclamation, "Whoops!"
  252.   Exit Sub
  253.  End If
  254. '==========================
  255. 'DEFINE THE TWITTER API URL
  256. '==========================
  257.  cURL$ = "http://twitter.com/direct_messages/new.xml?user=" & Recipient$
  258.  cURL$ = cURL$ & "&text=" & Tweet$
  259. '=============================================
  260. 'POST THE STRING WITH USER/PASS AUTHENTICATION
  261. '=============================================
  262.  Screen.MousePointer = 11
  263.  Response = CredentialPostURLSource(cURL$, UN$, PW$)
  264.  Screen.MousePointer = Default
  265. '===============================================================
  266. 'REMEMBER, YOU ARE LIMITED TO 100 REQUESTS PER HOUR WITH TWITTER
  267. '===============================================================
  268. End Sub
  269.  
  270. Sub BuildPostData(BYTEARRAY() As Byte, ByVal strPostData As String)
  271.  Dim lngNewBytes As Long
  272.  Dim strCH As String
  273.  Dim i As Long
  274.  lngNewBytes = Len(strPostData) - 1
  275.  If lngNewBytes < 0 Then
  276.   Exit Sub
  277.  End If
  278.  ReDim BYTEARRAY(lngNewBytes)
  279.  For i = 0 To lngNewBytes
  280.   strCH = Mid$(strPostData, i + 1, 1)
  281.   BYTEARRAY(i) = Asc(strCH)
  282.  Next
  283. End Sub
  284.  
  285. Function UrlEncode(sText As String) As String
  286.  sText = Replace(sText, " ", "+")
  287.  For i = 1 To Len(sText)
  288.   sChar = Mid$(sText, i, 1)
  289.   If InStr("+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789", sChar) Then
  290.    sResult = sResult & sChar
  291.   Else
  292.    sResult = sResult & "%" & Right$("0" & Hex(Asc(sChar)), 2)
  293.   End If
  294.  Next
  295.  UrlEncode = sFinal & sResult
  296. End Function
  297.  
  298. Function CredentialPostURLSource(TheURL As String, UN As String, PS As String) As String
  299. '======================================================
  300. '"?" Prefix 1st Field, "&" prefix for subsequent fields
  301. '======================================================
  302.  S = InStr(TheURL, "?")
  303.  If S = 0 Then
  304.   Exit Function
  305.  End If
  306.  SiteASP$ = Left$(TheURL, S - 1)
  307.  StringtoPost = Right$(TheURL, Len(TheURL) - S)
  308.  Dim bytpostdata() As Byte
  309.  Dim strPostData As String
  310.  Dim strHeader As String
  311.  Dim varPostData As Variant
  312. '====================================
  313. 'Pack the post data into a byte array
  314. '====================================
  315.  strPostData = StringtoPost
  316.  BuildPostData bytpostdata(), strPostData
  317. '=============================
  318. 'Write the byte into a variant
  319. '=============================
  320.  varPostData = bytpostdata
  321. '=================
  322. 'Create the Header
  323. '=================
  324.  strHeader = "application/x-www-form-urlencoded" + Chr(10) + Chr(13)
  325. '=============
  326. 'Post the data
  327. '=============
  328.  Dim xmlhttp As Object
  329.  Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
  330.  xmlhttp.Open "POST", SiteASP$, False, UN, PS
  331.  xmlhttp.setRequestHeader "Content-Type", strHeader
  332.  xmlhttp.Send varPostData
  333.  HTTPText$ = xmlhttp.responseText
  334.  Set xmlhttp = Nothing
  335.  CredentialPostURLSource = HTTPText$
  336. End Function
  337.  
  338.