unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinProvider, sSkinManager, sScrollBox, sFrameBar, ComCtrls,
  sStatusBar, ExtCtrls, sPanel, StdCtrls, sLabel, Buttons, sBitBtn, Masks,
  OleCtrls, SHDocVw, sGroupBox, sEdit, sComboBox, ADODB, DB, MSHTML,
  Grids, DBGrids, sRadioButton, sAlphaListBox, sDBNavigator, sDBText;

const
   InputBoxMessage = WM_USER + 200;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sSkinProvider1: TsSkinProvider;
    sStatusBar1: TsStatusBar;
    sPanel1: TsPanel;
    sPanel2: TsPanel;
    pMenu: TsPanel;
    pCenter: TsPanel;
    btnTeoriya: TsBitBtn;
    btnZadachi: TsBitBtn;
    btnKR: TsBitBtn;
    btnIDZ1: TsBitBtn;
    btnTest: TsBitBtn;
    btnAvtory: TsBitBtn;
    lblCapt: TsLabel;
    pEnter: TsPanel;
    sGroupBox1: TsGroupBox;
    lblUser: TsLabel;
    Label1: TsLabel;
    lblNoPass: TsLabel;
    cbxUser: TsComboBox;
    edPass: TsEdit;
    btnInfo: TsBitBtn;
    btnAdmin: TsBitBtn;
    pTest: TsPanel;
    lblTestVoprNum: TsLabel;
    Label5: TsLabel;
    Label4: TsLabel;
    lbTestVopr: TsListBox;
    btnTestEnd: TsBitBtn;
    Panel1: TsPanel;
    rbA: TsRadioButton;
    rbB: TsRadioButton;
    rbC: TsRadioButton;
    rbD: TsRadioButton;
    rbE: TsRadioButton;
    wbTest: TWebBrowser;
    dsUsers: TDataSource;
    tblTest: TADOTable;
    dsTest: TDataSource;
    dsResults: TDataSource;
    ADOConnection1: TADOConnection;
    tblUsers: TADOTable;
    tblResults: TADOTable;
    dsAdm: TDataSource;
    tblAdm: TADOTable;
    pAdmin: TsPanel;
    lblAdminUsers: TsLabel;
    lblAdminLog: TsLabel;
    dbgAdmin1: tdbgrid;
    dbnAdmin1: TsDBNavigator;
    btnAdminClose: TsBitBtn;
    btnAdminPassChange: TsBitBtn;
    DBGrid3: tdbgrid;
    DBNavigator1: TsDBNavigator;
    sDBText1: TsDBText;
    lblCaptUser: TsLabel;
    sPanel6: TsPanel;
    pWB: TsPanel;
    WB: TWebBrowser;
    pInfo: TsPanel;
    btnOk: TsBitBtn;
    btnOtmena: TsBitBtn;
    DBGrid1: TDBGrid;
    StringGrid1: TStringGrid;
    btnOpen: TsBitBtn;
    btnPrimery: TsBitBtn;
    btnIDZ2: TsBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure btnAdminClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure btnTeoriyaClick(Sender: TObject);
    procedure btnAdminCloseClick(Sender: TObject);
    procedure btnOtmenaClick(Sender: TObject);
    procedure cbxUserChange(Sender: TObject);
    procedure WBNavigateComplete2(Sender: TObject; const pDisp: IDispatch;
      var URL: OleVariant);
    procedure btnZadachiClick(Sender: TObject);
    procedure btnInfoClick(Sender: TObject);
    procedure btnKRClick(Sender: TObject);
    procedure btnIDZ1Click(Sender: TObject);
    procedure btnTestClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure btnAvtoryClick(Sender: TObject);
    procedure btnPrimeryClick(Sender: TObject);
    procedure btnIDZ2Click(Sender: TObject);
    procedure lbTestVoprClick(Sender: TObject);
    procedure rbAClick(Sender: TObject);
    procedure btnTestEndClick(Sender: TObject);
    procedure btnAdminPassChangeClick(Sender: TObject);
  private
    { Private declarations }
    procedure InputBoxSetPasswordChar(var Msg: TMessage); message InputBoxMessage;
  public
    { Public declarations }
    function InBase(UserName: String): Boolean;
    procedure Process(Dir: String);
  end;

var
  Form1: TForm1;
  SL, TestVopr, TestOtv, TestOtvUsr, TestID: TStringList;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.InputBoxSetPasswordChar(var Msg: TMessage);
var
  hInputForm, hEdit: HWND;
begin
  hInputForm := Screen.Forms[0].Handle;
  if (hInputForm <> 0) then
  begin
    hEdit := FindWindowEx(hInputForm, 0, 'TEdit', nil);
    SendMessage(hEdit, EM_SETPASSWORDCHAR, Ord('*'), 0);
  end;
end;

procedure FindFiles(StartFolder, Mask: string; List: TStrings;
  ScanSubFolders: boolean = False);
var
  SearchRec:  TSearchRec;
  FindResult: integer;
begin
  List.BeginUpdate;
  try
    StartFolder := IncludeTrailingBackslash(StartFolder);
    FindResult  := FindFirst(StartFolder + '*.*', faAnyFile, SearchRec);
    try
      while FindResult = 0 do
        with SearchRec do
        begin
          if (Attr and faDirectory) <> 0 then
          begin
            if ScanSubFolders and (Name <> '.') and (Name <> '..') then
              FindFiles(StartFolder + Name, Mask, List, ScanSubFolders);
          end
          else
          begin
            if MatchesMask(Name, Mask) then
              List.Append(StartFolder + Name);
          end;
          FindResult := FindNext(SearchRec);
        end;
    finally
      FindClose(SearchRec);
    end;
  finally
    List.EndUpdate;
  end;
end;

// Проверка существования пользователя в базе
function TForm1.InBase(UserName: String): Boolean;
begin
  Result := False;
  tblUsers.First;
  while not tblUsers.Eof do
  begin
    if AnsiUpperCase(UserName) =
      AnsiUpperCase(tblUsers.FieldByName('Name').AsString) then
    begin
      Result := True;
      Exit;
    end;
    tblUsers.Next
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Sl: TStringList;
begin
    Sl := TStringList.Create;
    while not tblUsers.Eof do
    begin
      Sl.Append(tblUsers.FieldByName('Name').AsString);
      tblUsers.Next;
    end;
    Sl.Sort;
    cbxUser.Items.Text := Sl.Text;
    Sl.Free;
  Caption := Application.Title;
  WB.Navigate('about:blank');
  wbTest.Anchors := [akLeft,akTop,akRight,akBottom];
  wbTest.Anchors := [akLeft,akTop,akRight,akBottom];
  wbTest.Navigate('about:blank');

  pAdmin.Left := pCenter.Left;
  pAdmin.Top := pCenter.Top;
  pAdmin.Width := pCenter.Width;
  pAdmin.Height := pCenter.Height;

  pTest.Left := pCenter.Left;
  pTest.Top := pCenter.Top;
  pTest.Width := pCenter.Width;
  pTest.Height := pCenter.Height;
  pInfo.Left := pCenter.Left;
  pInfo.Top := pCenter.Top;
  pInfo.Width := pCenter.Width;
  pInfo.Height := pCenter.Height;

  TestVopr := TStringList.Create;
  TestOtv := TStringList.Create;
  TestOtvUsr := TStringList.Create;
  TestID := TStringList.Create;

  pEnter.BringToFront;
end;

procedure TForm1.btnAdminClick(Sender: TObject);
var
  Pass: String;
begin
  PostMessage(Handle, InputBoxMessage, 0, 0);
  Pass := Trim(InputBox('Ввод пароля', 'Пароль для входа в журнал:', ''));
  tblAdm.Open;
  if Pass = tblAdm.FieldByName('admpass').AsString then
  begin
    pAdmin.Visible := True;
    pAdmin.BringToFront;
    pMenu.Enabled := False;
  end;
  tblAdm.Close;
end;

procedure TForm1.btnOkClick(Sender: TObject);
begin
  Tag := 0;
  if Trim(cbxUser.Text) = '' then
  begin

  end else
  if not InBase(Trim(cbxUser.Text)) then
  begin
    tblUsers.Append;
    tblUsers.FieldByName('Name').AsString := Trim(cbxUser.Text);
    tblUsers.FieldByName('Pass').AsString := edPass.Text;
    tblUsers.Post;
  end else
    if tblUsers.FieldByName('Pass').AsString <> edPass.Text then
    begin
      lblNoPass.Visible := True;
      Exit;
    end;
  WB.Navigate(ExtractFileDir(Application.ExeName) + '\0. Приветствие\index.htm');
  pWB.Visible := True;
  pMenu.Enabled := True;
  pEnter.Visible := False;
  sDBText1.Visible := True;
  lblCaptUser.Visible := True;
  Tag := 1;
end;

procedure TForm1.Process(Dir: String);
var
  i, j, k1, k2: integer;
begin
  pWB.Visible := False;
  pInfo.Visible := False;
  SL:=TStringList.Create;
  FindFiles(ExtractFileDir(Application.ExeName) + '\' + Dir, '*.htm', SL, False);
  for i := 0 to SL.Count - 1 do
  begin
    SL.Strings[i] := ExtractFileName(SL.Strings[i]);
    SL.Strings[i] := Copy(SL.Strings[i], 1, Length(SL.Strings[i]) - 4);
  end;
  for i := 0 to SL.Count - 2 do
    for j := i to SL.Count - 1 do
    begin
      k1 := StrToInt(Copy(SL.Strings[i], 1, Pos('.', SL.Strings[i]) - 1));
      k2 := StrToInt(Copy(SL.Strings[j], 1, Pos('.', SL.Strings[j]) - 1));
      if k2 < k1 then
        SL.Exchange(i, j);
    end;
  StringGrid1.RowCount := SL.Count;
  StringGrid1.Cols[0].Text := SL.Text;
  sl.Free;
  StringGrid1.Visible := True;
  btnOpen.Visible := True;
end;

procedure TForm1.btnTeoriyaClick(Sender: TObject);
begin
  lblCapt.Caption := 'Теория';
  Process('1. Теория');
  btnOpen.Tag := 1;
end;

procedure TForm1.btnAdminCloseClick(Sender: TObject);
begin
  pEnter.Visible := True;
  lblNoPass.Visible := False;
  pInfo.Visible := False;
  pAdmin.Visible := False;
  pWB.Visible := False;
  StringGrid1.Visible := False;
  btnOpen.Visible := False;
  lblCapt.Caption := '';
end;

procedure TForm1.btnOtmenaClick(Sender: TObject);
begin
  pMenu.Enabled := True;
  btnInfo.Enabled := False;
  pEnter.Visible := False;
  WB.Navigate(ExtractFileDir(Application.ExeName) + '\0. Приветствие\index.htm');
  pWB.Visible := True;
  lblCapt.Caption := 'Введение';
end;

procedure TForm1.cbxUserChange(Sender: TObject);
begin
  btnOk.Enabled := not (Trim(cbxUser.Text) = '');
end;

procedure TForm1.WBNavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
//  lblCapt.Caption := WB.OleObject.Document.Title;
  (WB.Document as IHTMLDocument2).ParentWindow.Focus;
end;

procedure TForm1.btnZadachiClick(Sender: TObject);
begin
  lblCapt.Caption := 'Задачи с ответами';
  Process('3. Задачи');
  btnOpen.Tag := 3;
end;

procedure TForm1.btnInfoClick(Sender: TObject);
begin
  pInfo.Visible := True;
  pInfo.BringToFront;
  lblCapt.Caption := 'Информация о результатах тестирований';
end;

procedure TForm1.btnKRClick(Sender: TObject);
begin
  lblCapt.Caption := 'Контрольные работы';
  Process('4. Контрольные работы');
  btnOpen.Tag := 4;
end;

procedure TForm1.btnIDZ1Click(Sender: TObject);
var
  SL: TStringList;
  i, j, k1, k2: integer;
  S: String;
begin
  lblCapt.Caption := 'Индивидуальные домашние задания №1';
  Process('5. ИДЗ 1');
  btnOpen.Tag := 5;
end;

procedure TForm1.btnTestClick(Sender: TObject);
  function InList(n: String): Boolean;
  var
    i: Integer;
  begin
    Result := False;
    for i := 0 to TestID.Count -1 do
      if TestID.Strings[i] = n then
      begin
        Result := True;
        Exit;
      end;
  end;
begin
  if MessageDlg(PAnsiChar('Начать тестирование?'), mtConfirmation, [mbYes, mbNo], 0) = mrno then
    Exit;
  pInfo.Visible := False;
  lblCapt.Caption := 'Тестирование';
  TestOtvUsr.Clear;
  TestVopr.Clear;
  TestOtv.Clear;
  TestID.Clear;
  lbTestVopr.Items.Clear;
  Randomize;
  repeat
    tblTest.RecNo := Random(tblTest.RecordCount) + 1;;
    if not InList(tblTest.FieldByName('id').AsString) then
    begin
      TestVopr.Append(
        ExtractFileDir(Application.ExeName) + '\7. Тест\' +
        tblTest.FieldByName('Nomer').AsString + '.htm');
        TestOtv.Append(tbltest.FieldByName('otvet').AsString);
        TestOtvUsr.Append('-');
        TestID.Append(tbltest.FieldByName('id').AsString);
        lbTestVopr.Items.Append(IntToStr(lbTestVopr.Items.Count + 1) + ' - ?');
      end;
    until TestVopr.Count >= 40;

    pTest.Visible := True;
    pTest.BringToFront;
    pMenu.Enabled := False;
    lbTestVopr.ItemIndex := 0;
    lbTestVoprClick(Sender);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  StringGrid1.ColWidths[0] := StringGrid1.Width - 4;
end;

procedure TForm1.btnOpenClick(Sender: TObject);
begin
  StringGrid1.Visible := False;
  btnOpen.Visible := False;
  case btnOpen.Tag of
  1: WB.Navigate(ExtractFileDir(Application.ExeName) + '\1. Теория\' + StringGrid1.Cells[0, StringGrid1.row] + '.htm');
  2: WB.Navigate(ExtractFileDir(Application.ExeName) + '\2. Примеры решения задач\' + StringGrid1.Cells[0, StringGrid1.row] + '.htm');
  3: WB.Navigate(ExtractFileDir(Application.ExeName) + '\3. Задачи\' + StringGrid1.Cells[0, StringGrid1.row] + '.htm');
  4: WB.Navigate(ExtractFileDir(Application.ExeName) + '\4. Контрольные работы\' + StringGrid1.Cells[0, StringGrid1.row] + '.htm');
  5: WB.Navigate(ExtractFileDir(Application.ExeName) + '\5. ИДЗ 1\' + StringGrid1.Cells[0, StringGrid1.row] + '.htm');
  6: WB.Navigate(ExtractFileDir(Application.ExeName) + '\6. ИДЗ 2\' + StringGrid1.Cells[0, StringGrid1.row] + '.htm');
  end;
  pWB.Visible := True;
  case btnOpen.Tag of
  1: lblCapt.Caption := btnTeoriya.Caption + ': ' + StringGrid1.Cells[0, StringGrid1.row];
  2: lblCapt.Caption := btnPrimery.Caption + ': ' + StringGrid1.Cells[0, StringGrid1.row];
  3: lblCapt.Caption := btnZadachi.Caption + ': ' + StringGrid1.Cells[0, StringGrid1.row];
  4: lblCapt.Caption := btnKR.Caption + ': ' + StringGrid1.Cells[0, StringGrid1.row];
  5: lblCapt.Caption := btnIDZ1.Caption + ': ' + StringGrid1.Cells[0, StringGrid1.row];
  6: lblCapt.Caption := btnIDZ2.Caption + ': ' + StringGrid1.Cells[0, StringGrid1.row];
  end;
  lblCapt.Hint := lblCapt.Caption;
end;

procedure TForm1.btnAvtoryClick(Sender: TObject);
begin
  Form2.ShowModal;
end;

procedure TForm1.btnPrimeryClick(Sender: TObject);
begin
  lblCapt.Caption := 'Примеры решения задач';
  Process('2. Примеры решения задач');
  btnOpen.Tag := 2;
end;

procedure TForm1.btnIDZ2Click(Sender: TObject);
begin
  lblCapt.Caption := 'Индивидуальные домашние задания №2';
  Process('6. ИДЗ 2');
  btnOpen.Tag := 6;
end;

procedure TForm1.lbTestVoprClick(Sender: TObject);
begin
  wbTest.Navigate(TestVopr.Strings[lbTestVopr.ItemIndex]);
  rbA.Checked := False;
  rbB.Checked := False;
  rbC.Checked := False;
  rbD.Checked := False;
  rbE.Checked := False;
  case TestOtvUsr.Strings[lbTestVopr.ItemIndex][1] of
    'A': rbA.Checked := True;
    'B': rbB.Checked := True;
    'C': rbC.Checked := True;
    'D': rbD.Checked := True;
    'E': rbE.Checked := True;
  end;
end;

procedure TForm1.rbAClick(Sender: TObject);
begin
  if lbTestVopr.ItemIndex < 0 then Exit;
  TestOtvUsr.Strings[lbTestVopr.ItemIndex] := TRadioButton(Sender).Caption;
  lbTestVopr.Items.Strings[lbTestVopr.ItemIndex] :=
    IntToStr(lbTestVopr.ItemIndex + 1) + ' - ' + TRadioButton(Sender).Caption;
end;

procedure TForm1.btnTestEndClick(Sender: TObject);
var
  i, verno: Integer;
begin
  if MessageDlg('Закончить тестирование?', mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
    Exit;
  verno := 0;
  for i := 0 to TestOtvUsr.Count -1 do
    if TestOtvUsr.Strings[i] = TestOtv.Strings[i] then
      inc(verno);
  if Tag = 1 then
  begin
  tblResults.Append;
  tblResults.FieldByName('Data').AsDateTime := Now;
  tblResults.FieldByName('Verno').AsInteger := verno;
  tblResults.FieldByName('NeVerno').AsInteger := lbTestVopr.Items.Count - verno;
  tblResults.Post;
  btnInfoClick(Sender);
  end
  else
    ShowMessage('Верных ответов: '+ inttostr(verno)+#13+
    'Неверных ответов: '+ inttostr(lbTestVopr.Items.Count - verno));
  pMenu.Enabled := True;
  pTest.Visible := False;
end;

procedure TForm1.btnAdminPassChangeClick(Sender: TObject);
var
  Pass: String;
begin
  PostMessage(Handle, InputBoxMessage, 0, 0);
  Pass := Trim(InputBox('Ввод пароля', 'Новый пароль на администрирование:', ''));
  tblAdm.Open;
  if Pass <> ''  then
  begin
    tblAdm.Edit;
    tblAdm.FieldByName('admpass').AsString := Pass;
    tblAdm.Post;
  end;
  tblAdm.Close;
end;

end.
