<%@ WebService Class="SecureService" debug="True"%>

Imports System
Imports System.Web.Services
Imports System.Web.Services.Protocols
Imports System.Data
Imports System.Data.SqlClient

<WebService( Namespace:="http://yourdomain.com/webservices" )> _
Public Class SecureService : Inherits WebService

Public AuthenticationHeader As AuthHeader

<WebMethod()> Public Function Login( username As String, password As String ) As ServiceTicket

  Dim conMyData As SqlConnection
  Dim cmdCheckPassword As SqlCommand
  Dim parmWork As SqlParameter
  Dim intUserID As Integer
  Dim intRole As Integer 
  Dim objServiceTicket As ServiceTicket
  Dim drowSession As DataRow

  ' Initialize Sql command
  conMyData = New SqlConnection( "Server=localhost;UID=sa;pwd=secret;database=myData" )
  cmdCheckPassword = New SqlCommand( "CheckPassword", conMyData )
  cmdCheckPassword.CommandType = CommandType.StoredProcedure

  ' Add parameters
  parmWork = cmdCheckPassword.Parameters.Add( _
    New SqlParameter( "@validuser", SqlDbType.Int ) )
  parmWork.Direction = ParameterDirection.ReturnValue
  cmdCheckPassword.Parameters.Add( _
    New SqlParameter( "@username", username ) )
  cmdCheckPassword.Parameters.Add( _
    New SqlParameter( "@password", password ) )
  parmWork = cmdCheckPassword.Parameters.Add( _
    New SqlParameter( "@sessionkey", SqlDbType.UniqueIdentifier ) )
  parmWork.Direction = ParameterDirection.Output
  parmWork = cmdCheckPassword.Parameters.Add( _
    New SqlParameter( "@expiration", SqlDbType.DateTime ) )
  parmWork.Direction = ParameterDirection.Output
  parmWork = cmdCheckPassword.Parameters.Add( _
    New SqlParameter( "@userID", SqlDbType.Int ) )
  parmWork.Direction = ParameterDirection.Output
  parmWork = cmdCheckPassword.Parameters.Add( _
    New SqlParameter( "@role", SqlDbType.Int ) )
  parmWork.Direction = ParameterDirection.Output

  ' Execute the command
  conMyData.Open()
    cmdCheckPassword.ExecuteNonQuery()
    objServiceTicket = New ServiceTicket
    If cmdCheckPassword.Parameters( "@validuser" ).Value = 0 Then
      objServiceTicket.IsAuthenticated = True
    objServiceTicket.SessionKey = cmdCheckPassword.Parameters( "@sessionkey" ).Value.ToString()
    objServiceTicket.Expiration = cmdCheckPassword.Parameters( "@expiration" ).Value    
    intUserID = cmdCheckPassword.Parameters( "@userID" ).Value
    intRole = cmdCheckPassword.Parameters( "@role" ).Value
    Else
      objServiceTicket.IsAuthenticated = False
    End If
  conMyData.Close()

  ' Add session to cache
  If objServiceTicket.IsAuthenticated Then
    If Context.Cache( "SessionKeys" ) Is Nothing Then
      LoadSessionKeys
    End If
    drowSession = Context.Cache( "SessionKeys" ).NewRow()
    drowSession( "session_key" ) = objServiceTicket.SessionKey
    drowSession( "session_expiration" ) = objServiceTicket.Expiration
    drowSession( "session_userID" ) = intUserID
    drowSession( "session_username" ) = username
    drowSession( "Session_role" ) = intRole
    Context.Cache( "SessionKeys" ).Rows.Add( drowSession )
  End If

  ' Return ServiceTicket
  Return objServiceTicket
End Function

<WebMethod(), SoapHeader( "AuthenticationHeader" )> _
Public Function GetLuckyNumber As Integer
  If Authenticate( AuthenticationHeader ) Then
    Return 7
  End If  
End Function

Private Sub LoadSessionKeys
  Dim conMyData As SqlConnection
  Dim dadMyData As SqlDataAdapter
  Dim dstSessionKeys As DataSet

  conMyData = New SqlConnection( "Server=localhost;UID=sa;PWD=secret;database=myData" )
  dadMyData = New SqlDataAdapter( "LoadSessionKeys", conMyData )
  dadMyData.SelectCommand.CommandType = CommandType.StoredProcedure
  dstSessionKeys = New DataSet
  dadMyData.Fill( dstSessionKeys, "SessionKeys" )
  Context.Cache.Insert( _
    "SessionKeys", _
     dstSessionKeys.Tables( "SessionKeys" ), _
     Nothing, _
     DateTime.Now.AddHours( 3 ), _
     TimeSpan.Zero )
End Sub

Private Function Authenticate( objAuthenticationHeader ) As Boolean
  Dim arrSessions As DataRow()
  Dim strMatch As String

  ' Load Session keys
  If Context.Cache( "SessionKeys" ) Is Nothing Then
    LoadSessionKeys
  End If

  ' Test for match
  strMatch = "session_key='" & objAuthenticationHeader.SessionKey
  strMatch &= "' And session_expiration > #" & DateTime.Now() & "#"
  arrSessions = Context.Cache( "SessionKeys" ).Select( strMatch )
  If arrSessions.Length > 0 Then
    Return True
  Else
    Return False
  End If  
End Function 
End Class

Public Class AuthHeader:Inherits SoapHeader
  Public SessionKey As String
End Class

Public Class ServiceTicket
  Public IsAuthenticated As Boolean
  Public SessionKey As String
  Public Expiration As DateTime
End Class