65.9K
CodeProject is changing. Read more.
Home

How to get mobile information using VBScript

starIconstarIconstarIconstarIcon
emptyStarIcon
starIcon

4.86/5 (20 votes)

May 28, 2009

CPOL
viewsIcon

35091

downloadIcon

355

An easy way to get mobile model number, vendors, screen size etc.

Introduction

This article will show you basic user agent / mobile capabilities (mobile model, vendors etc.,) profiling using simple VBScript.

Background

I created a WAP application for getting information about mobile hand set models and their vendors and store it in a simple text file. At first, I decided to create an application using Java, but the problem is that people need to download and install the application; finally, I decided to create a simple WML encoding ASP page.

Using the code

We will now discuss about the ways you can store the handset models and their vendors. At first, I would like to show you the basic UAProfile attribute fetching routine where I use Msxml2.dll, and it has no internal dependencies. The sample code is given below:

'Function GetValue(): used for HTTP POST/Get and XML parsing 

Function GetValue(ByVal url, ByVal name)

//###############################################
// Author: Md. Marufuzzaman
// Basic UapProfile attribute fetching routine
// Internal Dependencies: None
// !!! Mother of all UAP Routines
// ###############################################

    On Error Resume Next
    Dim http
    Dim document
    Dim namespaces
    Dim node
    Dim xpath

    Set http = Server.CreateObject("Msxml2.XMLHTTP")
    http.Open "GET", url, False
    http.Send
    
    
    If http.Status <> "200" Then
         GetValue = Nothing
         Exit Function
    End If

    Set document = Server.CreateObject("Msxml2.DOMDocument")
    document.async = False
    document.validateOnParse = False
    document.resolveExternals = False
    document.load http.responseBody

    If document.parseError.errorCode <> 0 Then
         GetValue = Nothing
         Exit Function
    End If
         
    document.setProperty "SelectionLanguage","XPath"
    xpath = "//*[local-name() = '" & name & "']"

    Set node = document.selectSingleNode(xpath)

    If Not node Is Nothing Then
         GetValue = node.Text
    Else
         GetValue = Nothing
    End If

    Set document = Nothing
    Set http = Nothing


End Function

'Function GetWidth(): Get mobile screen width

Function GetWidth()
//##################################################
// Author: Md. Marufuzzaman
// Gets the Screen Height of the Mobile screen 
// !!! Local Function Defendencies:              
// GetValue()                                 
// Revision:                                
//##################################################

    profile=replace(Request.ServerVariables("HTTP_PROFILE"),chr(34),"")
    xwapprofile=replace(Request.ServerVariables("HTTP_X_WAP_PROFILE"), _
                        chr(34),"")
    profileurl=    profile
    if profile= "" then
         vProf = split(xwapprofile,",")
         profileurl= vProf(0)
    end if
        
            
    //-----------------------------------------------------------
    retval = GetValue(profileurl,"ScreenSize")
    if retval <> "" then
        screenpara = split(retval,"x") //ok 
        GetWidth= screenpara(lbound(screenpara)) //OK
    else
        GetWidth= 144 //<------- the default width
    end if
    //-----------------------------------------------------------

End Function


'Function GetHeight(): Get mobile screen height

Function GetHeight()

//##################################################
// Author: Md. Marufuzzaman
// Gets the Screen Height of the Mobile screen //
// !!! Local Function Defendencies:              //
// GetValue()                                 //
// Revision:                                //
//###########################################
            
    profile=replace(Request.ServerVariables("HTTP_PROFILE"),chr(34),"")
    xwapprofile=replace(Request.ServerVariables("HTTP_X_WAP_PROFILE"), _
                        chr(34),"")
    profileurl=    profile
    if profile= "" then
         vProf = split(xwapprofile,",")
         profileurl= vProf(0)
    end if
    
    //-----------------------
    retval = GetValue(profileurl,"ScreenSize")
    
    if  retval <> "" then
        screenpara = split(retval,"x") //ok 
        GetHeight=screenpara(ubound(screenpara))
    else
        GetHeight= 176 //<---- the default height 
    end if
    //--------------

End Function

'Function Is_PDA(): Return true if the request from Windows PDA browser.

Function Is_PDA()

//###############################################
// Author: Md. Marufuzzaman
// Detect Windows CE/OS PDA
// // ###############################################

    Dim varUAProfile
    Dim varArray
    Dim variCounter
                            
    varUAProfile = Request.ServerVariables("HTTP_USER_AGENT")
    
    varUAProfile = varUAProfile & " #"    
    varArray = split(varUAProfile, " " )
        
    variCounter = 0

        while varArray(variCounter) <> "#"
            
            if ucase(varArray(variCounter)) = "WINDOWS" OR _
               ucase(varArray(variCounter+1)) = "CE" then

                Is_PDA = True
                Exit Function
            else
                Is_PDA = False
            end if
            
            variCounter = variCounter + 1
        wend
End Function

'Function HandSetMode(): Get the device model and the vendors 
'                        and store into a text file.

Function HandSetMode ()
//###########################################
// Author: Md. Marufuzzaman                   
// Revision:                               
//##########################################


  Dim fs,fname
  Dim varVendor,varHandSetModel,varData
  Dim varProf,varWapProfile
  Dim varProfile 
    
  varProfile=replace(Request.ServerVariables("HTTP_PROFILE"),chr(34),"")
  varWapProfile=replace(Request.ServerVariables("HTTP_X_WAP_PROFILE"),chr(34),"")

  profileurl = varProfile

    if varProfile= "" then
        varProf = split(varWapProfile,",")
          profileurl=varProf(0)
    end if        
    
    varVendor= ucase(GetValue(profileurl,"Vendor"))
    varHandSetModel= ucase(GetValue(profileurl,"Model"))
        
    varData = "Vendor:-" & varVendor & ", HandSet_Model # " & _
              varHandSetModel & ", UAProf:" & profileurl & _
              ", TimeStamp # " & Now()

    set fs=Server.CreateObject("Scripting.FileSystemObject")
    set fname=fs.OpenTextFile(Server.MapPath("HandSetList.txt"),8,true)
    // 8 = ForAppending

    fname.WriteLine(varData)

    fname.Close
    
    set fname=nothing
    set fs=nothing

End Function

Sample code of ASP page with WML encoding:

// Include the header file UAProfiling.in (VBScript files)

<?xml version="1.0"?>
<!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.1//EN" 
   "http://www.wapforum.org/DTD/wml_1.1.xml">

<wml>
<card id="profileview" title="Mobile Capabilities">

<p align="center">

<%

' Call the VBScript function

%>

</p>
</card>
</wml>

In thr above function GetValue(), I create two objects:

  1. Msxml2.XMLHTTP, used for the HTTP GET.
  2. Msxml2.DOMDocument, used for the XML parsing.

Conclusion

I hope that it might be helpful to you. Enjoy!