Программный комплекс дистанционного обучения

         try

           SQLConPassLogon.Params.Values['HostName']:= UserHost;

           SQLConPassLogon.Params.Values['DataBase']:= 'ts';

           SQLConPassLogon.Params.Values['User_Name']:= EditUserLogon.text;

           SQLConPassLogon.Params.Values['Password']:= EditPasswordLogon.text;

           //запоминаем значения

           //UserHost знаем из ts.ini

           UserName:= EditUserLogon.Text;

           UserPassword:= EditPasswordLogon.Text;

           //пытаемся соединиться

           SQLConPassLogon.Connected:=true;

         except

           on EDataBaseError do

             begin

               MessageDlg('Ошибка подключения,'+#13+' повторите ввод',mtWarning,[mbOk],0);

               logonError:=True;

{

после нескольких неудачных поытках подключения

-- спросить: уверены ли вы в правильности вводимых данных

-- перейти к LogonMore

}

             end; {on EDataBaseError do}

         end; {try}

         SQLConPassLogon.Connected:=false;

         if (not logonError) //если пользователь законнектился

          then

            begin

              //сохраняем данные пользователя в sapphire.ini

              CurrentFolder_ := ExtractFilePath(Application.ExeName);

              if  (not FileExists(CurrentFolder_ + 'ts.ini')) //если файл не существует - создаем его

               then

                begin

                  AssignFile(F,CurrentFolder_+'ts.ini');

                  Rewrite(F);

                  CloseFile(F);

                end;

              IniFile:= TIniFile.Create(CurrentFolder_+'ts.ini');

              IniFile.WriteString('main','host',UserHost);

              IniFile.WriteString('main','user',UserName);

              IniFile.Free;

         end; {if (not logonError)}

         if (not logonError) then frmLogon.Close;

     end;{if (key = VK_RETURN)}

end;

procedure TfrmLogon.FormShow(Sender: TObject);

//при показе загружаем данные из sapphire.ini

var CurrentFolder: string;

     IniFileLogon: TIniFile;

begin

   logonError:=True;

   CurrentFolder := ExtractFilePath(Application.ExeName);

   //На всякий случай проверяем его существование

   if FileExists(CurrentFolder+'ts.ini')

     then

      begin

        IniFileLogon:= TIniFile.Create(CurrentFolder+'ts.ini');

        UserHost:= IniFileLogon.ReadString('main','host','');

        EditUserLogon.text:=IniFileLogon.ReadString('main','user','');

        beep;

        IniFileLogon.Free;

      end;

    StatusBarfrmLogon.Panels[0].Text:= '  '+DateToStr(now);

    StatusBarfrmLogon.Panels[1].Text:= '  host: '+UserHost;

end;

end.

unit QuestionsUnit;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type

  TFormQuestions = class(TForm)

    StatusBarQuestions: TStatusBar;

    GroupBoxQuestions: TGroupBox;

    LabelSubject: TLabel;

    LabelSection: TLabel;

    LabelTema: TLabel;

    LabelPart: TLabel;

    LabelQuestion: TLabel;

    EditQuestion: TEdit;

    LabelAnswer_a: TLabel;

    LabelAnswer_b: TLabel;

    LabelAnswer_c: TLabel;

    LabelAnswer_d: TLabel;

    EditAnswer_a: TEdit;

    EditAnswer_b: TEdit;

    EditAnswer_c: TEdit;

    EditAnswer_d: TEdit;

    ButtonOk: TButton;

    ButtonAdd: TButton;

    RadioGroup: TRadioGroup;

    ComboBoxSubject: TComboBox;

    ComboBoxSection: TComboBox;

    ComboBoxTema: TComboBox;

    ComboBoxPart: TComboBox;

    procedure FormShow(Sender: TObject);

    procedure ButtonOkClick(Sender: TObject);

    procedure ButtonAddClick(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  FormQuestions: TFormQuestions;

implementation

uses UnitDataModule;

{$R *.dfm}

procedure TFormQuestions.FormShow(Sender: TObject);

begin

   ComboBoxSubject.Text:= '';

   ComboBoxSection.Text:= '';

   ComboBoxTema.Text:= '';

   ComboBoxPart.Text:= '';

   EditQuestion.Text:= '';

   EditAnswer_a.Text:= '';

   EditAnswer_b.Text:= '';

   EditAnswer_c.Text:= '';

   EditAnswer_d.Text:= '';

   RadioGroup.ItemIndex:= -1;

   if DataModuleTs.ClientDataSetQuestions.RecordCount > 0

      then

        begin

           //заполняем ComboBoxSubject.items

           DataModuleTs.ClientDataSetQuestions.First;

           while not DataModuleTs.ClientDataSetQuestions.Eof

             do

              begin

                ComboBoxSubject.Items.Add(DataModuleTs.ClientDataSetQuestions.FieldByName('Subject').AsString);

                DataModuleTs.ClientDataSetQuestions.Next;

              end;{while}

            //заполняем ComboBoxSection.items

            DataModuleTs.ClientDataSetQuestions.First;

            while not DataModuleTs.ClientDataSetQuestions.Eof

              do

               begin

                ComboBoxSection.Items.Add(DataModuleTs.ClientDataSetQuestions.FieldByName('Section').AsString);

                DataModuleTs.ClientDataSetQuestions.Next;

              end;{while}

             //заполняем ComboBoxTema.items

            DataModuleTs.ClientDataSetQuestions.First;

            while not DataModuleTs.ClientDataSetQuestions.Eof

              do

               begin

                ComboBoxTema.Items.Add(DataModuleTs.ClientDataSetQuestions.FieldByName('Tema').AsString);

                DataModuleTs.ClientDataSetQuestions.Next;

              end;{while}

            //заполняем ComboBoxPart.items

            DataModuleTs.ClientDataSetQuestions.First;

            while not DataModuleTs.ClientDataSetQuestions.Eof

              do

               begin

                ComboBoxPart.Items.Add(DataModuleTs.ClientDataSetQuestions.FieldByName('Part').AsString);

                DataModuleTs.ClientDataSetQuestions.Next;

              end;{while}

       end;{begin}

end;

procedure TFormQuestions.ButtonOkClick(Sender: TObject);

begin

  FormQuestions.Close;

end;

procedure TFormQuestions.ButtonAddClick(Sender: TObject);

var scriptAdd: string;

     a,b,c,d :string;

begin

   a:= EditAnswer_a.Text;

   b:= EditAnswer_b.Text;

   c:= EditAnswer_c.Text;

   d:= EditAnswer_d.Text;

   //проверка правильного ответа

   case RadioGroup.ItemIndex of

   0: a:='@@'+a;

   1: b:='@@'+b;

   2: c:='@@'+c;

   3: d:='@@'+d;

   else

     MessageDlg('не выбран правильный ответ',mtError,[mbCancel],0);

   end;

   if RadioGroup.ItemIndex<> -1

    then

     begin

      scriptAdd:= 'insert into ts.questions ('+

      'Subject,Section,Tema,Part,Question,'+

      'Answer_a,Answer_b,Answer_c,Answer_d ) values '+

      ' ('''+ComboBoxSubject.Text+''','''+ComboBoxSection.Text+

      ''','''+ComboBoxTema.Text+''','''+ComboBoxPart.Text+''','''+EditQuestion.Text+

      ''','''+a+''','''+b+''','''+c+''','''+d+''')';

      runSQLScript(scriptAdd,'Ts','');

      DataModuleTs.ClientDataSetQuestions.Refresh;

      FormQuestions.FormShow(Sender);

     end;

end;

end.

program TS;

uses

  Forms,

  SysUtils,

  TSUnitmain in 'TSUnitmain.pas' {TSmain},

  LogonUnit in 'LogonUnit.pas' {frmLogon},

  LogonMoreUnit in 'LogonMoreUnit.pas' {frmLogonMore},

  NewUserUnit in 'NewUserUnit.pas' {frmNewUser},

  UnitDataModule in 'UnitDataModule.pas' {DataModuleTs: TDataModule},

  QuestionsUnit in 'QuestionsUnit.pas' {FormQuestions},

  FormTestUnit in 'FormTestUnit.pas' {FormTest},

  QuestionUnit in 'QuestionUnit.pas' {FormQuestion};

var yes_ini:boolean;

{$R *.res}

begin

  //проверка существования файла ts.ini

  if  FileExists(ExtractFilePath(Application.ExeName)+'ts.ini')

    then  yes_ini := true   //да - существует

      else  yes_ini := False;

  //end if

  try

    if yes_ini

     then  //если мы обнаружили ts.ini

       begin

         frmLogon := TfrmLogon.Create(Application);

         frmLogon.Update;

         frmLogon.ShowModal;

       end

     else //если нет

       begin

         frmLogonMore := TfrmLogonMore.Create(Application);

         frmLogonMore.Update;

         frmLogonMore.ShowModal;

       end;

    if not logonError  //пользователь прошел проверку

      then

        begin

            Application.Initialize;

            Application.CreateForm(TTSmain, TSmain);

  Application.CreateForm(TfrmNewUser, frmNewUser);

  Application.CreateForm(TDataModuleTs, DataModuleTs);

  Application.CreateForm(TFormQuestions, FormQuestions);

  Application.CreateForm(TFormTest, FormTest);

  Application.CreateForm(TFormQuestion, FormQuestion);

  end

      else     //пользователь не прошел проверку

        begin

          if yes_ini

            then

             begin

               frmLogon.Hide;

               frmLogon.Free;

             end

            else

              begin

                frmLogonMore.Hide;

                frmLogonMore.Free;

              end;

          Halt(0);

        end;

     if yes_ini

       then frmLogon.Hide

         else frmLogonMore.Hide;

    finally

     if yes_ini

       then frmLogon.Free

         else frmLogonMore.Free;

   end;

  Application.Run;

end.

unit UnitDataModule;

interface

uses

  SysUtils, Classes, DBXpress, DB, Dialogs, SqlExpr, FMTBcd, DBClient, Provider;

type

  TDataModuleTs = class(TDataModule)

    mySQLConnectionScripts: TSQLConnection;

    SQLConnectionTs: TSQLConnection;

    mySQLTableUsers: TSQLTable;

    DataSetProviderUsers: TDataSetProvider;

    ClientDataSetUsers: TClientDataSet;

    DataSourceUsers: TDataSource;

    ClientDataSetUsersUsersId: TIntegerField;

    ClientDataSetUsersUserOrganization: TStringField;

    ClientDataSetUsersUserAtribute: TStringField;

    ClientDataSetUsersUserCourse: TStringField;

    ClientDataSetUsersUserGroup: TStringField;

    ClientDataSetUsersUserSubgroup: TStringField;

    ClientDataSetUsersUserName: TStringField;

    ClientDataSetUsersUserTolerance: TStringField;

    ClientDataSetUsersUserUpDate: TDateField;

    ClientDataSetUsersUserMaster: TStringField;

    mySQLQueryScripts: TSQLQuery;

    mySQLTableQuestions: TSQLTable;

    DataSetProviderQuestions: TDataSetProvider;

    ClientDataSetQuestions: TClientDataSet;

    DataSourceQuestions: TDataSource;

    mySQLQueryTest: TSQLQuery;

    DataSetProviderTest: TDataSetProvider;

    ClientDataSetTest: TClientDataSet;

    DataSourceTest: TDataSource;

  private

    { Private declarations }

  public

    { Public declarations }

  end;

  function DateToMySQL(dateStr: string):string;

  procedure runSQLScript(script,DataBase,err_message:string);

  procedure runSQLScriptQuery(script:string);

  procedure runSQLConnectionTs;

var

  DataModuleTs: TDataModuleTs;

implementation

uses TSUnitmain;

{$R *.dfm}

function DateToMySQL(dateStr: string):string;

  var d,m,y : string;

begin

   //переводим дату в формат MySql

   // 08.11.2004 -> 2004-11-08

   d:= copy(dateStr,0,2);

   m:= copy(dateStr,4,2);

   y:= copy(dateStr,7,4);

   Result :=y+'-'+m+'-'+d;

end;

procedure runSQLConnectionTs;

begin

        try

           DataModuleTs.SQLConnectionTs.Params.Values['HostName']:= UserHost;

           DataModuleTs.SQLConnectionTs.Params.Values['DataBase']:= 'ts';

           DataModuleTs.SQLConnectionTs.Params.Values['User_Name']:= UserName;

           DataModuleTs.SQLConnectionTs.Params.Values['Password']:= UserPassword;

           //пытаемся соединиться

           DataModuleTs.SQLConnectionTs.Connected:=true;

           DataModuleTs.mySQLTableUsers.Active:= true;

           DataModuleTs.ClientDataSetUsers.Active:= true;

           DataModuleTs.mySQLTableQuestions.Active:= true;

           DataModuleTs.ClientDataSetQuestions.Active:= true;

        except

           on EDataBaseError do MessageDlg('Ошибка подключения',mtWarning,[mbOk],0);

        end; {try}

end;

procedure runSQLScriptQuery(script:string);

begin

  if script<>''then

    begin

     DataModuleTs.mySQLQueryScripts.Active:= false;

     DataModuleTs.mySQLQueryScripts.Close;

     DataModuleTs.mySQLQueryScripts.SQL.Clear;

     DataModuleTs.mySQLQueryScripts.SQL.Add(script);

     DataModuleTs.mySQLQueryScripts.Open;

     if DataModuleTs.mySQLQueryScripts.RecordCount <> 0

       then UserAtribute:= DataModuleTs.mySQLQueryScripts.FieldByName('UserAtribute').AsString;

    end;

end;

procedure runSQLScript(script,DataBase,err_message:string);

begin

   DataModuleTs.mySQLConnectionScripts.Connected:= false;

   DataModuleTs.mySQLConnectionScripts.Params.Values['HostName']:= UserHost;

   DataModuleTs.mySQLConnectionScripts.Params.Values['DataBase']:= DataBase;

   DataModuleTs.mySQLConnectionScripts.Params.Values['User_Name']:= UserName;

   DataModuleTs.mySQLConnectionScripts.Params.Values['Password']:= UserPassword;

   DataModuleTs.mySQLConnectionScripts.Connected:= true;

   if script<>''then DataModuleTs.mySQLConnectionScripts.ExecuteDirect(script);

   DataModuleTs.mySQLConnectionScripts.Connected:= false;

end;

end.

unit LogonMoreUnit;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ComCtrls, DBXpress, DB, SqlExpr, inifiles;

type

  TfrmLogonMore = class(TForm)

    GroupBox: TGroupBox;

    RadioButton1: TRadioButton;

    RadioButton2: TRadioButton;

    EditHostLogonMore: TEdit;

    UserPasswordBox: TGroupBox;

    Label3: TLabel;

    Label5: TLabel;

    LabelUser: TLabel;

    LabelPassword: TLabel;

    EditUserLogonMore: TEdit;

    EditPasswordLogonMore: TEdit;

    StatusBar1: TStatusBar;

    ButtonOk: TButton;

    SQLConPassLogonMore: TSQLConnection;

    procedure ButtonOkClick(Sender: TObject);

    procedure FormShow(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  frmLogonMore: TfrmLogonMore;

implementation

uses TSUnitmain;

{$R *.dfm}

procedure TfrmLogonMore.ButtonOkClick(Sender: TObject);

var CurrentFolder_: string;

     IniFile: TIniFile;

     F: File;

begin

      logonError:=false;

         try

           SQLConPassLogonMore.Params.Values['HostName']:= EditHostLogonMore.Text;

           SQLConPassLogonMore.Params.Values['DataBase']:= 'ts';

           SQLConPassLogonMore.Params.Values['User_Name']:= EditUserLogonMore.text;

           SQLConPassLogonMore.Params.Values['Password']:= EditPasswordLogonMore.text;

           //запоминаем значения

           UserHost:= EditHostLogonMore.Text;

           UserName:= EditUserLogonMore.Text;

           UserPassword:= EditPasswordLogonMore.Text;

           //пытаемся соединиться

           SQLConPassLogonMore.Connected:=true;

         except

           on EDataBaseError do

             begin

               MessageDlg('Ошибка подключения;'+#13+' повторите ввод',mtWarning,[mbOk],0);

               logonError:=True;

             end;

         end;  {try}

         SQLConPassLogonMore.Connected:=false;

//если пользователь законнектился-> сохраняем эти данные  в sapphire.ini

      if (not logonError)

        then

          begin

            CurrentFolder_ := ExtractFilePath(Application.ExeName);

            //если файл не существует - создаем его

            if  (not FileExists(CurrentFolder_ + 'ts.ini'))

              then

                begin

                  AssignFile(F,CurrentFolder_+'ts.ini');

                  Rewrite(F);

                  CloseFile(F);

                end;

            IniFile:= TIniFile.Create(CurrentFolder_+'ts.ini');

            IniFile.WriteString('main','host',UserHost);

            IniFile.WriteString('main','user',UserName);

            IniFile.Free;

        end;  {if (not logonError)}

        if (not logonError) then frmLogonMore.Close;

end;     

procedure TfrmLogonMore.FormShow(Sender: TObject);

begin

  logonError:=True;

end;

end.

unit NewUserUnit;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ComCtrls;

type

  TfrmNewUser = class(TForm)

    LabelUserOrganization: TLabel;

    LabelUserAtribute: TLabel;

    LabelUserCourse: TLabel;

    LabelUserGroup: TLabel;

    LabelUserSubgroup: TLabel;

    LabelUserName: TLabel;

    CheckBoxUserTolerance: TCheckBox;

    StatusBar1: TStatusBar;

    ButtonOk: TButton;

    GroupBox: TGroupBox;

    ComboBoxUserAtribute: TComboBox;

    EditUserPassword: TEdit;

    LabelUserPassword: TLabel;

    ComboBoxUserOrganization: TComboBox;

    ComboBoxUserCourse: TComboBox;

    ComboBoxUserGroup: TComboBox;

    EditUserName: TEdit;

    ComboBoxUserSubgroup: TComboBox;

    procedure ButtonOkClick(Sender: TObject);