Facebook api vs Twitter api

aspless · October 14th, 2009, 11:16 AM

What i am interested to know is if anyone has successfully written a classic asp script to interface with facebook for simple status updates and maybe even facebooks internal messaging.

After the brief look around the net i am a tad over welmed by the seeming complexity of this task.

Compared to twitters querystring method there is much more involvement in getting the facebook api to talk.

In case any of you are interested in the twitter script below are two examples. The first is the status update script and the second is my re-written direct message script using the querystring from a .Net example (available if requested).

Status Update:

Code:

<%
'============================================================== 
' 
' Scriptname: PostToTwitterSimple.vbs 
' 
' SITEJUNCTION 
' TWITTER STATUS UPDATE 
' 
' With this script you can update your Twitter status 
' 
' July 2009 - Erick Hiemstra 
' 
' more info: 
' http://sitejunction.awardspace.com/v.../basic_script/ 
' 
'============================================================== 
OPTION EXPLICIT 'Be sure you have declared all your variables. 
' -------------------------- 
' SOME VARIABLES 
' In this script the response is hardcoded directly into a variable 
' to keep the script readable, but could of 
' course come from whatever source. 
' -------------------------- 
Dim strUsername, strPassword, strMessage 
strUsername = "your name here" ' Your Twitter username 
strPassword = "your password here" ' Your Twitter password 
strMessage = "Your update here" ' Your Twitter update
 
' Calling the function and store the result in a variable. 
Dim strTwitterXMLResponse 
strTwitterXMLResponse = SendToTwitter(strMessage, strUsername, strPassword) 
' Post back the result with a messagebox so you know something happend 
MsgBox strTwitterXMLResponse, VbOkOnly, "TWITTER STATUS UPDATE" 
' -------------------------- 
' FUNCTIONS 
' This is where the actual work is done 
' -------------------------- 
Function SendToTwitter(strMessage, strUsername, strPassword) 
     ' This is the function wicht does all the work. 
     ' It uses XMLHTTP to post your message to Twitter.. 
     Dim objHTTP 
     Set objHTTP = CreateObject("Microsoft.XMLHTTP") 
 
          objHTTP.open "POST", "http://twitter.com/statuses/update.xml", false, strUsername, strPassword 
          objHTTP.send "status=" & strMessage 
 
          ' The function stores the Twitter response to the result of the function so you can use this later 
          SendToTwitter = objHTTP.responseText 
 
     Set objHTTP = nothing 'Release the object 
 
End Function
%>

aspless · October 14th, 2009, 11:22 AM

Direct Message:

Code:

 
<%
'============================================================== 
' 
' SITEJUNCTION 
' TWITTER STATUS UPDATE 
' 
' With this script you can send direct messages
' 
' July 2009 - Erick Hiemstra and a bit of Aspless
' 
' more info: 
' http://sitejunction.awardspace.com/vbscript_tweets/basic_script/ 
' 
'============================================================== 
OPTION EXPLICIT 'Be sure you have declared all your variables. 
' -------------------------- 
' SOME VARIABLES 
' In this script the response is hardcoded directly into a variable 
' to keep the script readable, but could of 
' course come from whatever source. 
' -------------------------- 
Dim strUsername, strPassword, strMessage, strRecipient 
strUsername = "your name here" ' Your Twitter username 
strPassword = "your password here" ' Your Twitter password 
strMessage = "Message Here." ' Direct Message
strRecipient = "Recipient Here" ' Recipient
 
' Calling the function and store the result in a variable. 
Dim strTwitterXMLResponse 
strTwitterXMLResponse = SendToTwitter(strMessage, strUsername, strPassword) 
' Post back the result with a messagebox so you know something happend 
MsgBox strTwitterXMLResponse, VbOkOnly, "TWITTER STATUS UPDATE" 
' -------------------------- 
' FUNCTIONS 
' This is where the actual work is done 
' -------------------------- 
Function SendToTwitter(strMessage, strUsername, strPassword) 
 
' This is the function wicht does all the work. 
' It uses XMLHTTP to post your message to Twitter.. 
Dim objHTTP 
Set objHTTP = CreateObject("Microsoft.XMLHTTP")

.. p2p guys this script keeps geting cut when pasting

aspless · October 14th, 2009, 11:29 AM

Code:

objHTTP.open "POST",

Code:

"http://twitter.com/direct_messages/new.xml?user="
&strRecipient&"&text="&strMessage&"", false, strUsername, strPassword 
          objHTTP.send  
           
          ' The function stores the Twitter response to the result of the function so you can use this later 
          SendToTwitter = objHTTP.responseText 
      
     Set objHTTP = nothing 'Release the object 
      
End Function

aspless · October 15th, 2009, 08:39 AM

Since looking into this a little further the steps i have taken are:

Created application on FB so now have my api key and secret key.

Found on forums facebook.asp and class_md5.asp and a test page

So far the test page does not error .. Nor does it seem to post an update to my profile.

Below are the three pages used!!

Facebook.asp

Code:

<%
    ' FaceBook ASP Class v1.2
    ' Developed by Craig Bovis
    '-----------------------------
    '
    ' This class is designed to allow you to interface with facebook applications via a Canvas page
    ' It provides simple methods for authenticating the canvas request and making calls to the Facebook API
    
    CONST REST_URI = "http://api.facebook.com/restserver.php"
    CONST FB_PARAM_PREFIX = "fb_sig"
    CONST FB_API_VERSION = "1.0"
 
 
    
    Class FaceBook
        
        Public SecretKey
        Public ApiKey
        Public SessionKey
        
        ' Public properties for accessing information passed across to this callback from Facebook
        
        Public Property Get InCanvas
         InCanvas = (Request(FB_PARAM_PREFIX & "_in_canvas") = "1")
        End Property
        
        Public Property Get ApplicationInstalled
         ApplicationInstalled = (Request(FB_PARAM_PREFIX & "_added") = "1")
        End Property
        
        Public Property Get UserID
         UserID = Request(FB_PARAM_PREFIX & "_user")
        End Property
        
        ' This allows you to call a facebook method (e.g. facebook.profile.getFBML) with the specified parameters
        ' You do not need to pass in the following parameters as they are appended automatically,
        '   - session_key
        '   - api_key
        '   - call_id
        '   - v
        Public Function CallApiMethod(strMethod, oParams)
            oParams("method") = strMethod
            Dim oXMLHTTP
            Set oXMLHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
            oXMLHTTP.Open "GET", GenerateRequestURI(oParams), False
            oXMLHTTP.Send()
            Set CallApiMethod = oXMLHTTP.ResponseXml
        End Function
        
        Public Sub Redirect(strURI)
            %>
                <fb:redirect url="<%= strURI %>" />
            <%
        End Sub
        
        Public Function ErrorMessage(strMsg)
            ErrorMessage = "<fb:error message=""" & strMsg & """ />"
        End Function
        
        Public Function SuccessMessage(strMsg)
            SuccessMessage = "<fb:success message=""" & strMsg & """ />"
        End Function
        
        Public Function RequireInstall()
            If (Request.Form("fb_sig_added") = "0") Then
                %>
                    <fb:redirect url="http://www.facebook.com/apps/application.php?api_key=<%= ApiKey %>" />
                <%
            End If
        End Function
        
        Public Function SetRefHandle(handle, fbml)
            Dim oParams
            Set oParams = Server.CreateObject("Scripting.Dictionary")
            oParams.Add "handle", handle
            oParams.Add "fbml", fbml
            Set SetRefHandle = CallApiMethod("facebook.fbml.setRefHandle", oParams)
        End Function
        
        Public Function SetProfileFBML(uid, fbml)
            Dim oParams
            Set oParams = Server.CreateObject("Scripting.Dictionary")
            oParams.Add "markup", fbml
            If (Not IsNull(uid)) Then oParams.Add "uid", uid
            Set SetProfileFBML = CallApiMethod("facebook.profile.setFBML", oParams)
        End Function
        
        Function FQLQuery(query)
            Dim oParams
            Set oParams = Server.CreateObject("Scripting.Dictionary")
            oParams.Add "query", query
            Set FQLQuery = CallApiMethod("facebook.fql.query", oParams)
        End Function
        
        Public Sub IncludeCSS(strPath)
            Dim oFSO
            Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
            If (oFSO.FileExists(Server.MapPath(strPath))) Then
                Dim oFile
                Set oFile = oFSO.OpenTextFile(Server.MapPath(strPath))
                    %>
                    <style type="text/css">
                        <%= oFile.ReadAll() %>
                    </style>
                    <%
                Call oFile.Close()
            End If
        End Sub
        
        ' This property returns whether or not the request made to your page was from FaceBook
        Public Property Get RequestIsValid
            Dim strItem, oRequestParams
            Set oRequestParams = Server.CreateObject("Scripting.Dictionary")
            For Each strItem In Request.Form
                If (Left(strItem, Len(FB_PARAM_PREFIX)) = FB_PARAM_PREFIX And Not strItem = FB_PARAM_PREFIX) Then
                    oRequestParams(Mid(strItem, Len(FB_PARAM_PREFIX & "_") + 1)) = Request.Form(strItem)
                End If
            Next
            RequestIsValid = (GenerateSig(oRequestParams) = Request.Form("fb_sig"))
        End Property
        
        Public Function Form(strKey)
            If (Len(Request.Form(strKey)) > 0) Then
                Form = Request.Form(strKey)
            Else
                If (Len(Request.Form(strKey & "[0]")) > 0) Then
                    Dim arrKey()
                    Redim arrKey(0)
                    Do While Len(Request.Form(strKey & "[" & Ubound(arrKey) & "]")) > 0
                        arrKey(Ubound(arrKey)) = Request.Form(strKey & "[" & Ubound(arrKey) & "]")
                        Redim Preserve arrKey(Ubound(arrKey) + 1)
                    Loop
                    Redim Preserve arrKey(Ubound(arrKey) - 1)
                    Form = arrKey
                End If
            End If
        End Function
        
        Public Function SendNotificationRequest(to_ids, req_type, content, image, boolInvite)
            Dim oParams
            Set oParams = Server.CreateObject("Scripting.Dictionary")
            oParams.Add "to_ids", to_ids
            oParams.Add "type", req_type
            oParams.Add "content", content
            oParams.Add "image", image
            oParams.Add "invite", LCase(boolInvite)
            Set SendNotificationRequest = CallApiMethod("facebook.notifications.sendRequest", oParams)
        End Function
                
        Private Sub Class_Initialize()
            If (Len(Request(FB_PARAM_PREFIX & "_api_key")) > 0) Then ApiKey = Request(FB_PARAM_PREFIX & "_api_key")
            If (Len(Request(FB_PARAM_PREFIX & "_session_key")) > 0) Then SessionKey = Request(FB_PARAM_PREFIX & "_session_key")
        End Sub
        
        ' This generates a facebook REST uri for the passed in parameters
        Private Function GenerateRequestURI(oParams)
            If (Len(SessionKey) > 0) Then oParams("session_key") = SessionKey
            If (Len(ApiKey) > 0) Then oParams("api_key") = ApiKey
            If (Len(GetUniqueCallID()) > 0) Then oParams("call_id") = GetUniqueCallID()
            oParams("v") = FB_API_VERSION
            GenerateRequestURI = REST_URI & "?"
            Dim strItem
            For Each strItem In oParams.Keys
                GenerateRequestURI = GenerateRequestURI & strItem & "=" & Server.UrlEncode(oParams(strItem)) & "&"
            Next
            GenerateRequestURI = GenerateRequestURI & "sig=" & GenerateSig(oParams)
        End Function
        
        ' This creates a signature of the supplied parameters
        Private Function GenerateSig(oParams)
            Set oParams = SortDictionary(oParams)
            Dim strSig, strItem
            For Each strItem In oParams
                strSig = strSig & strItem & "=" & oParams(strItem)
            Next
            strSig = strSig & SecretKey
            Dim oMD5
            Set oMD5 = New MD5
            oMD5.Text = strSig
            GenerateSig = oMD5.HexMD5
        End Function
        
        ' SortDictionary function courtesy of MSDN
        Private Function SortDictionary(objDict)
            Dim strDict()
            Dim objKey
            Dim strKey,strItem
            Dim X,Y,Z
            Z = objDict.Count
            If Z > 1 Then
                ReDim strDict(Z,2)
                X = 0
                For Each objKey In objDict
                    strDict(X,1)  = CStr(objKey)
                    strDict(X,2) = CStr(objDict(objKey))
                    X = X + 1
                Next
                For X = 0 to (Z - 2)
                    For Y = X to (Z - 1)
                        If StrComp(strDict(X,1),strDict(Y,1),vbTextCompare) > 0 Then
                            strKey  = strDict(X,1)
                            strItem = strDict(X,2)
                            strDict(X,1)  = strDict(Y,1)
                            strDict(X,2) = strDict(Y,2)
                            strDict(Y,1)  = strKey
                            strDict(Y,2) = strItem
                        End If
                    Next
                Next
                objDict.RemoveAll
                For X = 0 to (Z - 1)
                    objDict.Add strDict(X,1), strDict(X,2)
                Next
            End If
            Set SortDictionary = objDict
        End Function
        
        ' Returns a unique CallID. Uses an application incrementer & a timestamp since VBScript only allows
        ' us to generate a timestamp accurate to 1 second. We may make multiple calls per second so this would not be unique!
        Private Function GetUniqueCallID()
         If (Len(Application("FB_CallID")) = 0) Then Application("FB_CallID") = 1
         GetUniqueCallID = TimeStamp() & Application("FB_CallID")
         Application("FB_CallID") = Application("FB_CallID") + 1
        End Function
        
        ' Returns a timestamp accurate within 1 second
        Private Function TimeStamp()
         TimeStamp = Year(Now()) & Month(Now()) & Day(Now()) & Hour(Now()) & Minute(Now()) & Second(Now())
        End Function
        
    End Class
    
%>

class_md5.asp

Code:

<%
' RSA/MD5 implementation
'
' Version 1.0.1
' Date: 14th April, 2003
' Author: Chris Read
' Home page: http://users.bigpond.net.au/mrjolly/
'
' Most ASP MD5 implementations look relatively the same, the exception with this one is that
' it is a class. Other than that, it's massaged from the RFC1321 C code and simplified a little.
'
' There are two properties
' Text - String, text to encode
' HEXMD5 - String, read-only, MD5 value of Text above
' There are no methods
'
' Private to this class
Private Const S11 = &H007
Private Const S12 = &H00C
Private Const S13 = &H011
Private Const S14 = &H016
Private Const S21 = &H005
Private Const S22 = &H009
Private Const S23 = &H00E
Private Const S24 = &H014
Private Const S31 = &H004
Private Const S32 = &H00B
Private Const S33 = &H010
Private Const S34 = &H017
Private Const S41 = &H006
Private Const S42 = &H00A
Private Const S43 = &H00F
Private Const S44 = &H015
Class MD5
 ' Public methods and properties
 
 ' Text property
 Public Text
 ' Text value in Hex, read-only
 Public Property Get HEXMD5()
  Dim lArray
  Dim lIndex
  Dim AA
  Dim BB
  Dim CC
  Dim DD
  Dim lStatus0
  Dim lStatus1
  Dim lStatus2
  Dim lStatus3
  lArray = ConvertToWordArray(Text)
  lStatus0 = &H67452301
  lStatus1 = &HEFCDAB89
  lStatus2 = &H98BADCFE
  lStatus3 = &H10325476
  For lIndex = 0 To UBound(lArray) Step 16
   AA = lStatus0
   BB = lStatus1
   CC = lStatus2
   DD = lStatus3
   FF lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 0), S11,&HD76AA478
   FF lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 1), S12,&HE8C7B756
   FF lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 2), S13,&H242070DB
   FF lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 3), S14,&HC1BDCEEE
   FF lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 4), S11,&HF57C0FAF
   FF lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 5), S12,&H4787C62A
   FF lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 6), S13,&HA8304613
   FF lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 7), S14,&HFD469501
   FF lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 8), S11,&H698098D8
   FF lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 9), S12,&H8B44F7AF
   FF lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 10), S13,&HFFFF5BB1
   FF lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 11), S14,&H895CD7BE
   FF lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 12), S11,&H6B901122
   FF lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 13), S12,&HFD987193
   FF lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 14), S13,&HA679438E
   FF lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 15), S14,&H49B40821
   GG lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 1), S21,&HF61E2562
   GG lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 6), S22,&HC040B340
   GG lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 11), S23,&H265E5A51
   GG lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 0), S24,&HE9B6C7AA
   GG lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 5), S21,&HD62F105D
   GG lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 10), S22,&H2441453
   GG lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 15), S23,&HD8A1E681
   GG lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 4), S24,&HE7D3FBC8
   GG lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 9), S21,&H21E1CDE6
   GG lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 14), S22,&HC33707D6
   GG lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 3), S23,&HF4D50D87
   GG lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 8), S24,&H455A14ED
   GG lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 13), S21,&HA9E3E905
   GG lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 2), S22,&HFCEFA3F8
   GG lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 7), S23,&H676F02D9
   GG lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 12), S24,&H8D2A4C8A
           
   HH lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 5), S31,&HFFFA3942
   HH lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 8), S32,&H8771F681
   HH lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 11), S33,&H6D9D6122
   HH lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 14), S34,&HFDE5380C
   HH lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 1), S31,&HA4BEEA44
   HH lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 4), S32,&H4BDECFA9
   HH lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 7), S33,&HF6BB4B60
   HH lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 10), S34,&HBEBFBC70
   HH lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 13), S31,&H289B7EC6
   HH lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 0), S32,&HEAA127FA
   HH lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 3), S33,&HD4EF3085
   HH lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 6), S34,&H4881D05
   HH lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 9), S31,&HD9D4D039
   HH lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 12), S32,&HE6DB99E5
   HH lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 15), S33,&H1FA27CF8
   HH lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 2), S34,&HC4AC5665
   II lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 0), S41,&HF4292244
   II lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 7), S42,&H432AFF97
   II lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 14), S43,&HAB9423A7
   II lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 5), S44,&HFC93A039
   II lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 12), S41,&H655B59C3
   II lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 3), S42,&H8F0CCC92
   II lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 10), S43,&HFFEFF47D
   II lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 1), S44,&H85845DD1
   II lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 8), S41,&H6FA87E4F
   II lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 15), S42,&HFE2CE6E0
   II lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 6), S43,&HA3014314
   II lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 13), S44,&H4E0811A1
   II lStatus0,lStatus1,lStatus2,lStatus3,lArray(lIndex + 4), S41,&HF7537E82
   II lStatus3,lStatus0,lStatus1,lStatus2,lArray(lIndex + 11), S42,&HBD3AF235
   II lStatus2,lStatus3,lStatus0,lStatus1,lArray(lIndex + 2), S43,&H2AD7D2BB
   II lStatus1,lStatus2,lStatus3,lStatus0,lArray(lIndex + 9), S44,&HEB86D391
   lStatus0 = Add32(lStatus0,AA)
   lStatus1 = Add32(lStatus1,BB)
   lStatus2 = Add32(lStatus2,CC)
   lStatus3 = Add32(lStatus3,DD)
  Next
    
  HEXMD5 = LCase(WordToHex(lStatus0) & WordToHex(lStatus1) & WordToHex(lStatus2) & WordToHex(lStatus3))
 End Property
 ' Private methods and properties
 Private m_lMask()
 Private m_lPow()
 Private Function F(lX, lY, lZ)
  F = (lX And lY) Or ((Not lX) And lZ)
 End Function
 Private Function G(lX, lY, lZ)
  G = (lX And lZ) Or (lY And (Not lZ))
 End Function
 Private Function H(lX, lY, lZ)
  H = lX Xor lY Xor lZ
 End Function
 Private Function I(lX, lY, lZ)
  I = lY Xor (lX Or (Not lZ))
 End Function
 Private Sub FF(lA, lB, lC, lD, lX, lS, lAC)
  lA = Add32(lA,Add32(Add32(F(lB,lC,lD),lX),lAC))
  lA = RotateLeft32(lA,lS)
  lA = Add32(lA,lB)
 End Sub
 Private Sub GG(lA, lB, lC, lD, lX, lS, lAC)
  lA = Add32(lA,Add32(Add32(G(lB,lC,lD),lX),lAC))
  lA = RotateLeft32(lA,lS)
  lA = Add32(lA,lB)
 End Sub
 Private Sub HH(lA, lB, lC, lD, lX, lS, lAC)
  lA = Add32(lA,Add32(Add32(H(lB,lC,lD),lX),lAC))
  lA = RotateLeft32(lA,lS)
  lA = Add32(lA,lB)
 End Sub
 Private Sub II(lA, lB, lC, lD, lX, lS, lAC)
  lA = Add32(lA,Add32(Add32(I(lB,lC,lD),lX),lAC))
  lA = RotateLeft32(lA,lS)
  lA = Add32(lA,lB)
 End Sub
 Private Function ConvertToWordArray(sText)
  Dim lTextLength
  Dim lNumberOfWords
  Dim lWordArray()
  Dim lBytePosition
  Dim lByteCount
  Dim lWordCount
    
  lTextLength = Len(sText)
    
  lNumberOfWords = (((lTextLength + 8) \ 64) + 1) * 16
  ReDim lWordArray(lNumberOfWords - 1)
    
  lBytePosition = 0
  lByteCount = 0
  
  Do Until lByteCount >= lTextLength
   lWordCount = lByteCount \ 4
   lBytePosition = (lByteCount Mod 4) * 8
   lWordArray(lWordCount) = lWordArray(lWordCount) Or ShiftLeft(Asc(Mid(sText,lByteCount + 1,1)),lBytePosition)
   lByteCount = lByteCount + 1
  Loop
  lWordCount = lByteCount \ 4
  lBytePosition = (lByteCount Mod 4) * 8
  lWordArray(lWordCount) = lWordArray(lWordCount) Or ShiftLeft(&H80,lBytePosition)
  lWordArray(lNumberOfWords - 2) = ShiftLeft(lTextLength,3)
  lWordArray(lNumberOfWords - 1) = ShiftRight(lTextLength,29)
    
  ConvertToWordArray = lWordArray
 End Function
 Private Function WordToHex(lValue)
  Dim lTemp
  For lTemp = 0 To 3
   WordToHex = WordToHex & Right("00" & Hex(ShiftRight(lValue,lTemp * 8) And m_lMask(7)),2)
  Next
 End Function
 ' Unsigned value arithmetic functions for rotating, shifting and adding
 Private Function ShiftLeft(lValue,iBits)
  ' Guilty until proven innocent
  ShiftLeft = 0
  If iBits = 0 then
   ShiftLeft = lValue ' No shifting to do
  ElseIf iBits = 31 Then ' Quickly shift left if there is a value, being aware of the sign
   If lValue And 1 Then
    ShiftLeft = &H80000000
   End If
  Else ' Shift left x bits, being careful with the sign
   If (lValue And m_lPow(31 - iBits)) Then
    ShiftLeft = ((lValue And m_lMask(31 - (iBits + 1))) * m_lPow(iBits)) Or &H80000000
   Else
    ShiftLeft = ((lValue And m_lMask(31 - iBits)) * m_lPow(iBits))
   End If
  End If
 End Function
 Private Function ShiftRight(lValue,iBits)
  ' Guilty until proven innocent
  ShiftRight = 0
  
  If iBits = 0 then
   ShiftRight = lValue ' No shifting to do
  ElseIf iBits = 31 Then ' Quickly shift to the right if there is a value in the sign
   If lValue And &H80000000 Then
    ShiftRight = 1
   End If
  Else
   ShiftRight = (lValue And &H7FFFFFFE) \ m_lPow(iBits)
   If (lValue And &H80000000) Then
    ShiftRight = (ShiftRight Or (&H40000000 \ m_lPow(iBits - 1)))
   End If
  End If
 End Function
 Private Function RotateLeft32(lValue,iBits)
  RotateLeft32 = ShiftLeft(lValue,iBits) Or ShiftRight(lValue,(32 - iBits))
 End Function
 Private Function Add32(lA,lB)
  Dim lA4
  Dim lB4
  Dim lA8
  Dim lB8
  Dim lA32
  Dim lB32
  Dim lA31
  Dim lB31
  Dim lTemp
  lA32 = lA And &H80000000
  lB32 = lB And &H80000000
  lA31 = lA And &H40000000
  lB31 = lB And &H40000000
  lTemp = (lA And &H3FFFFFFF) + (lB And &H3FFFFFFF)
  If lA31 And lB31 Then
   lTemp = lTemp Xor &H80000000 Xor lA32 Xor lB32
  ElseIf lA31 Or lB31 Then
   If lTemp And &H40000000 Then
    lTemp = lTemp Xor &HC0000000 Xor lA32 Xor lB32
   Else
    lTemp = lTemp Xor &H40000000 Xor lA32 Xor lB32
   End If
  Else
   lTemp = lTemp Xor lA32 Xor lB32
  End If
  Add32 = lTemp
 End Function
 ' Class initialization
 Private Sub Class_Initialize()
  Text = ""
  
  Redim m_lMask(30)
  Redim m_lPow(30)
  
  ' Make arrays of these values to save some time during the calculation
  m_lMask(0) = CLng(&H00000001&)
  m_lMask(1) = CLng(&H00000003&)
  m_lMask(2) = CLng(&H00000007&)
  m_lMask(3) = CLng(&H0000000F&)
  m_lMask(4) = CLng(&H0000001F&)
  m_lMask(5) = CLng(&H0000003F&)
  m_lMask(6) = CLng(&H0000007F&)
  m_lMask(7) = CLng(&H000000FF&)
  m_lMask(8) = CLng(&H000001FF&)
  m_lMask(9) = CLng(&H000003FF&)
  m_lMask(10) = CLng(&H000007FF&)
  m_lMask(11) = CLng(&H00000FFF&)
  m_lMask(12) = CLng(&H00001FFF&)
  m_lMask(13) = CLng(&H00003FFF&)
  m_lMask(14) = CLng(&H00007FFF&)
  m_lMask(15) = CLng(&H0000FFFF&)
  m_lMask(16) = CLng(&H0001FFFF&)
  m_lMask(17) = CLng(&H0003FFFF&)
  m_lMask(18) = CLng(&H0007FFFF&)
  m_lMask(19) = CLng(&H000FFFFF&)
  m_lMask(20) = CLng(&H001FFFFF&)
  m_lMask(21) = CLng(&H003FFFFF&)
  m_lMask(22) = CLng(&H007FFFFF&)
  m_lMask(23) = CLng(&H00FFFFFF&)
  m_lMask(24) = CLng(&H01FFFFFF&)
  m_lMask(25) = CLng(&H03FFFFFF&)
  m_lMask(26) = CLng(&H07FFFFFF&)
  m_lMask(27) = CLng(&H0FFFFFFF&)
  m_lMask(28) = CLng(&H1FFFFFFF&)
  m_lMask(29) = CLng(&H3FFFFFFF&)
  m_lMask(30) = CLng(&H7FFFFFFF&)
  ' Power operations always take time to calculate
  m_lPow(0) = CLng(&H00000001&)
  m_lPow(1) = CLng(&H00000002&)
  m_lPow(2) = CLng(&H00000004&)
  m_lPow(3) = CLng(&H00000008&)
  m_lPow(4) = CLng(&H00000010&)
  m_lPow(5) = CLng(&H00000020&)
  m_lPow(6) = CLng(&H00000040&)
  m_lPow(7) = CLng(&H00000080&)
  m_lPow(8) = CLng(&H00000100&)
  m_lPow(9) = CLng(&H00000200&)
  m_lPow(10) = CLng(&H00000400&)
  m_lPow(11) = CLng(&H00000800&)
  m_lPow(12) = CLng(&H00001000&)
  m_lPow(13) = CLng(&H00002000&)
  m_lPow(14) = CLng(&H00004000&)
  m_lPow(15) = CLng(&H00008000&)
  m_lPow(16) = CLng(&H00010000&)
  m_lPow(17) = CLng(&H00020000&)
  m_lPow(18) = CLng(&H00040000&)
  m_lPow(19) = CLng(&H00080000&)
  m_lPow(20) = CLng(&H00100000&)
  m_lPow(21) = CLng(&H00200000&)
  m_lPow(22) = CLng(&H00400000&)
  m_lPow(23) = CLng(&H00800000&)
  m_lPow(24) = CLng(&H01000000&)
  m_lPow(25) = CLng(&H02000000&)
  m_lPow(26) = CLng(&H04000000&)
  m_lPow(27) = CLng(&H08000000&)
  m_lPow(28) = CLng(&H10000000&)
  m_lPow(29) = CLng(&H20000000&)
  m_lPow(30) = CLng(&H40000000&)
 End Sub
End Class
%>

test_page.asp

Code:

<!--#include virtual="pages/includes/facebook.asp"-->
<!--#include file="includes/md5.asp"-->
<%

dim oFacebook
set oFacebook = new FaceBook
oFacebook.ApiKey = "(add your key)"
oFacebook.SecretKey = "(add your key)"
Call oFacebook.SetProfileFBML(myUserFacebookId, "Hello World!")
%>

Any thoughts would be appreciated..

Cheers

Aspless

John1989 · September 11th, 2017, 08:51 AM

Hi,

Did anyone ever try to import facebook data to SQL with SSIS? I know that I have to use API. Can anybody share a sample?

Thanks
John