허접이긴 한데요... 그래도 중복로그인을 어느정도는 차단할 수 있는 것 같기에 제 경험을 올려봅니다.
아니다 싶으면 과감하게 꾸짖어주세요..
맨처음 드리고 싶은 말씀은 중복로그인을 막으려면 일단 ActiveX를 통해서 처리할 수 밖에는 없다는 것을 말씀드리고 싶습니다.
그것은 ASP 에서는 Global.asa 에서 Session_OnEnd 이벤트를 통해서 세션종료를 처리하는데 웹사이트에서 로그아웃을 하지 않고 웹브라우저를 종료했을때는 일단 종료한 시점부터 Session.TimeOut 으로 설정한 시간동안 유저의 이벤트가 없는 것으로 처리해서 그 시간이 지나야만 세션을 종료처리합니다.
따라서 Session.TimeOut 에서 30분으로 설정한다면 30분동안 재접속할때는 그것이 중복로그인인지 정상로그인인지 파악이 안된다는 것이지요.
그래서 저는 ActiveX를 통해서 다음의 두가지 기능을 추가했습니다.
하나는 사용자의 랜카드 mac address를 가져와서 체크하는 것이고요.
다른 하나는 Inet 방식으로 ActiveX에서 웹서버의 특정파일에 POST 방식으로 정보를 보내는 것입니다.
먼저 랜카드 mac address를 가져오는 것입니다.
다음은 모듈부분입니다.
-----------------------
Option Explicit
Option Base 0
Private Declare Function GetNetworkParams Lib "IPHlpApi" (ByRef pFixedInfo As Any, ByRef pOutBufLen As Long) As Long
Private Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As Any, pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const ERROR_BUFFER_OVERFLOW = 111&
Private Const MAX_ADAPTER_NAME_LENGTH As Long = 260
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 132
Private Const DEFAULT_MINIMUM_ENTITIES As Long = 32
Private Const MAX_HOSTNAME_LEN As Long = 128
Private Const MAX_DOMAIN_NAME_LEN As Long = 128
Private Const MAX_SCOPE_ID_LEN As Long = 256
Private Const MIB_IF_TYPE_OTHER As Byte = 1
Private Const MIB_IF_TYPE_ETHERNET As Byte = 6
Private Const MIB_IF_TYPE_TOKENRING As Byte = 9
Private Const MIB_IF_TYPE_FDDI As Byte = 15
Private Const MIB_IF_TYPE_PPP As Byte = 23
Private Const MIB_IF_TYPE_LOOPBACK As Byte = 24
Private Const MIB_IF_TYPE_SLIP As Byte = 28
Private Type typIPStrs
tNext As Long
IpAddress As String * 16
IpMask As String * 16
Context As Long
End Type
Private Type typFixedInfo
Hostname As String * 132
DomainName As String * 132
CurrentDnsServer As Long
DnsServerList As typIPStrs
NodeType As Long
ScopeId As String * 260
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End Type
Private Type typIpAdapterInfo
tNext As Long
ComboIndex As Long
AdapterName As String * MAX_ADAPTER_NAME_LENGTH
Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
AddressLength As Long
Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
Index As Long
tType As Long
DhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As typIPStrs
GatewayList As typIPStrs
DhcpServer As typIPStrs
HaveWins As Boolean
PrimaryWinsServer As typIPStrs
SecondaryWinsServer As typIPStrs
LeaseObtained As Long
LeaseExpires As Long
End Type
Public Type typIPAdapter
AdapterName As String
AdapterType As String
Description As String
MacAdress As String
IpAddressCount As Long
IpAddress() As String
End Type
Public Type typAdapters
Count As Long
Item() As typIPAdapter
End Type
'/** GetIPAdapters
' * gets the adapters installed on local machine
' *
' * @returns typAdapters ,
' */
Public Function GetIPAdapters() As typAdapters
Dim returnAdp As typAdapters
Dim Error As Long
Dim AdapterInfoSize As Long
Dim i As Long
Dim PhysicalAddress As String
Dim AdapterInfo As typIpAdapterInfo
Dim Adapt As typIpAdapterInfo
Dim AddrStr As typIPStrs
Dim Buffer As typIPStrs
Dim pAddrStr As Long
Dim pAdapt As Long
Dim Buffer2 As typIpAdapterInfo
Dim AdapterInfoBuffer() As Byte
AdapterInfoSize = 0
Error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
If Error <> 0 Then
If Error <> ERROR_BUFFER_OVERFLOW Then
Debug.Print "GetAdaptersInfo sizing failed with error " & Error
Exit Function '>---> Bottom
End If
End If
ReDim AdapterInfoBuffer(AdapterInfoSize - 1)
Error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
If Error <> 0 Then
Debug.Print "GetAdaptersInfo failed with error " & Error
Exit Function
End If
CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)
pAdapt = -1
returnAdp.Count = 0
Do While pAdapt <> 0
returnAdp.Count = returnAdp.Count + 1
ReDim Preserve returnAdp.Item(returnAdp.Count)
With returnAdp.Item(returnAdp.Count - 1)
pAdapt = AdapterInfo.tNext
CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
Select Case Buffer2.tType
Case MIB_IF_TYPE_ETHERNET
.AdapterType = "Ethernet adapter"
Case MIB_IF_TYPE_TOKENRING
.AdapterType = "Token Ring adapter"
Case MIB_IF_TYPE_FDDI
.AdapterType = "FDDI adapter"
Case MIB_IF_TYPE_PPP
.AdapterType = "PPP adapter"
Case MIB_IF_TYPE_LOOPBACK
.AdapterType = "Loopback adapter"
Case MIB_IF_TYPE_SLIP
.AdapterType = "Slip adapter"
Case Else
.AdapterType = "Other adapter"
End Select
.AdapterName = Buffer2.AdapterName
.Description = Buffer2.Description
For i = 0 To Buffer2.AddressLength - 1
PhysicalAddress = PhysicalAddress & Hex$(Buffer2.Address(i))
If i < Buffer2.AddressLength - 1 Then
PhysicalAddress = PhysicalAddress & "-"
End If
Next i
.MacAdress = PhysicalAddress
.IpAddressCount = 0
pAddrStr = -1
Do While pAddrStr <> 0
.IpAddressCount = .IpAddressCount + 1
pAddrStr = Buffer2.IpAddressList.tNext
ReDim Preserve .IpAddress(.IpAddressCount - 1)
CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer)
.IpAddress(.IpAddressCount - 1) = Left$(Buffer.IpAddress, InStr(Buffer.IpAddress, Chr$(0)) - 1)
pAddrStr = Buffer.tNext
If pAddrStr <> 0 Then
CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, Len(Buffer2.IpAddressList)
End If
Loop
End With
pAdapt = Buffer2.tNext
If pAdapt <> 0 Then
CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)
End If
Loop
GetIPAdapters = returnAdp
End Function
--------- 모듈부분 끝----
--------- 다음은 UserControl에 추가하는 함수입니다. ------
Public Function MacAddr() As String
Dim a As typAdapters
Dim tmpVal As String
Dim i As Integer
a = GetIPAdapters
For i = 0 To a.Count
tmpVal = tmpVal & a.Item(i).MacAdress
Next
MacAddr = tmpVal
End Function
위에 있는 mac address를 가져오는 방식은 제가 구상한 것이 아니라 어느 곳인지는 잘 모르지만, 다른 사이트에서 퍼온 것입니다. 어디에서 가져온 것인지 생각이 나지 않네요..
그리고 다음은 Inet 방식으로 ActiveX에서 웹서버의 특정파일에 POST 방식으로 정보를 보내는 것입니다.
Public Sub quitSession()
URL = "http://www...../chkInUser.asp"
strPostData = "UserCode=" & m_UserCode & "&mode=OUTWEB"
strPostData = StrConv(strPostData, vbFromUnicode)
strHeader = "Content-Type: application/x-www-form-urlencoded" & vbCrLf
If Len(m_UserCode) > 0 Then
Inet1.Execute URL, "POST", strPostData, strHeader
While Inet1.StillExecuting
DoEvents
Sleep 1
Wend
End If
End Sub
Public Sub keepSession()
URL = "http://www...../chkInUser.asp"
strPostData = "UserCode=" & m_UserCode & "&mode=INWEB"
strPostData = StrConv(strPostData, vbFromUnicode)
strHeader = "Content-Type: application/x-www-form-urlencoded" & vbCrLf
If Len(m_UserCode) > 0 Then
Inet1.Execute URL, "POST", strPostData, strHeader
While Inet1.StillExecuting
DoEvents
Sleep 1
Wend
End If
End Sub
자.. 여기에서 m_UserCode 라는 변수는 유저의 ID 값인데요...
이것은 ASP에서 ActiveX Object를 구성할때 <PARAM name="UserCode" value="2">
로 추가하는 것입니다.
이를 위해서는
Const m_def_UserCode = "0"
'속성 변수:
Dim m_UserCode As String
Private Sub UserControl_InitProperties()
m_UserCode = m_def_UserCode
End Sub
'저장소에서 속성값을 로드합니다.
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_UserCode = PropBag.ReadProperty("UserCode", m_def_UserCode)
End Sub
'속성값을 저장소에 기록합니다.
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("UserCode", m_UserCode, m_def_UserCode)
End Sub
형태로 PARAM 의 UserCode 값을 m_UserCode 로 받습니다.
일단 이렇게 되면
기본적인 함수들의 구성은 끝났고요...
Private Sub UserControl_Show()
Call keepSession
End Sub
Private Sub UserControl_Terminate()
Call quitSession
End Sub
이렇게 UserControl이 시작될때하고 끝날때 keep 하고 Quit 정보가 웹서버로 전송되게 합니다.
그리고 웹서버의 chkInUser.asp에서는
mode가 INWEB일때는 INUSER 라는 테이블에 UserCode를 로그인 상태로 해놓고
mode가 OUTWEB일때는 INUSER 라는 테이블에 UserCode를 로그아웃 상태로 해놓습니다.
이렇게해놓으면 한가지 단점이 있습니다.
그것은 웹브라우저 종료가 아니라 웹페이지가 이동할때도 Usercontrol_Terminate 이벤트가 작동된다는 것입니다.
그래서 페이지가 로딩될때 UserControl_Show 가 작동되고 페이지를 클릭해서 지금페이지에서 다른페이지로 이동할때 Usercontrol_Terminate 가 되기 때문에 DB에 수시로 업데이트가 된다는 것입니다.
그런데 그런 단점도 iframe이나 기타의 방식으로 통제할 수 있을 꺼라고 봅니다.