Function Facebook

[Patrique 0]

<%

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 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

 

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

 

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

 

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

 

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

 

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

 

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

 

Private Function TimeStamp()

TimeStamp = Year(Now()) & Month(Now()) & Day(Now()) & Hour(Now()) & Minute(Now()) & Second(Now())

End Function

 

End Class

%>

[luizsnpjr 0]

Patrique, como funciona este código? da um help pra mim?

[Patrique 0]

Opa, só agora vi que acabei postando o code incompleto, para ver completo e um tutorial veja no link abaixo

 

Este code server para fazer um conect login com o facebook para o seu site

 

Testado e aprovado.

 

* Lembrando que toda a aplicação conect deve ser testando localmente pelo ip e não localhost, caso contrário vai da erro.

 

http://www.codeproject.com/KB/asp/classic-asp-facebookweb.aspx