Христофоров Юрий
В этой статье будет рассказано, как зарегистрированным пользователям разрешить доступ к некой секретной asp странице, а посторонним нет.
Постановка задачи: Есть база данных Access 97, в которой хранятся имена зарегистрированных пользователей и их пароли, и есть некая секретная страница, доступ к которой должны иметь только пользователи, занесенные в БД. Пароли в БД требуется хранить в зашифрованном виде. Преимущество такого подхода в том, что поля базы данных, содержащие пароли, не содержат реальных значений и их нельзя использовать при входе в систему.
Для работы нам понадобится ActiveX компонент Ecrypt, который Вы можете взять на этом сайте в разделе ActiveX.
Движемся по шагам:
1. Создайте БД в Access. Имя таблицы - TUSERS. Описание полей:
n_id - Счетчик (Primary Key)
s_name - Текстовый
s_password - Текстовый
Затем создайте DSN для этой БД. При работе с WindowsNT (2000) необходимо создать System DSN, а при работе с Windows95-98 можно создать и User DSN. Дайте DSN имя reg.
2. Напишем ActiveX DLL Auth на Visual Basic 6, которая будет выполнять основную работу. Запустите Visual Basic 6 и в окне New Project выберем ActiveX DLL. Переименуем имя проекта на Auth, а имя класса на Security. Теперь надо подключить необходимые библиотеки: выбираем Project ->References...
Подключаем библиотеки Microsoft ActiveX Data Objects 2.1 Library и ECrypt 1.0 Type Library (см. выше).
3. Далее набираем следующий код:
Option Explicit
Private cn As ADODB.Connection
Private rs As ADODB.Recordset
Private sName As String 'Имя пользователя
Private sPasswd As String 'Пароль
Private sError As String
Private sResult As Integer 'Результат
Public Property Get Result() As Integer
Result = sResult
End Property
Public Property Let InitName(ByVal Name As String)
sName = Name
Public Property Let InitPassword(ByVal Passwd As String)
sPasswd = Passwd
Private Sub Class_Initialize()
sError = ""
Set cn = New ADODB.Connection
cn.Open "DSN=reg" 'Установим соединение
Set rs = New ADODB.Recordset
End Sub
Private Sub Class_Terminate()
Set rs = Nothing
Set cn = Nothing
'Регистрирует пользователей
Public Sub Register()
On Error GoTo Er
rs.Open "SELECT N_ID FROM TUSERS WHERE S_NAME='" & sName & "'", cn, 1
'Если пользователь с таким именем уже есть, то
If rs.RecordCount <> 0 Then
sResult = 1 'Возвращаем результат
rs.Close
cn.Close
Exit Sub 'Выход
End If
Dim crypt_obj As ECRYPTLib.Cryptor
Dim crypt_pass As String
Set crypt_obj = New ECRYPTLib.Cryptor
crypt_obj.Key = "Visual+Basic+6 !" 'Ключ шифрования
crypt_obj.Text = sPasswd 'Пароль
crypt_pass = crypt_obj.coder() 'Шифруем
'Добавляем новую запись
cn.Execute "INSERT INTO TUSERS (S_NAME,S_PASSWORD) VALUES ('" & Replace(sName, "'", "''") & _
"','" & Replace(crypt_pass, "'", "''") & "')"
sResult = 0 'Все прошло успешно
Exit Sub
Er:
sResult = 2 'Непредвиденная ошибка
'Проверка пользователей
Public Sub Check()
rs.Open "SELECT S_NAME,S_PASSWORD FROM TUSERS WHERE S_NAME='" & sName & "'", cn, 1
'Если нет пользователя с таким именем
If rs.RecordCount = 0 Then
sResult = 1
Dim tmp As String
tmp = rs.Fields("S_PASSWORD")
Dim uncrypt_obj As ECRYPTLib.Cryptor
Dim uncrypt_pass As String
Set uncrypt_obj = New ECRYPTLib.Cryptor
uncrypt_obj.Key = "Visual+Basic+6 !"
uncrypt_obj.Text = tmp
'Расшифровываем пароль из БД
uncrypt_pass = uncrypt_obj.decoder()
'Если они не совпадают
If uncrypt_pass <> sPasswd Then
sResult = 3
sResult = 0 'Все нормально
Компилируем проект и получаем Auth.dll.
4. Следующий шаг - это написание asp и htm страниц.
start.htm - страница с формой для ввода имени и пароля
Имя и пароль должны содержать только английские буквы и символы !!!
<form action="check.asp" method="post" >
<table border=0> <tr><td>Имя</td>
<td><INPUT type="text" name="user">
</td></tr>
<tr><td>Пароль</td><td>
<INPUT type="password" name="passwd"> </td></tr><tr><td> </td><td>
<INPUT type="submit" value="Вход">
</td></tr></table>
</form>
<p> [<ahref= "register.htm">Здесь можнозарегистрироваться</a>]
check.asp - страница для проверки имени и пароля (написана на VBScript)
<%
nm = Request.Form("user")
ps = Request.Form("passwd")
Set obj = CreateObject("Auth.Security")'Создаем объект нашей DLL
obj.InitName = nm
obj.InitPassword = ps
obj.Check
res = obj.Result
If CInt(res) = 0 Then
Session("user") = "OK" 'Установим сессионную переменную
'Перенаправим зарегистрир. пользователя на секретную страницу...
Response.Redirect "secret.asp"
If CInt(res) = 2
Then Response.Write "<h3>Ошибка базы данных!</h3>"
Response.End
If CInt(res) = 1
Then Response.Write "<h3>Вы не зарегистрированы!</h3>"
If CInt(res) = 3
Then Response.Write "<h3>Пароль неверен!</h3>"
%>
security.asp - страница, проверяющая сессионную переменную
If Session("user") <> "OK" Then
'Если сессионная переменная неверна
Response.Write "Не зарегистрированный пользователь !"
'Завершаем сценарий
register.htm - страница для новых пользователей
Здесь можно зарегистрироваться...
<center>
<form action= "register.asp" method="post">
<tableborder=0><tr><td>Имя(англ.)</td>
</td></tr><tr><td>Пароль(англ.)</td>
<td><INPUT type="password" name="passwd">
</td></tr><tr><td> </td><td>
<INPUT type="submit" value="Вход" ></td></tr>
</table>
<p> [<ahref= "start.htm">На Loginстраницу</a>]
register.asp - страница для занесения новых пользователей в БД
Set obj = CreateObject("Auth.Security")
obj.Register
If CInt(res) =
0 ThenResponse.Write
"Регистрация прошла успешно !<br>" Response.Write "Имя:"&
nm & "<br>" Response.Write "Пароль:" &ps
& "<br>" Response.Write"[<ahref='start.htm'>Login</a>]"
2 ThenResponse.Write "<h3>Ошибка базы данных!</h3>"
1 ThenResponse.Write "<h3>Пользователь с таким именем уже существует!</h3>"
secret.asp - секретная страница
<!--#include file="security.asp"-->
<html>
<body>
<h2>Вы попали сюда!</h2>
<h3>Это секретная страница !</h3>
Вот и все. Исходный файл проекта прилагается: auth.zip
Для подготовки данной работы были использованы материалы с сайта http://www.activex.net.ru/