unit UserProfileLoaderDirect;

interface
uses
  forms,
  Graphics,
  Dialogs,
  SysUtils,
  pFIBDatabase,
  pFIBQuery,
  RpVisualParams,
  UserProfile;

  function getUserProfileDirect(user: TUserProfile): integer;
  function getUserProfileNoMessage(user: TUserProfile): integer;
  function getUsersListDirect(place: string; var list: string): boolean;

implementation
uses
  Status,
  Numbers, FIBQuery;






function getConnection(var qry: TpFIBQuery): Boolean;
var
  dbname: string;
  db: TpFIBDatabase;
  trn: TpFIBTransaction;
begin
//  Sleep(2000);
  result := False;

  dbname := trim( rpVisualParams_Read('UserEx_DBName', 'База данных пользователей', '') );

  db := TpFIBDatabase.Create(nil);
  qry := TpFIBQuery.Create(db);
  trn := TpFIBTransaction.Create(db);

  db.DefaultTransaction := trn;
  trn.DefaultDatabase := db;

  qry.Database := db;
  qry.Transaction := trn;

  db.DBName := trim(dbname);
  db.DBParams.Add('user_name=SYSDBA');
  db.DBParams.Add('password=masterkey');
  db.DBParams.Add('lc_ctype=WIN1251');

  if dbname <> '' then begin
    try
      db.Connected := true;
      Result := true;
    except
      try
        db.Connected := false;
      except
      end;
    end;
  end;

  if not Result then begin
    db.Free;
    qry := nil;
  end;

end;



procedure disconnect(qry: TpFIBQuery);
begin
  if qry = nil then Exit;

  try
    qry.Database.Connected := false;
  except
  end;

  qry.Database.Free;
end;




function verifyPassword( psw1, psw2: String): Boolean;
begin
  Result := psw1 = psw2;
end;




function verifyPlace( place, places: String): Boolean;
begin
  Result := CheckFilter(place, places);
end;



function authenticate(qry: TpFIBQuery; user: TUserProfile): Integer;
var
  usingCard: boolean;
begin
  usingCard := user.cardcode <> '';

  if usingCard then
    qry.SQL.Text := 'select u.id, u.name, u.descr, u.places from users u inner join cards c on (u.id = c.user_id) ' +
          'where (u.deleted is null ) and (c.code = ''' + user.cardcode + ''')'
  else
    qry.SQL.Text := 'select id, name, descr, places, psw from users where (deleted is null ) and (name = '''+user.name+''')';


  Result := 0; // verified ok
  try
    qry.Transaction.StartTransaction;
    qry.ExecQuery;
    if not qry.Eof then begin
      if not usingCard then
        if not verifyPassword( user.password, qry.FieldByName('psw').AsString) then
          Result := 2; // wrong password
    end else begin
      result := 1; // user name not found
      qry.Close;

      qry.SQL.Text := 'insert into cardlog (code, place, dt) values (''' +
            user.cardcode + ''', '''+ user.place + ''', ''' + FormatDateTime('yyyy.mm.dd hh:nn:ss', now) + ''')';
      qry.ExecQuery;
    end;

    qry.Transaction.commit;
  except
    Result := 3; // error
    qry.Transaction.Active := False;
  end;


//  user.cardcode := '';
//  user.password := '';

  if Result = 0 then
    if not verifyPlace(user.place, qry.FieldByName('places').AsString) then
      Result := 4; // wrong place

  if Result = 0 then begin
    user.id := qry.FieldByName('id').AsInteger;
    user.name := qry.FieldByName('name').AsString;
    user.descr := qry.FieldByName('descr').AsString;
  end else begin
    user.id := -1;
    user.name := '';
    user.descr := '';
  end;

//  ShowMessage(IntToStr(result));
end;


procedure getGroupRulesRecursive(qry: TpFIBQuery; user: TUserProfile; group_id: integer);
var
  parent_id: Integer;
begin
  // get parent id
  parent_id := -1;
  try
    qry.SQL.Text := 'select g.parent_id from groups g inner join groups gp on (g.parent_id = gp.id)' +
          ' where g.id=' + IntToStr(group_id);
    qry.Transaction.StartTransaction;
    qry.ExecQuery;
    if not qry.Eof then
      parent_id := qry.Fields[0].AsInteger;
    qry.Transaction.commit;
  except
    qry.Transaction.Active := False;
  end;

  // load parent first
  if parent_id <> -1 then
    getGroupRulesRecursive(qry, user, parent_id);

  // load rules
  try
    qry.SQL.Text := 'select expr, access from grouprules where access<2 and group_id=' +
          IntToStr(group_id) + ' order by ord';
    qry.Transaction.StartTransaction;
    qry.ExecQuery;

    while not qry.Eof do begin
      user.addRuleIntoLastGroup(
        '',
        qry.FieldByName('expr').AsString,
        qry.FieldByName('access').AsInteger = 1
      );
      qry.Next;
    end;

    qry.Transaction.commit;
  except
    qry.Transaction.Active := False;
  end;


end;

procedure getGroupRules(qry: TpFIBQuery; user: TUserProfile);
var
  i: Integer;
  ids: array of integer;
begin
  // populate array with group_ids that user has got
  try
    qry.SQL.Text := 'select group_id, places from usergroups where user_id=' + IntToStr(user.id);
    qry.Transaction.StartTransaction;
    qry.ExecQuery;
    i := 0;
    while not qry.Eof do begin
      if checkfilter(user.place, qry.Fields[1].AsString) then begin
        SetLength(ids, i+1);
        ids[i] := qry.Fields[0].AsInteger;
        inc(i);
      end;
      qry.Next;
    end;
    qry.Transaction.commit;
  except
    qry.Transaction.Active := False;
  end;


  // fetch rules of each group
  for i:=0 to Length(ids)-1 do begin
    user.addGroup;
    getGroupRulesRecursive(qry, user, ids[i]);
  end;

{
  qry.SQL.Text := 'select r.expr, gr.places, r.access, gr.group_id, r.ord ' +
        'from usergroups gr inner join grouprules r on (gr.group_id = r.group_id) ' +
        'where access<2 and gr.user_id = ' + IntToStr(user.id) + ' order by gr.group_id, r.ord';

  try
    qry.Transaction.StartTransaction;
    qry.ExecQuery;

    gr := -1;
    while not qry.Eof do begin

      if gr <> qry.FieldByName('group_id').AsInteger then begin
        gr := qry.FieldByName('group_id').AsInteger;
        user.addGroup;
      end;

      user.addRuleIntoLastGroup(
            qry.FieldByName('places').AsString,
            qry.FieldByName('expr').AsString,
            qry.FieldByName('access').AsInteger = 1
          );

      qry.Next;
    end;
    qry.Transaction.commit;
  except
    qry.Transaction.Active := False;
  end;
}
end;



procedure getUserRules(qry: TpFIBQuery; user: TUserProfile);
begin
  qry.SQL.Text := 'select expr, places, access, ord from userrules where access<2 and user_id = ' +
        IntToStr(user.id) + ' order by ord';

  try
    qry.Transaction.StartTransaction;
    qry.ExecQuery;

    while not qry.Eof do begin

      user.addRuleIntoAllGroups(
            qry.FieldByName('places').AsString,
            qry.FieldByName('expr').AsString,
            qry.FieldByName('access').AsInteger = 1
          );

      qry.Next;
    end;
    qry.Transaction.commit;
  except
    qry.Transaction.Active := False;
  end;

end;





procedure getCardConfirmList(qry: TpFIBQuery; user: TUserProfile);
var
  i: Integer;
begin

  SetLength(user.cardConfirmList, 0);

  qry.SQL.Text := 'select expr, places from cardconfirmlist';
  try
    qry.Transaction.StartTransaction;
    qry.ExecQuery;

    i := 0;
    while not qry.Eof do begin

      if checkfilter(user.place, qry.Fields[1].AsString) then begin
        SetLength(user.cardConfirmList, i+1);
        user.cardConfirmList[i] := qry.Fields[0].AsString;
        inc(i);
      end;
      qry.Next;
    end;
    qry.Transaction.commit;
  except
    qry.Transaction.Active := False;
  end;

end;

function getUserProfileNoMessage(user: TUserProfile): integer;
var
  qry: TpFIBQuery;
begin
  // connect to db
  if getConnection(qry) then begin

    // authentication, getting user id, name and descr:
    Result := authenticate(qry, user);
    if Result = 0 then begin

      user.clearRules;

      // group rules
      getGroupRules(qry, user);

      // user rules
      getUserRules(qry, user);

      // card confirm list
      getCardConfirmList(qry, user);
    end;

    // disconnect from db
    disconnect(qry);

  end else
    result := -1; // no connection
end;



function getUserProfileDirect(user: TUserProfile): integer;
var
  qry: TpFIBQuery;
  s: string;
begin
  ShowStatusMessageA('Вход в систему', 'подождите...', clBtnFace, clBlack, clGray);
  Application.ProcessMessages;

  // connect to db
  if getConnection(qry) then begin

    // authentication, getting user id, name and descr:
    Result := authenticate(qry, user);
    if Result = 0 then begin

      user.clearRules;

      // group rules
      getGroupRules(qry, user);

      // user rules
      getUserRules(qry, user);

      // card confirm list
      getCardConfirmList(qry, user);
    end;

    // disconnect from db
    disconnect(qry);

  end else
    result := -1; // no connection


  if Result = 0 then begin
    ShowStatusMessageA(user.name, user.descr, clLime, clBlack, clGray);
    Application.ProcessMessages;
    Sleep(1000);
  end else begin
    case result of
    -1: s:='ошибка подключения к базе данных';
    1: s:='пользователь не найден';
    2: s:='неправильный пароль';
    3: s:='ошибка запроса данных';
    4: s:='доступ запрещен';
    end;

    ShowStatusMessageA('Вход не выполнен', s, clRed, clBtnFace, clWhite);
    Application.ProcessMessages;
    Sleep(1000);
  end;

  CloseStatusMessage;
end;



function getUsersListDirect(place: string; var list: string): boolean;
var
  qry: TpFIBQuery;
begin
  list := '';
  result := false;

  if getConnection(qry) then begin

    try
      qry.SQL.Text := 'select name, places from users where deleted is null';

      qry.Transaction.StartTransaction;
      qry.ExecQuery;

      while not qry.Eof do begin
        if Trim(qry.FieldByName('name').Asstring) <> '' then
          if verifyPlace( place, qry.FieldByName('places').Asstring ) then
            list := list + qry.FieldByName('name').Asstring + #13;

        qry.Next;
      end;

      qry.Transaction.commit;
      result := true;
    except
      qry.Transaction.Active := False;
    end;

    disconnect(qry);
  end;
end;

end.


