Генератор
Проектов

Проект abookdbs

Описание

Проект addrbookdbs представляет реализацию адресной книги в виде сервера, обрабатывающего HTTP-запросы из браузера.

Задача

Разработка web-приложения для браузера с функциями ведения адресной книги (создание, редактирование, удаление записей).

Преимущества решения

Механизма описания html-страниц - gblk - позволяет использовать все возможности генераторного языка с полным контролем типов. Обычные средства разработки web -приложений страдают практически полным отсутствием контроля типов, что приводит к сложностям в развитии и поддержке проектов, особенно больших. Также разработчик может использовать простое и компактное взаим В данном примере не предполагается взаимодействие со стандартным промышленным web-сервером, но в реальном проекте для этого декларируется cgi или fastcgi агент. В данном примере используются только обычные web-запросы (с формированием новой html-страницы), однако могут быть использованы и json-запросы. Данные, которыми оперирует сервер и которые используются при построении html-страниц, упакованы в документ, построенный по принципу один-ко-многим, так называемая сетевая база данных в оперативной памяти. Такой документ обладает в генераторчном языке удобными и функционально полными процедурами обработки и передачи между всеми программными компонентами, включая, при необходимости, и мобильные приложения.

Подробнее

В проект addrbookdbs декларированы следующие компоненты: wport - группа запросов, объединенных одним именем команды в URL (webaddr.wpr). Имя команды указывается в опции actname для wport (в данном примере - action). В нем декларируются как обычные web-запросы, так и json-запросы. hserver - сервер обработки HTTP запросов (addrsrv.srv). hport - логический порт, обрабатывающий указанные в нем запросы (как обычные web-запросы, так и json-запросы) (hpraddr.hprt). В логическом hport описана реакция сервера на каждый конкретный HTTP запрос. По результатам web-запроса формируется новая html-страница. (По результатам json-запроса формируется json документ) Связь hserver и hport такая: в hserver декларируются обрабатываемые http-запросы (номер порта), для каждого порта указывается перечень обрабатываемых логических портов hport.

Информация хранится в реляционной базе данных. Для создания и обновления БД используется утилита addrdbs_utl. Данный компонент просто декларируется в проекте. Описав в проекте схему базы данных и задав имя утилиты, автоматически получаем утилиту для управления базой данных проекта. Доступ сервера к базе осуществляются в его конфигурационном файле. Для разработчика взаимодействие с базой данных абсолютно прозрачно и мультиплатформенно, а также крайне компактно в коде, при этом опять используется полный контроль типов.

Данные, которыми оперирует сервер и которые используются при построении html-страниц, упакованы в документ, построенный по принципу один-ко-многим, так называемая сетевая мини база данных.

Рекомендации по установке

Для связи с нашим сервером (addrsrv) необходимо указать в адресной строке браузера: <IP-адрес сервера>:<порт сервера webport.waddr port><имя скрипта webport.waddr script_name> Порт и имя скрипта настраиваются в конфигурационном файле сервера addrsrv.conf. По умолчанию доступ на локальном компьютере по следующему адресу: 127.0.0.1:7200/hprt1/hpraddr

В сгенерируемых автоматически тестовых данных доступ такой (логин/пароль): admin/pass login1/password1 login2/password2 ...

Перечень файлов проекта

Файл abookdbs.gen:

project abookdbs
  /firm="УСТ"
  /version="01.001"
  /http="http://www.ustech.ru"
  /email="managers@ustech.ru"

package apkg

database addrdbs

wport webaddr

gblk gblk_addr

gcss styletut

wscript wsctut

httpsrvspec addrsrvspec

httpsrv addrsrv

dbsutility addrdbs_utl

Файл apkg.package:

package apkg

type t_mess : char8[300];
type t_login : char8[50];
  /title="Логин"
  /html_escape
type t_password : char8[50];
  /password
  /html_escape
type t_name1 : char8[80];
  /title="Фамилия"
  /html_escape
type t_name2 : char8[80];
  /title="Имя"
  /html_escape
type t_name3 : char8[80];
  /title="Отчество"
  /html_escape
type t_email : char8[60];
  /title="E-mail"
  /html_escape
type t_www : char8[100];
  /title="Сайт"
  /html_escape
type t_phone : char8[20];
  /html_escape
type t_user_info : struct
( t_login login,
  t_name1 name1,
  t_name2 name2,
  t_name3 name3,
  t_email email,
  t_www www,
  t_phone phone_office,
  t_phone phone_mobile,
  t_phone phone_home
);
  /io_used
type t_pswhash : char8[50];
type t_sesshash : char8[50];
type t_cnf : struct
( gsystem.t_filename7 prj_version
);
  /used

procdecl eval_hash(t_login login,t_password password,out t_pswhash pswhash);
procdecl test_www(out t_www www);

implementation

type t_loginhash : char8[100];

procdecl eval_hash(t_login login,t_password password,out t_pswhash pswhash)
{ var
    t_loginhash loginhash := login;

  loginhash += password;
  ghash.md5(loginhash,pswhash);
}

procdecl test_www(out t_www www)
{ var
    t_www www0,
    int i;

  www := "http://www.panoramio.com/photo/7";

  for ( i := 0; i < 6; i += 1 )
  { var
      int code;

    rand.i(1,9,code);
    www0[i] := byte('0')+ code;
  }

  www0[i] := byte(0);
  www += www0;
}

Файл apkg.package:

database addrdbs;
  /driver=(dbd_sqlite)

type t_user : struct
( apkg.t_login login,
  apkg.t_name1 name1,
  apkg.t_name2 name2,
  apkg.t_name3 name3,
  apkg.t_email email,
  apkg.t_www www,
  apkg.t_phone phone_office,
  apkg.t_phone phone_mobile,
  apkg.t_phone phone_home,
  apkg.t_pswhash pswhash,
  apkg.t_sesshash sesshash,
  bool admin
);

table user : t_user;
  select output out user_sel(login):(*);
  insert input inp user_ins(*);
  update output out user_upd(login):(*);
  delete user_del(login);
  cursor output yuser user_cur():(*);
index i_user on user unique(login);

sql user_cnt
(
):
( int cnt
)
  select
    count(*)
  from
    user;

fprocdecl user_to_info(t_user yuser,out apkg.t_user_info yinfo);
fprocdecl info_to_user(apkg.t_user_info yinfo,inout t_user yuser);

implementation

fprocdecl user_to_info(t_user yuser,out apkg.t_user_info yinfo)
{ yinfo.login := yuser.login;
  yinfo.name1 := yuser.name1;
  yinfo.name2 := yuser.name2;
  yinfo.name3 := yuser.name3;
  yinfo.email := yuser.email;
  yinfo.www := yuser.www;
  yinfo.phone_office := yuser.phone_office;
  yinfo.phone_mobile := yuser.phone_mobile;
  yinfo.phone_home := yuser.phone_home;
}

fprocdecl info_to_user(apkg.t_user_info yinfo,inout t_user yuser)
{ yuser.login := yinfo.login;
  yuser.name1 := yinfo.name1;
  yuser.name2 := yinfo.name2;
  yuser.name3 := yinfo.name3;
  yuser.email := yinfo.email;
  yuser.www := yinfo.www;
  yuser.phone_office := yinfo.phone_office;
  yuser.phone_mobile := yinfo.phone_mobile;
  yuser.phone_home := yinfo.phone_home;
}

Файл webaddr.wport:

wport webaddr
  /actname="action"

webreq login(apkg.t_login login,apkg.t_password password);
  /oper=(href,form)
  /log=full
webreq logout();
  /oper=(ahref)
  /log=full
webreq password(apkg.t_password password,apkg.t_password password1,apkg.t_password password2);
  /oper=(ahref,form)
  /log=full
webreq users();
  /oper=(ahref)
  /log=full
webreq user_info(apkg.t_login login);
  /oper=(ahref)
  /log=full
webreq user_del(apkg.t_login login);
  /oper=(ahref)
  /log=full
webreq user_psw(apkg.t_login login,apkg.t_password password1,apkg.t_password password2);
  /oper=(form)
  /log=full
webreq user_upd(apkg.t_user_info yinfo);
  /oper=(form)
  /log=full
webreq user_new0(apkg.t_user_info yinfo);
  /oper=(ahref)
  /log=full
webreq user_new(apkg.t_user_info yinfo,apkg.t_password password1,apkg.t_password password2);
  /oper=(form)
  /log=full

Файл gblk_addr.gblk:

gblk gblk_addr

<$blockdecl users(string7 prj_version,addrdbs.addrdbs adbs,addrdbs.t_user yuser0,string8 mess)>
<$blockdecl password(string7 prj_version,addrdbs.t_user yuser0,string8 mess)>
<$blockdecl user(string7 prj_version,addrdbs.t_user yuser0,addrdbs.t_user yuser,string8 mess)>
<$blockdecl user_new(string7 prj_version,addrdbs.t_user yuser0,apkg.t_user_info yinfo,apkg.t_password password1,apkg.t_password password2,string8 mess)>
<$blockdecl login(string7 prj_version,apkg.t_login login,string8 mess)>

<$implementation>

<$block head(string8 title)>
  <head>
    <title><$text(title)></title>
    <meta http-equiv='Content-Type' content='text/html; charset=UTF-8'>
    <meta http-equiv='Pragma' content='no-cache'>
    <meta http-equiv='Cache-Control' content='no-cache'>
    <link rel='icon' type='image/png' href='wsctut/images/favicon.png'>
    <link rel='stylesheet' type='text/css' href='/wsctut/styletut.css' media='all'/>
  </head>
</$block>

<$block footer(string7 prj_version)>
  <p style='font-size:11px' align='right'>Технология ГП<br>WEB-интерфейс адресной книги, версия: <$text(prj_version)></p>
</$block>

<$block menu(addrdbs.t_user yuser0,string8 mess)>
  <p>Сотрудник <$text(yuser0.login," ",yuser0.name1," ",yuser0.name2," ",yuser0.name3)></p>
  <table>
    <tr>
      <td><a $href=webaddr.users()>Сотрудники</a></td>
      <td><a $href=webaddr.password("","","")>Смена пароля</a></td>
      <$if( yuser0.admin )>
        <$oper
          var
            apkg.t_user_info yinfo;
        >
        <td><a $href=webaddr.user_new0(yinfo)>Новый сотрудник</a></td>
      </$if>
      <td><a $href=webaddr.logout()>Выход</a></td>
    </tr>
  </table>

  <hr align='left'>
  <$if( mess <> "" )>
    <p><$text(mess)></p>
    <hr align='left'>
  </$if>
</$block>

<$blockdecl user_new(string7 prj_version,addrdbs.t_user yuser0,apkg.t_user_info yinfo,apkg.t_password password1,apkg.t_password password2,string8 mess)>
<html>
  <$call head("")>
  <body>
    <$call menu(yuser0,mess)>
    <p><a $href=webaddr.users()><img src='/wsctut/images/logo.png' border='0' align='center'></a></p>
    <$form webaddr.user_new(yinfo,password1,password2) method='get' enctype='multipart/form-data' name="user_new" id="id-form_user_new">
      <table>
        <tr><td></td><td>Редактирование реквизитов сотрудника</td></tr>
        <tr><td align='right'><$text(TITLE(yinfo.login))>:</td><td><$input yinfo.login></td></tr>
        <tr><td align='right'><$text(TITLE(yinfo.name1))>:</td><td><$input yinfo.name1></td></tr>
        <tr><td align='right'><$text(TITLE(yinfo.name2))>:</td><td><$input yinfo.name2></td></tr>
        <tr><td align='right'><$text(TITLE(yinfo.name3))>:</td><td><$input yinfo.name3></td></tr>
        <tr><td align='right'><$text(TITLE(yinfo.email))>:</td><td><$input yinfo.email></td></tr>
        <tr><td align='right'><$text(TITLE(yinfo.www))>:</td><td><$input yinfo.www></td></tr>
        <tr><td align='right'>Рабочий телефон:</td><td><$input yinfo.phone_office></td></tr>
        <tr><td align='right'>Мобильный телефон:</td><td><$input yinfo.phone_mobile></td></tr>
        <tr><td align='right'>Домашний телефон:</td><td><$input yinfo.phone_home></td></tr>
        <tr><td align='right'>Пароль:</td><td><$input password1></td></tr>
        <tr><td align='right'>Еще раз новый пароль:</td><td><$input password2></td></tr>
        <tr><td></td><td><input type='submit' name='sub' value='Отправить'></td></tr>
      </table>
    </$form>
    <$call footer(prj_version)>
  </body>
</html>
</$blockdecl>

<$blockdecl user(string7 prj_version,addrdbs.t_user yuser0,addrdbs.t_user yuser,string8 mess)>
<html>
  <$oper
    var
      char8 txt[1023];
  >
  <$call head("")>
  <body>
    <$call menu(yuser0,mess)>
    <p><a $href=webaddr.users()><img src='/wsctut/images/logo.png' border='0' align='center'></a></p>

    <table>
      <tr><td align='right'><$text(TITLE(yuser.name1))>:</td><td><$text(yuser.name1)></td></tr>
      <tr><td align='right'><$text(TITLE(yuser.name2))>:</td><td><$text(yuser.name2)></td></tr>
      <tr><td align='right'><$text(TITLE(yuser.name3))>:</td><td><$text(yuser.name3)></td></tr>
      <tr><td align='right'><$text(TITLE(yuser.login))>:</td><td><$text(yuser.login)></td></tr>
      <tr><td align='right'><$text(TITLE(yuser.email))>:</td><td><$text(yuser.email)></td></tr>
      <tr><td align='right'><$text(TITLE(yuser.www))>:</td><td><a href=(string(txt,yuser.www)) target='_blank'><$text(yuser.www)></a></td></tr>
      <tr><td align='right'>Тел. рабочий:</td><td><$text(yuser.phone_office)></td></tr>
      <tr><td align='right'>Тел. мобильный:</td><td><$text(yuser.phone_mobile)></td></tr>
      <tr><td align='right'>Тел. домашний:</td><td><$text(yuser.phone_home)></td></tr>
    </table>

    <$if( yuser0.admin )>
      <$oper
        var
          apkg.t_user_info yinfo;
      >
      <$oper
        call addrdbs.user_to_info(yuser,yinfo);
      >
      <$form webaddr.user_upd(yinfo) method='get' enctype='multipart/form-data' name="user_upd" id="id-form_user_upd">
        <hr align='left'>
        <table>
          <tr><td></td><td>Редактирование реквизитов сотрудника</td></tr>
          <tr><td align='right'><$text(TITLE(yinfo.login))>:</td><td><$input yinfo.login></td></tr>
          <tr><td align='right'><$text(TITLE(yinfo.name1))>:</td><td><$input yinfo.name1></td></tr>
          <tr><td align='right'><$text(TITLE(yinfo.name2))>:</td><td><$input yinfo.name2></td></tr>
          <tr><td align='right'><$text(TITLE(yinfo.name3))>:</td><td><$input yinfo.name3></td></tr>
          <tr><td align='right'><$text(TITLE(yinfo.email))>:</td><td><$input yinfo.email></td></tr>
          <tr><td align='right'><$text(TITLE(yinfo.www))>:</td><td><$input yinfo.www></td></tr>
          <tr><td align='right'>Рабочий телефон:</td><td><$input yinfo.phone_office></td></tr>
          <tr><td align='right'>Мобильный телефон:</td><td><$input yinfo.phone_mobile></td></tr>
          <tr><td align='right'>Домашний телефон:</td><td><$input yinfo.phone_home></td></tr>
          <tr><td></td><td><input type='submit' name='sub' value='Отправить'></td></tr>
        </table>
      </$form>
    </$if>


    <$if( yuser0.admin )>
      <$oper
        var
          apkg.t_password password1,
          apkg.t_password password2;
      >
      <$form webaddr.user_psw(yuser.login,password1,password2) method='get' enctype='multipart/form-data' name="user_psw" id="id-form_user_psw">
        <hr align='left'>
        <table>
          <tr><td></td><td>Смена пароля сотрудника</td></tr>
          <tr><td align='right'>Пароль:</td><td><$input password1></td></tr>
          <tr><td align='right'>Еще раз новый пароль:</td><td><$input password2></td></tr>
          <tr><td></td><td><input type='submit' name='sub' value='Отправить'></td></tr>
        </table>
      </$form>
    </$if>

    <$if( yuser0.admin )>
      <hr align='left'>
      <a $href=webaddr.user_del(yuser.login)>Удалить сотрудника</a>
    </$if>

    <$call footer(prj_version)>
  </body>
</html>
</$blockdecl>

<$blockdecl password(string7 prj_version,addrdbs.t_user yuser0,string8 mess)>
<html>
  <$call head("")>
  <body>
    <$call menu(yuser0,mess)>
    <p><a $href=webaddr.users()><img src='/wsctut/images/logo.png' border='0' align='center'></a></p>
    <$oper
      var
        apkg.t_password password,
        apkg.t_password password1,
        apkg.t_password password2;
    >
    <$form webaddr.password(password,password1,password2) method='get' enctype='multipart/form-data' name="password" id="id-form_password">
      <hr align='left'>
      <table>
        <tr><td></td><td>Смена пароля</td></tr>
        <tr><td align='right'>Старый пароль:</td><td><$input password1></td></tr>
        <tr><td align='right'>Новый пароль:</td><td><$input password1></td></tr>
        <tr><td align='right'>Еще раз новый пароль:</td><td><$input password2></td></tr>

        <tr><td></td><td><input type='submit' name='sub' value='Отправить'></td></tr>

      </table>
    </$form>

    <$call footer(prj_version)>
  </body>
</html>
</$blockdecl>

<$blockdecl users(string7 prj_version,addrdbs.addrdbs adbs,addrdbs.t_user yuser0,string8 mess)>
<html>
  <$oper
    var
      char8 txt[1023];
  >
  <$call head(U"Список сотрудников")>
  <body>
    <$call menu(yuser0,mess)>
    <p><a $href=webaddr.users()><img src='/wsctut/images/logo.png' border='0' align='center'></a></p>
    <table>
      <$oper
        var
          addrdbs.user_cur sql;
      >
      <tr>
        <td><$text(TITLE(sql.yuser.login))></td>
        <td><$text(TITLE(sql.yuser.name1))></td>
        <td><$text(TITLE(sql.yuser.name2))></td>
        <td><$text(TITLE(sql.yuser.name3))></td>
        <td><$text(TITLE(sql.yuser.email))></td>
      </tr>
      <$oper
        addrdbs.user_cur_open_err(adbs,sql);
      >
      <$for ( ; ; )>
        <$oper
          addrdbs.user_cur_fetch_err(adbs,sql);
        >
        <$if( adbs.sqlcode <> 0 )>
          <$oper
            break;
          >
        </$if>
        <tr>
          <td><a $href=webaddr.user_info(sql.yuser.login)><$text(sql.yuser.login)></a></td>
          <td><$text(sql.yuser.name1)></td>
          <td><$text(sql.yuser.name2)></td>
          <td><$text(sql.yuser.name3)></td>
          <td><a href=(string(txt,"mailto:",sql.yuser.email))><$text(sql.yuser.email)></a></td>
        </tr>
      </$for
      >
      <$oper
        addrdbs.user_cur_close_err(adbs,sql);
      >
    </table>

    <$call footer(prj_version)>
  </body>
</html>
</$blockdecl>

<$blockdecl login(string7 prj_version,apkg.t_login login,string8 mess)>
<html>
  <$call head(U"Адресная книга")>
  <body>
    <p><img src='/wsctut/images/logo.png' border='0' align='center'></p>
    <$if( mess <> "" )>
      <hr align='left'>
      <p><$text(mess)></p>
    </$if>

    <$oper
      var
        apkg.t_password password;
    >

    <$form webaddr.login(login,password) method='get' enctype='multipart/form-data' name="login" id="id-form_login">
      <hr align='left'>
      <table>
        <tr><td></td><td>Вход в систему</td></tr>
        <tr><td align='right'><$text(TITLE(login))>:</td><td><$input login></td></tr>
        <tr><td align='right'>Пароль:</td><td><$input password></td></tr>

        <tr><td></td><td><input type='submit' name='sub' value='Отправить'></td></tr>

      </table>
    </$form>

    <$call footer(prj_version)>
  </body>
</html>
</$blockdecl>

Файл styletut.gcss:

gcss styletut

html
{ height: 100%;
}

body
{ font-family: Ubuntu,"Bitstream Vera Sans","DejaVu Sans",Tahoma,sans-serif;
  font-size: 16px;
}

a
{ color: #000080;
  text-decoration: none;
}

a:hover
{ color: #000080;
  text-decoration: none;
}

p
{ font-size: 18px;
  line-height:1.5;
  width: 800px;
}

textarea
{ font-size: 17px;
  line-height:1.5;
  width: 800px;
}

pre
{ font-size: 17px;
  line-height:1.5;
  width: 800px;
}

hr
{ width: 800px;
}

td
{ font-size: 16px;
}

Файл wsctut.wscript:

wscript wsctut
  /vers

gcss styletut

dir "images"
{
  file "favicon.png"
  file "logo.png"
}

Файл addrsrvspec.httpsrvspec:

httpsrvspec addrsrvspec:"ADDRSRV"

database adbs:addrdbs

vhost hprt1
  /wscript=wsctut
(
  script script1
  (
    webport webaddr
  )
)

Файл addrsrv.httpsrv:

httpsrv addrsrv httpsrvspec addrsrvspec
  /regfile="addrdbs_bas.sqlite"

proc check_login(web.t_web xweb,addrdbs.addrdbs adbs,out addrdbs.t_user yuser0,out apkg.t_mess mess)
{ var
    apkg.t_login login,
    apkg.t_sesshash sesshash;

  null(yuser0);
  mess := "";
  call web.find_cookie_c(xweb,"login",login);
  call web.find_cookie_c(xweb,"sesshash",sesshash);
  if ( login = "" or sesshash = "" )
    mess := U"Выполните вход в систему";
  else
  { var
      addrdbs.user_sel ysql;

    ysql.login := login;
    addrdbs.user_sel_select_err(adbs,ysql);
    yuser0 := ysql.out;
    if ( adbs.sqlcode <> 0  )
      mess := U"Нет такого пользователя";
    else if ( sesshash <> yuser0.sesshash )
    { mess := U"Повторите вход в систему";
      null(yuser0);
    }
  }
}

proc login(addrsrvspec.s_srv xsrv,web.t_web xweb,apkg.t_login login,apkg.t_password password)
{ var
    addrdbs.user_sel ysql1,
    addrdbs.t_user yuser,
    apkg.t_pswhash pswhash;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call apkg.eval_hash(login,password,pswhash);
  ysql1.login := login;
  addrdbs.user_sel_select_err(xsrv.adbs,ysql1);
  yuser := ysql1.out;
  if ( xsrv.adbs.sqlcode <> 0 or yuser.pswhash = "" or pswhash <> yuser.pswhash )
    call gblk_addr.login(xweb,xsrv.prj_version,login,U"Неправильные данные","");
  else
  { var
      addrdbs.user_upd ysql2;

    rand.c("0123456789ABCDEF",SIZEOF(apkg.t_sesshash)-2,yuser.sesshash);
    ysql2.login := yuser.login;
    ysql2.out := yuser;
    addrdbs.user_upd_update_err(xsrv.adbs,ysql2);
    web.set_cookie(xweb,"login",yuser.login,"","");
    web.set_cookie(xweb,"sesshash",yuser.sesshash,"","");
    call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser,"","");
  }
}

proc logout(addrsrvspec.s_srv xsrv,web.t_web xweb)
{ var
    addrdbs.t_user yuser0,
    apkg.t_mess mess;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call check_login(xweb,xsrv.adbs,yuser0,mess);
  if ( yuser0.login = "" )
    call gblk_addr.login(xweb,xsrv.prj_version,"","","");
  else
  { var
      addrdbs.user_upd ysql1;

    yuser0.sesshash := "";
    ysql1.login := yuser0.login;
    ysql1.out := yuser0;
    addrdbs.user_upd_update_err(xsrv.adbs,ysql1);
    web.set_cookie(xweb,"login","","","");
    web.set_cookie(xweb,"sesshash","","","");
    call gblk_addr.login(xweb,xsrv.prj_version,"","","");
  }
}

proc password(addrsrvspec.s_srv xsrv,web.t_web xweb,apkg.t_password password,apkg.t_password password1,apkg.t_password password2)
{ var
    addrdbs.t_user yuser0,
    apkg.t_mess mess;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call check_login(xweb,xsrv.adbs,yuser0,mess);
  if ( yuser0.login = "" )
    call gblk_addr.login(xweb,xsrv.prj_version,"",mess,"");
  else
  { var
      apkg.t_pswhash pswhash;

    call apkg.eval_hash(yuser0.login,password,pswhash);
    if ( password = "" and password1 = "" and password2 = "" )
      call gblk_addr.password(xweb,xsrv.prj_version,yuser0,"","");
    else if ( pswhash <> yuser0.pswhash )
      call gblk_addr.password(xweb,xsrv.prj_version,yuser0,U"Неправильный старый пароль","");
    else if ( password1 = "" )
      call gblk_addr.password(xweb,xsrv.prj_version,yuser0,U"Не задан новый пароль","");
    else if ( password1 <> password2 )
      call gblk_addr.password(xweb,xsrv.prj_version,yuser0,U"Пароли не совпадают","");
    else
    { var
        addrdbs.user_upd ysql1;

      call apkg.eval_hash(yuser0.login,password1,yuser0.pswhash);
      ysql1.login := yuser0.login;
      ysql1.out := yuser0;
      addrdbs.user_upd_update_err(xsrv.adbs,ysql1);
      call gblk_addr.login(xweb,xsrv.prj_version,yuser0.login,U"Войдите с новым паролем","");
    }
  }
}

proc users(addrsrvspec.s_srv xsrv,web.t_web xweb)
{ var
    addrdbs.t_user yuser0,
    apkg.t_mess mess;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call check_login(xweb,xsrv.adbs,yuser0,mess);
  if ( yuser0.login = "" )
    call gblk_addr.login(xweb,xsrv.prj_version,"",mess,"");
  else
    call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,"","");
}

proc user_info(addrsrvspec.s_srv xsrv,web.t_web xweb,apkg.t_login login)
{ var
    addrdbs.t_user yuser0,
    apkg.t_mess mess;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call check_login(xweb,xsrv.adbs,yuser0,mess);
  if ( yuser0.login = "" )
    call gblk_addr.login(xweb,xsrv.prj_version,"",mess,"");
  else
  { var
      addrdbs.user_sel ysql1,
      addrdbs.t_user yuser;

    ysql1.login := login;
    addrdbs.user_sel_select_err(xsrv.adbs,ysql1);
    yuser := ysql1.out;
    if ( xsrv.adbs.sqlcode <> 0 )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Неправильные данные","");
    else
      call gblk_addr.user(xweb,xsrv.prj_version,yuser0,yuser,"","");
  }
}

proc user_del(addrsrvspec.s_srv xsrv,web.t_web xweb,apkg.t_login login)
{ var
    addrdbs.t_user yuser0,
    apkg.t_mess mess;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call check_login(xweb,xsrv.adbs,yuser0,mess);
  if ( yuser0.login = "" )
    call gblk_addr.login(xweb,xsrv.prj_version,"",mess,"");
  else
  { var
      addrdbs.user_sel ysql1,
      addrdbs.t_user yuser;

    ysql1.login := login;
    addrdbs.user_sel_select_err(xsrv.adbs,ysql1);
    yuser := ysql1.out;
    if ( xsrv.adbs.sqlcode <> 0 )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Сотрудник не найден","");
    else if ( not yuser0.admin )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Не имеете права","");
    else if ( yuser.login = yuser0.login )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Нельзя удалять себя","");
    else
    { var
        addrdbs.user_del ysql2;

      ysql2.login := login;
      addrdbs.user_del_delete_err(xsrv.adbs,ysql2);
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,"","");
    }
  }
}

proc user_psw(addrsrvspec.s_srv xsrv,web.t_web xweb,apkg.t_login login,apkg.t_password password1,apkg.t_password password2)
{ var
    addrdbs.t_user yuser0,
    apkg.t_mess mess;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call check_login(xweb,xsrv.adbs,yuser0,mess);
  if ( yuser0.login = "" )
    call gblk_addr.login(xweb,xsrv.prj_version,"",mess,"");
  else
  { var
      addrdbs.user_sel ysql1,
      addrdbs.t_user yuser;

    ysql1.login := login;
    addrdbs.user_sel_select_err(xsrv.adbs,ysql1);
    yuser := ysql1.out;
    if ( xsrv.adbs.sqlcode <> 0 )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Сотрудник не найден","");
    else if ( not yuser0.admin )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Не имеете права","");
    else if ( password1 <> password2 )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Пароли не совпадают","");
    else
    { var
        addrdbs.user_upd ysql2;

      call apkg.eval_hash(yuser.login,password1,yuser.pswhash);
      yuser.sesshash := "";
      ysql2.login := yuser.login;
      ysql2.out := yuser;
      addrdbs.user_upd_update_err(xsrv.adbs,ysql2);
      call gblk_addr.user(xweb,xsrv.prj_version,yuser0,yuser,"","");
    }
  }
}

proc user_upd(addrsrvspec.s_srv xsrv,web.t_web xweb,apkg.t_user_info yinfo)
{ var
    addrdbs.t_user yuser0,
    addrdbs.t_user yuser,
    apkg.t_mess mess;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call check_login(xweb,xsrv.adbs,yuser0,mess);
  if ( yuser0.login = "" )
    call gblk_addr.login(xweb,xsrv.prj_version,"",mess,"");
  else
  { var
      addrdbs.user_sel ysql1;

    ysql1.login := yinfo.login;
    addrdbs.user_sel_select_err(xsrv.adbs,ysql1);
    yuser := ysql1.out;
    if ( xsrv.adbs.sqlcode <> 0 )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Сотрудник не найден","");
    else if ( not yuser0.admin )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Не имеете права","");
    else
    { var
        addrdbs.user_upd ysql2;

      call addrdbs.info_to_user(yinfo,yuser);
      ysql2.login := yuser.login;
      ysql2.out := yuser;
      addrdbs.user_upd_update_err(xsrv.adbs,ysql2);
      call gblk_addr.user(xweb,xsrv.prj_version,yuser0,yuser,"","");
    }
  }
}

proc user_new0(addrsrvspec.s_srv xsrv,web.t_web xweb,apkg.t_user_info yinfo)
{ var
    addrdbs.t_user yuser0,
    apkg.t_mess mess;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call check_login(xweb,xsrv.adbs,yuser0,mess);
  if ( yuser0.login = "" )
    call gblk_addr.login(xweb,xsrv.prj_version,"",mess,"");
  else
    call gblk_addr.user_new(xweb,xsrv.prj_version,yuser0,yinfo,"","","","");
}

proc user_new(addrsrvspec.s_srv xsrv,web.t_web xweb,apkg.t_user_info yinfo,apkg.t_password password1,apkg.t_password password2)
{ var
    addrdbs.t_user yuser0,
    addrdbs.t_user yuser,
    apkg.t_mess mess;

  web.html(xweb,"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">\n");
  call check_login(xweb,xsrv.adbs,yuser0,mess);
  if ( yuser0.login = "" )
    call gblk_addr.login(xweb,xsrv.prj_version,"",mess,"");
  else
  { var
      addrdbs.user_sel ysql1;

    ysql1.login := yinfo.login;
    addrdbs.user_sel_select_err(xsrv.adbs,ysql1);
    yuser := ysql1.out;
    if ( not yuser0.admin )
      call gblk_addr.users(xweb,xsrv.prj_version,xsrv.adbs,yuser0,U"Не имеете права","");
    else if ( xsrv.adbs.sqlcode = 0 )
      call gblk_addr.user_new(xweb,xsrv.prj_version,yuser0,yinfo,"","",U"Такой сотрудник уже зарегистрирован","");
    else if ( password1 <> password2 )
      call gblk_addr.user_new(xweb,xsrv.prj_version,yuser0,yinfo,"","",U"Пароли не совпадают","");
    else
    { var
        addrdbs.user_ins ysql2;

      call addrdbs.info_to_user(yinfo,yuser);
      call apkg.eval_hash(yuser.login,password1,yuser.pswhash);
      ysql2.inp := yuser;
      addrdbs.user_ins_insert_err(xsrv.adbs,ysql2);
      call gblk_addr.user(xweb,xsrv.prj_version,yuser0,yuser,"","");
    }
  }
}

proc prc_default(addrsrvspec.s_srv xsrv,web.t_web xweb)
{ web.reply_code(xweb,"302 Found\r\n");
  web.header(xweb,"Location: ");
  web.header(xweb,xsrv.yhttp_hprt1.yconf_hprt1_script1.script_name);
  web.header(xweb,"?action=login&login=&password=");
  web.header(xweb,"\r\n\r\n");
}

proc user_create(addrdbs.addrdbs adbs,inout addrdbs.t_user yuser,apkg.t_password password,bool admin)
{ var
    addrdbs.user_ins ysql1;

  yuser.admin := admin;
  call apkg.eval_hash(yuser.login,password,yuser.pswhash);
  ysql1.inp := yuser;
  addrdbs.user_ins_insert_err(adbs,ysql1);
}

proc start_fun(addrsrvspec.s_srv xsrv)
{ var
    addrdbs.user_cnt ysql1;

  addrdbs.user_cnt_select_err(xsrv.adbs,ysql1);
  if ( ysql1.cnt = 0 )
  { var
      int i;

    { var
        addrdbs.t_user yuser;

      yuser.login := "admin";
      yuser.email := "admin@example.com";
      call apkg.test_www(yuser.www);
      rand_test.name8(yuser.name1,yuser.name2,yuser.name3);
      rand_test.phone(yuser.phone_office);
      rand_test.phone(yuser.phone_mobile);
      rand_test.phone(yuser.phone_home);
      call user_create(xsrv.adbs,yuser,"pass",true);
    }

    for ( i := 0; i < 30; i += 1 )
    { var
        addrdbs.t_user yuser,
        apkg.t_password password;

      yuser.login := "login";
      yuser.login += i+1;
      password := "password";
      password += i+1;
      yuser.email := yuser.login;
      yuser.email += "@example.com";
      call apkg.test_www(yuser.www);
      rand_test.name8(yuser.name1,yuser.name2,yuser.name3);
      rand_test.phone(yuser.phone_office);
      rand_test.phone(yuser.phone_mobile);
      rand_test.phone(yuser.phone_home);
      call user_create(xsrv.adbs,yuser,password,false);
    }
  }
}

init
{ setcallback xsrv.cb_start_fun := start_fun(xsrv);
}

vhost hprt1
  /ipaddr="0.0.0.0"
  /port=7200
(
  script script1
  (
    webreq login := login(xsrv,xweb,login,password);
    webreq logout := logout(xsrv,xweb);
    webreq password := password(xsrv,xweb,password,password1,password2);
    webreq users := users(xsrv,xweb);
    webreq user_info := user_info(xsrv,xweb,login);
    webreq user_del := user_del(xsrv,xweb,login);
    webreq user_psw := user_psw(xsrv,xweb,login,password1,password2);
    webreq user_upd := user_upd(xsrv,xweb,yinfo);
    webreq user_new0 := user_new0(xsrv,xweb,yinfo);
    webreq user_new := user_new(xsrv,xweb,yinfo,password1,password2);
  )
  default := prc_default(xsrv,cb_xweb);
)

Файл addrdbs_utl.dbsutility:

dbsutility addrdbs_utl:$en"Database service utility"
  /icon16=sys_dbsutl
  /icon32=sys_dbsutl_32

database addrdbs
Скачать проект abookdbs