Разработка системы компьютерного контроля знаний по дисциплинам кафедры

if N>=0 then ListBox1.Items.Delete(N);//Disconnect

end;

end;

procedure TForm1.WMChangeCaption(var Message: TMessage);

begin

Caption:='Подключено '+IntToStr(Message.WParam)+' клиентов';

TrayNotifyIcon1.Hint:='Подключено '

+IntToStr(Message.WParam)+' клиентов';

end;

procedure TForm1.WMHideTask(var Message:TMessage);

begin

Form1.Hide;

end;

Procedure TForm1.ReadIni(var Path,Name:String;var Loc:Boolean);

var Ini:TiniFile;

begin

try

ini:=TiniFile.Create(ChangeFileExt( Application.ExeName, '.INI'));

Loc:=Ini.ReadBool('TYPEBASA','NAMES',false);

if not Loc then

begin

Path:=Ini.ReadString('DATABASE1', 'PATH','D:\database\');

Name:=Ini.ReadString('DATABASE1', 'NAME','Examination.mdb');

end else

begin

Path:=Ini.ReadString('DATABASE2', 'PATH','MSSQL');

Name:=Ini.ReadString('DATABASE2', 'NAME','EXAMINATION');

end;

finally

Ini.Free

end;

end;

Procedure TForm1.WriteIni(Path,Name:String;Loc:Boolean);

var Ini:TiniFile;

begin

try

ini:=TiniFile.Create(ChangeFileExt( Application.ExeName, '.INI'));

Ini.WriteBool('TYPEBASA','NAMES',Loc);

if not Loc then

begin

Ini.WriteString('DATABASE1', 'PATH',Path);

Ini.WriteString('DATABASE1', 'NAME',Name);

end else

begin

Ini.WriteString('DATABASE2', 'PATH',Path);

Ini.WriteString('DATABASE2', 'NAME',Name);

end;

finally

Ini.Free

end;

end;

procedure TForm1.PathNastr;

var //Ini:TiniFile;

P,N:String;

L:Boolean;

begin

if not FileExists(ChangeFileExt( Application.ExeName, '.INI')) then

begin

WriteIni('D:\database\','Examination.mdb',False);

end else

begin

ReadIni(P,N,L);

if not L then RdMod.ConnStr:=Format(Conn1,[(P+N)])

else RdMod.ConnStr:=Format(Conn2,[N,P])

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

PathNastr;

LogFileName:=ChangeFileExt(Application.ExeName,'.Log');

AssignFile(F,LogFileName);

if not FileExists(LogFileName) then Rewrite(F)

else Append(F);

PostMessage(Form1.Handle,WM_HIDETASK,0,0);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

CloseFile(F);

end;

procedure TForm1.TrayNotifyIcon1DblClick(Sender: TObject);

begin

if Form1.Visible then Form1.Hide else Form1.Show

end;

procedure TForm1.AboutClick(Sender: TObject);

begin

MessageDLG('Дипломный проект. Выполнил Ананьев В.А.',

mtInformation,[mbOK],0);

end;

procedure TForm1.Exit_prgClick(Sender: TObject);

begin

Close

end;

procedure TForm1.NasrtClick(Sender: TObject);

begin

Form2:=TForm2.Create(Self);

Form2.ShowModal;

Form2.Free;

end;

procedure TForm1.FormShow(Sender: TObject);

begin

if LowerCase(ParamStr(1))='instal' then application.Terminate;

end;

end.

Библиотека типов Myserver_TLB. Автоматически генерируется средой Delphi.

unit Myserver_TLB;

// PASTLWTR : 1.2

// File generated on 24.06.2006 13:20:59 from Type Library described below.

// ************************************************************************ //

// Type Lib: D:\Borland\Projects\диплом\Server\Myserver.tlb (1)

// LIBID: {58D5340E-B6C4-4B88-8551-5EAED04F014F}

// LCID: 0

// Helpfile:

// HelpString: Myserver Library

// DepndLst:

// (1) v1.0 Midas, (C:\WINDOWS\system32\midas.dll)

// (2) v2.0 stdole, (C:\WINDOWS\system32\stdole2.tlb)

// ************************************************************************ //

{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.

{$WARN SYMBOL_PLATFORM OFF}

{$WRITEABLECONST ON}

{$VARPROPSETTER ON}

interface

uses Windows, ActiveX, Classes, Graphics, Midas, StdVCL, Variants;

// *********************************************************************//

// GUIDS declared in the TypeLibrary. Following prefixes are used:

// Type Libraries : LIBID_xxxx

// CoClasses : CLASS_xxxx

// DISPInterfaces : DIID_xxxx

// Non-DISP interfaces: IID_xxxx

// *********************************************************************//

const

// TypeLibrary Major and minor versions

MyserverMajorVersion = 1;

MyserverMinorVersion = 0;

LIBID_Myserver: TGUID = '{58D5340E-B6C4-4B88-8551-5EAED04F014F}';

IID_IMyServ: TGUID = '{CD5804FE-5C4B-460A-A631-233784FF6B2C}';

CLASS_MyServ: TGUID = '{1C09DBC2-80E1-4565-9197-FE467ABA1928}';

type

// *********************************************************************//

// Forward declaration of types defined in TypeLibrary

// *********************************************************************//

IMyServ = interface;

IMyServDisp = dispinterface;

// *********************************************************************//

// Declaration of CoClasses defined in Type Library

// (NOTE: Here we map each CoClass to its Default Interface)

// *********************************************************************//

MyServ = IMyServ;

// *********************************************************************//

// Interface: IMyServ

// Flags: (4416) Dual OleAutomation Dispatchable

// GUID: {CD5804FE-5C4B-460A-A631-233784FF6B2C}

// *********************************************************************//

IMyServ = interface(IAppServer)

['{CD5804FE-5C4B-460A-A631-233784FF6B2C}']

function Login(const UserName: WideString; const Password: WideString): WordBool; safecall;

procedure IPAdress(const Adress: WideString; const LocalAdress: WideString;

const LocalName: WideString); safecall;

procedure Otvet(Predmet: Integer; Tema: Integer; Vopros: Integer; const VarOtv: WideString); safecall;

procedure Ocenka(Predmet: Integer; Tema: Integer; Count: Integer; Verno: Integer;

NeVerno: Integer; var Estimation: Integer); safecall;

end;

// *********************************************************************//

// DispIntf: IMyServDisp

// Flags: (4416) Dual OleAutomation Dispatchable

// GUID: {CD5804FE-5C4B-460A-A631-233784FF6B2C}

// *********************************************************************//

IMyServDisp = dispinterface

['{CD5804FE-5C4B-460A-A631-233784FF6B2C}']

function Login(const UserName: WideString; const Password: WideString): WordBool; dispid 301;

procedure IPAdress(const Adress: WideString; const LocalAdress: WideString;

const LocalName: WideString); dispid 302;

procedure Otvet(Predmet: Integer; Tema: Integer; Vopros: Integer; const VarOtv: WideString); dispid 303;

procedure Ocenka(Predmet: Integer; Tema: Integer; Count: Integer; Verno: Integer;

NeVerno: Integer; var Estimation: Integer); dispid 304;

function AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer;

out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; dispid 20000000;

function AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer;

Options: Integer; const CommandText: WideString; var Params: OleVariant;

var OwnerData: OleVariant): OleVariant; dispid 20000001;

function AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; dispid 20000002;

function AS_GetProviderNames: OleVariant; dispid 20000003;

function AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; dispid 20000004;

function AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer;

var OwnerData: OleVariant): OleVariant; dispid 20000005;

procedure AS_Execute(const ProviderName: WideString; const CommandText: WideString;

var Params: OleVariant; var OwnerData: OleVariant); dispid 20000006;

end;

// *********************************************************************//

// The Class CoMyServ provides a Create and CreateRemote method to

// create instances of the default interface IMyServ exposed by

// the CoClass MyServ. The functions are intended to be used by

// clients wishing to automate the CoClass objects exposed by the

// server of this typelibrary.

// *********************************************************************//

CoMyServ = class

class function Create: IMyServ;

class function CreateRemote(const MachineName: string): IMyServ;

end;

implementation

uses ComObj;

class function CoMyServ.Create: IMyServ;

begin

Result := CreateComObject(CLASS_MyServ) as IMyServ;

end;

class function CoMyServ.CreateRemote(const MachineName: string): IMyServ;

begin

Result := CreateRemoteComObject(MachineName, CLASS_MyServ) as IMyServ;

end;

end.

Удаленный модуль данных RdMod (Remote Data Module).

unit RdMod;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,

DBClient, Myserver_TLB, StdVcl, Provider, DB, ADODB,Forms;

type

TMyServ = class(TRemoteDataModule, IMyServ)

ADOConnection1: TADOConnection;

ADOConnection2: TADOConnection;

DataSetProviderUser: TDataSetProvider;

DataSetProviderPredmet: TDataSetProvider;

DataSetProviderTema: TDataSetProvider;

DataSetProviderVopros: TDataSetProvider;

DataSetProviderVariant: TDataSetProvider;

DataSetProviderCommand: TDataSetProvider;

DataSetProviderStudents: TDataSetProvider;

DataSetProviderLectors: TDataSetProvider;

DataSource1: TDataSource;

DataSource2: TDataSource;

DataSource3: TDataSource;

DataSource4: TDataSource;

UserTable: TADOTable;

UserTable1: TADOTable;

PredmetTable: TADOTable;

TemaTable: TADOTable;

VoprosTable: TADOTable;

VariantTable: TADOTable;

ADOQuery1: TADOQuery;

StudentsTable: TADOTable;

LectorsTable: TADOTable;

ADOQuery2: TADOQuery;

OcenkiTable: TADOTable;

DataSetProviderOcenki: TDataSetProvider;

procedure RemoteDataModuleCreate(Sender: TObject);

private

FAddress:String;

FLocalAddress:String;

FLocalName:String;

FFullAdress:String;

FVerno:integer;

FNeverno:integer;

FUserName:String;

FUserID:LongInt;

{ Private declarations }

protected

class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;

function Login(const UserName, Password: WideString): WordBool; safecall;

procedure IPAdress(const Adress, LocalAdress, LocalName: WideString); safecall;

procedure Otvet(Predmet, Tema, Vopros: Integer; const VarOtv: WideString);safecall;

procedure Ocenka(Predmet, Tema, Count, Verno, NeVerno: Integer;var Estimation: Integer); safecall;

public

property Address:String read FAddress;

procedure AfterConstruction; override;

destructor Destroy; override;

{ Public declarations }

end;

Const

Conn1='Provider=Microsoft.Jet.OLEDB.4.0;DataSource=%S;Mode=ReadWrite;Persist Security Info=False';

Conn2='Provider=SQLOLEDB.1;Persist Security Info=False;Initial Catalog=%S;Data Source=%S';

var F:TextFile;

LogFileName:String;

ClientCount:integer=0;

ClientList:TThreadList=Nil;

ConnStr:String;

implementation

uses Serv;

{$R *.DFM}

class procedure TMyServ.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);

begin

if Register then

begin

inherited UpdateRegistry(Register, ClassID, ProgID);

EnableSocketTransport(ClassID);

EnableWebTransport(ClassID);

end else

begin

DisableSocketTransport(ClassID);

DisableWebTransport(ClassID);

inherited UpdateRegistry(Register, ClassID, ProgID);

end;

end;

function TMyServ.Login(const UserName, Password: WideString): WordBool;

var Name,Pass:String;

procedure NoAccess;

begin

Writeln(f,DateToStr(Now)+' '+TimeToStr(Now)+' Попытка несанкционированного доступа');

ADOConnection2.Connected:=false;

end;

procedure Access;

begin

Writeln(f,DateToStr(Now)+' '+TimeToStr(Now)+ ' Подключился '+Name);

end;

begin

Name:=UserName;

Pass:=Password;

ADOConnection2.Connected:=True;

UserTable.Open;

if UserTable.Locate('LOGIN',Name,[]) then

begin

if Pass=UserTable.FieldValues['PASS'] then

begin

Access;

FUserName:=Name;

FUserID:=UserTable.FieldValues['USER_ID'];

result:=true

end

else begin

NoAccess;

result:=false

end;

end else

begin

NoAccess;

result:=false;

end;

UserTable.close;

end;

procedure TMyServ.AfterConstruction;

begin

inherited;

Inc(ClientCount);

PostMessage(Form1.Handle,WM_CHANGECAPTION,ClientCount,0);

end;

destructor TMyServ.Destroy;

var

N:integer;

P:pointer;

begin

N:=length(FFullAdress);

GetMem(P,N+1);

FillMemory(P,N+1,0);

Move(FFullAdress[1],P^,N);

Dec(ClientCount);

PostMessage(Form1.Handle,WM_CHANGECAPTION,ClientCount,0);

PostMessage(Form1.Handle,WM_USERIPADRES,integer(P),1);

inherited;

end;

procedure TMyServ.IPAdress(const Adress, LocalAdress,

LocalName: WideString);

var

N:integer;

P:pointer;

begin

FAddress:=Adress;

FLocalAddress:=LocalAdress;

FLocalName:=LocalName;

FFullAdress:=FAddress+' '+FLocalAddress+' '+FLocalName;

N:=length(FFullAdress);

GetMem(P,N+1);

FillMemory(P,N+1,0);

Move(FFullAdress[1],P^,N);

PostMessage(Form1.Handle,WM_USERIPADRES,integer(P),0);

end;

procedure TMyServ.RemoteDataModuleCreate(Sender: TObject);

begin

ADOConnection1.ConnectionString:=ConnStr;

ADOConnection2.ConnectionString:=ConnStr;

end;

procedure TMyServ.Otvet(Predmet, Tema, Vopros: Integer;

const VarOtv: WideString);

begin

end;

procedure TMyServ.Ocenka(Predmet, Tema, Count, Verno, NeVerno: Integer;

var Estimation: Integer);

function Procent(Col,Ver:Integer):Integer;

begin

result:=Round(100*Ver/Col);

end;

begin

case Procent(Count,Verno) of

0..49 : Estimation:=2;

50..79 : Estimation:=3;

80..89 : Estimation:=4;

90..100 : Estimation:=5;

end;

OcenkiTable.Open;

OcenkiTable.Append;

OcenkiTable.FieldValues['USER_ID']:=FUserID;

OcenkiTable.FieldValues['PREDMET_ID']:=Predmet;

OcenkiTable.FieldValues['TEMA_ID']:=Tema;

OcenkiTable.FieldValues['OCENKA']:=Estimation;

OcenkiTable.FieldValues['DATA']:=now;

OcenkiTable.Post;

OcenkiTable.Close;

end;

initialization

TComponentFactory.Create(ComServer, TMyServ,

Class_MyServ, ciMultiInstance, tmApartment);

ClientList:=TThreadList.Create;

finalization

Clientlist.Free;

end.

Модуль настроек серверной части Nastr_Path.

unit Nastr_Path;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TForm2 = class(TForm)

RadioGroup1: TRadioGroup;

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Edit1: TEdit;

Edit2: TEdit;

GroupBox2: TGroupBox;

Button1: TButton;

Button2: TButton;

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure RadioGroup1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

uses Serv;

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);

var Path,Name:String;

L:Boolean;

begin

Form1.Readini(Path,Name,L);

Edit1.Text:=Path;

Edit2.Text:=Name;

if L then RadioGroup1.ItemIndex:=1

else RadioGroup1.ItemIndex:=0;

end;

procedure TForm2.Button2Click(Sender: TObject);

begin

Close;

end;

procedure TForm2.Button1Click(Sender: TObject);

begin

Form1.WriteIni(Edit1.Text,Edit2.Text,Boolean(RadioGroup1.ItemIndex));

Form1.PathNastr;

Close;

end;

procedure TForm2.RadioGroup1Click(Sender: TObject);

begin

Case Radiogroup1.ItemIndex of

0:begin

Label1.Caption:='Путь к данным';

Label2.Caption:='Имя файла данных';

end;

1:begin

Label1.Caption:='Имя сервера';

Label2.Caption:='Имя базы данных';

end;

end;

end;

end.

Модуль TrayNotifyIcon, реализует компонент TTrayNotifyIcon. Предназначен для сворачивания окна сервера в иконку на панели задач.

unit TrayNotifyIcon;

interface

uses

Windows, SysUtils, Messages, ShellAPI, Classes,

Graphics, Forms, Menus, ExtCtrls;

type

ENotifyIconError=class(Exception);

TTrayNotifyIcon = class(TComponent)

private

FDefaultIcon:THAndle;

FIcon:TIcon;

FHideTask:Boolean;

FHint:String;

FIconVisible:Boolean;

FPopupMenu:TPopupMenu;

FOnClick:TNotifyEvent;

FOnDblClick:TNotifyEvent;

FNoShowClick:Boolean;

FTimer:TTimer;

Tnd:TNotifyIconData;

procedure SetIcon(Value:TIcon);

procedure SetHideTask(Value:Boolean);

procedure SetHint(Value:String);

procedure SetIconVisible(Value:Boolean);

procedure SetPopupMenu(Value:TPopupMenu);

procedure SendTrayMessage(Msg:DWORD;Flags:UINT);

function ActiveIconHandle:THandle;

procedure OnButtonTimer(Sender:TObject);

protected

procedure Loaded;override;

procedure LoadDefaultIcon;virtual;

procedure Notification(AComponent:TComponent;

Operation:TOperation);override;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

published

property Icon:TIcon read FIcon write SetIcon;

property HideTask:Boolean read FHideTask write SetHideTask

default false;

property Hint:String read FHint write SetHint;

property IconVisible:Boolean read FIconVisible write SetIconVisible

default false;

property PopupMenu:TPopupMenu read FPopupMenu write SetPopupMenu;

property OnClick:TNotifyEvent read FOnClick write FOnClick;

property OnDblClick:TNotifyEvent read FOnDblClick write FOnDblClick;

end;

procedure Register;

implementation

type

TIconManager = class

private

FHWindow:HWnd;

procedure TrayWndProc(var Message:TMessage);

public

constructor Create;

destructor Destroy;override;

property HWindow:HWnd read FHWindow write FHWindow;

end;

var

IconMgr:TIconManager;

MY_TRAYICON:Integer;

constructor TIconManager.Create;

begin

FHWindow:=AllocateHWnd(TrayWndProc);

end;

destructor TIconManager.Destroy;

begin

if FHWindow<>0 then DeallocateHWnd(FHWindow);

inherited Destroy;

end;

procedure TIconManager.TrayWndProc(var Message:TMessage);

var

Pt:TPoint;

TheIcon:TTrayNotifyIcon;

begin

with Message do

begin

if (Msg=MY_TRAYICON) then

begin

TheIcon:=TTrayNotifyIcon(wParam);

case lParam of

WM_LBUTTONDOWN : TheIcon.FTimer.Enabled:=True;

WM_LBUTTONDBLCLK :

begin

TheIcon.FNoShowClick:=True;

if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);

end;

WM_RBUTTONDOWN :

begin

if Assigned(TheIcon.FPopupMenu) then

begin

SetForegroundWindow(IconMgr.HWindow);

GetCursorPos(Pt);

TheIcon.FPopupMenu.Popup(Pt.X,Pt.Y);

PostMessage(IconMgr.HWindow,WM_USER,0,0);

end;

end;

end;//case

end

else result:=DefWindowProc(FHWindow,Msg,wParam,lParam);

end;

end;

constructor TTrayNotifyIcon.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

FIcon:=TIcon.Create;

FTimer:=TTimer.Create(Self);

with FTimer do

begin

Enabled:=False;

Interval:=GetDoubleClickTime;

OnTimer:=OnButtonTimer;

end;

LoadDefaultIcon;

end;

destructor TTrayNotifyIcon.Destroy;

begin

if FIconVisible then SetIconVisible(False);

FIcon.Free;

FTimer.Free;

inherited Destroy;

end;

function TTrayNotifyIcon.ActiveIconHandle:THandle;

begin

if FIcon.Handle<>0 then result:=FIcon.Handle

else result:=FDefaultIcon;

end;

procedure TTrayNotifyIcon.LoadDefaultIcon;

begin

FDefaultIcon:=LoadIcon(0,IDI_WINLOGO);

end;

procedure TTrayNotifyIcon.Loaded;

begin

inherited Loaded;

if FIconVisible then

SendTrayMessage(NIM_ADD,NIF_MESSAGE or NIF_ICON or NIF_TIP);

end;

procedure TTrayNotifyIcon.Notification(AComponent:TComponent;

Operation:TOperation);

begin

inherited Notification(AComponent,Operation);

if (Operation=opRemove) and (AComponent=PopupMenu) then

PopupMenu:=nil;

end;

procedure TTrayNotifyIcon.OnButtonTimer(Sender:TObject);

begin

FTimer.Enabled:=false;

if (not FNoShowClick) and Assigned(FOnClick) then FOnClick(Self);

FNoShowClick:=False;

end;

procedure TTrayNotifyIcon.SendTrayMessage(Msg:DWORD;Flags:UINT);

begin

with Tnd do

begin

cbSize:=SizeOf(Tnd);

StrPLCopy(szTip,PChar(FHint),SizeOf(szTip));

uFlags:=Flags;

uID:=UINT(Self);

Wnd:=IconMgr.HWindow;

uCallbackMessage:=MY_TRAYICON;

hIcon:=ActiveIconHandle;

end;

Shell_NotifyIcon(Msg,@Tnd);

end;

procedure TTrayNotifyIcon.SetHideTask(Value:Boolean);

const

ShowArray:array[Boolean] of integer = (sw_ShowNormal,sw_Hide);

begin

if FHideTask<>Value then

begin

FHideTask:=Value;

if not (csDesigning in ComponentState) then

ShowWindow(Application.Handle,ShowArray[FHideTask]);

end;

end;

procedure TTrayNotifyIcon.SetHint(Value:String);

begin

if FHint<>Value then

begin

FHint:=Value;

if FIconVisible then SendTrayMessage(NIM_MODIFY,NIF_TIP);

end;

end;

procedure TTrayNotifyIcon.SetIcon(Value:TIcon);

begin

FIcon.Assign(Value);

if FIconVisible then SendTrayMessage(NIM_MODIFY,NIF_ICON);

end;

procedure TTrayNotifyIcon.SetIconVisible(Value:Boolean);

const

MsgArray: array[Boolean] of DWORD = (NIM_DELETE,NIM_ADD);

begin

if FIconVisible<>Value then

begin

FIconVisible:=Value;

if not (csDesigning in ComponentState) then

SendTrayMessage(MsgArray[Value],NIF_MESSAGE or NIF_ICON or NIF_TIP);

end;

end;

procedure TTrayNotifyIcon.SetPopupMenu(Value:TPopupMenu);

begin

FPopupMenu:=Value;

if Value<>nil then Value.FreeNotification(Self);

end;

const

TrayMsgStr='MY.TrayNotifyIconMsg';

procedure Register;

begin

RegisterComponents('Samples', [TTrayNotifyIcon]);

end;

initialization

MY_TRAYICON:=RegisterWindowMessage(TrayMsgStr);

IconMgr:=TIconManager.Create;

finalization

IconMgr.Free;

end.

Исходный код административной части программного комплекса.

program Project1;

uses

Forms,

Unit1 in 'Unit1.pas' {Form1},

Nastr_Connect in 'Nastr_Connect.pas' {Form2},

UserLogin in 'UserLogin.pas' {Form3},

UserList in 'UserList.pas' {UserListFrm},

Add_Edit_User in 'Add_Edit_User.pas' {AddEditUserFrm},

Find_Komp in 'Find_Komp.pas' {FindKompFrm},

AddNewPredmet in 'AddNewPredmet.pas' {AddPredmetFrm},

AddNewVopros in 'AddNewVopros.pas' {VoprosOtvetListFrm},

AddStudents in 'AddStudents.pas' {AddStudentsFrm},

AddLectors in 'AddLectors.pas' {AddLectorsFrm},

StudentList in 'StudentList.pas' {StudentsListFrm},

FrmAbout in 'FrmAbout.pas' {AboutFrm},

DldVoprosAdd in 'DldVoprosAdd.pas' {DlgFrmAddVopros},

DlgPredmet in 'DlgPredmet.pas' {PredmetAdd},

NewVopros in 'NewVopros.pas' {NewVoprosFrm},

LectorList in 'LectorList.pas' {FrmLectorList};

{$R *.res}

begin

Application.Initialize;

Application.Title := 'Администрирование';

Application.CreateForm(TForm1, Form1);

Application.Run;

end.

Главный модуль приложения.

unit Unit1;

interface

uses

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

Dialogs, StdCtrls,DB, DBClient, MConnect, Menus, XPMan,

ComCtrls, ToolWin, ExtCtrls, Sockets, SConnect, jpeg, ImgList, RzBHints,

RzPanel, RzStatus, RzGroupBar;

//Grids, DBGrids,

type

TForm1 = class(TForm)

MainMenu1 : TMainMenu;

Administ : TMenuItem;

test_vopros : TMenuItem;

App_Edit_User : TMenuItem;

Con_ct_Server : TMenuItem;

Podkluch : TMenuItem;

Nastr : TMenuItem;

MListStudents : TMenuItem;

MPredmet : TMenuItem;

MVopros : TMenuItem;

Exit_Prog : TMenuItem;

MListLectors : TMenuItem;

ToolBttnAddUser : TToolButton;

ToolBttnStudents : TToolButton;

ToolBttnLectors : TToolButton;

ToolButton4 : TToolButton;

ToolBttnPredmet : TToolButton;

ToolBttnVopros : TToolButton;

ClientDataSetUser : TClientDataSet;

ClientDataSetPredmet : TClientDataSet;

ClientDataSetTema : TClientDataSet;

ClientDataSetVopros : TClientDataSet;

ClientDataSetVariant : TClientDataSet;

ClientDataSetQuery : TClientDataSet;

ClientDataSetStudents : TClientDataSet;

ClientDataSetLectors : TClientDataSet;

ClientDataSetOcenki : TClientDataSet;

TcpServer1 : TTcpServer;

DCOMConnection1 : TDCOMConnection;

SocketConnection1 : TSocketConnection;

ConnectionBroker1 : TConnectionBroker;

PredmetSource : TDataSource;

TemaSource : TDataSource;

VoprosSource : TDataSource;

VariantSource : TDataSource;

StudentsSource : TDataSource;

LectorsSource : TDataSource;

OcenkiSource : TDataSource;

ToolBar1 : TToolBar;

ImageList1 : TImageList;

RzBalloonHints1 : TRzBalloonHints;

RzStatusBar1 : TRzStatusBar;

RzClockStatus1 : TRzClockStatus;

RzKeyStatus1 : TRzKeyStatus;

RzKeyStatus2 : TRzKeyStatus;

RzGlyphStatus1 : TRzGlyphStatus;

RzMarqueeStatus1 : TRzMarqueeStatus;

Timer1 : TTimer;

ToolButton1 : TToolButton;

MAbout : TMenuItem;

RzGroupBar1 : TRzGroupBar;

RzGroup1 : TRzGroup;

Bevel1 : TBevel;

RzGroup2 : TRzGroup;

RzGroup3 : TRzGroup;

Image1 : TImage;

procedure NastrClick(Sender: TObject);

procedure PodkluchClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormCreate(Sender: TObject);

procedure App_Edit_UserClick(Sender: TObject);

procedure Exit_ProgClick(Sender: TObject);

procedure MPredmetClick(Sender: TObject);

procedure MVoprosClick(Sender: TObject);

procedure MListStudentsClick(Sender: TObject);

procedure MListLectorsClick(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure ClientDataSetPredmetBeforeDelete(DataSet: TDataSet);

procedure ClientDataSetTemaBeforeDelete(DataSet: TDataSet);

procedure ClientDataSetTemaBeforeRefresh(DataSet: TDataSet);

procedure ClientDataSetPredmetBeforeRefresh(DataSet: TDataSet);

procedure MAboutClick(Sender: TObject);

procedure ClientDataSetVoprosBeforeRefresh(DataSet: TDataSet);

procedure ClientDataSetVoprosAfterPost(DataSet: TDataSet);

procedure ClientDataSetVariantAfterPost(DataSet: TDataSet);

procedure ClientDataSetPredmetBeforeInsert(DataSet: TDataSet);

procedure ClientDataSetTemaBeforeInsert(DataSet: TDataSet);

procedure ClientDataSetVoprosAfterInsert(DataSet: TDataSet);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Nastr_Connect, UserLogin,IniFiles,ComObj, UserList,

AddNewPredmet, AddNewVopros, AddStudents, StudentList, FrmAbout,

DldVoprosAdd, DlgPredmet, LectorList;

{$R *.dfm}

procedure TForm1.NastrClick(Sender: TObject);

begin

if ConnectionBroker1.Connected then ConnectionBroker1.Connected:=False;

Form2:=TForm2.Create(Self);

Form2.ShowModal;

Form2.Free;

//настройка соеденения

end;

procedure TForm1.PodkluchClick(Sender: TObject);

var S1,S2,S3:string;

procedure MenuEnable;

begin

Administ.Enabled:=not Administ.Enabled;

test_vopros.Enabled:=not test_vopros.Enabled;

Nastr.Enabled:=not Nastr.Enabled;

// Desk.Enabled:=not Desk.Enabled;

ToolBttnAddUser.Enabled:=not ToolBttnAddUser.Enabled;

ToolBttnStudents.Enabled:=not ToolBttnStudents.Enabled;

ToolBttnLectors.Enabled:=not ToolBttnLectors.Enabled;

ToolBttnPredmet.Enabled:=not ToolBttnPredmet.Enabled;

ToolBttnVopros.Enabled:=not ToolBttnVopros.Enabled;

RzGroup1.Items.Items[0].Enabled:= not RzGroup1.Items.Items[0].Enabled;

RzGroup1.Items.Items[1].Enabled:= not RzGroup1.Items.Items[1].Enabled;

RzGroup1.Items.Items[2].Enabled:= not RzGroup1.Items.Items[2].Enabled;

RzGroup2.Items.Items[0].Enabled:= not RzGroup2.Items.Items[0].Enabled;

RzGroup2.Items.Items[1].Enabled:= not RzGroup2.Items.Items[1].Enabled;

RzGroup3.Items.Items[1].Enabled:= not RzGroup3.Items.Items[1].Enabled;

end;

begin

//подключение\отключение к серверу

if ConnectionBroker1.Connected then

begin

ConnectionBroker1.Connected:=False;

Podkluch.Caption:='Подключение';

Podkluch.ImageIndex:=0;

RzGroup3.Items.Items[0].Caption:='Подключение';

RzGroup3.Items.Items[0].ImageIndex:=0;

RzGlyphStatus1.ImageIndex:=15;

Timer1.Enabled:=False;

RzMarqueeStatus1.Caption:='Отключен от сервера';

MenuEnable;

TcpServer1.Close;

end else

begin

Form3:=TForm3.Create(Self);

Form3.ShowModal;

if Form3.ModalResult=mrOK then

begin

try

ConnectionBroker1.Connected:=True;

except

on E:Exception do

begin

MessageDLG(Format('Ошибка подключения к серверу: %S',[E.Message]),

mtError,[mbOK],0);

exit;

end;

end;//except

if ConnectionBroker1.AppServer.Login(Form3.Edit1.Text,Form3.Edit2.Text) then

begin

Podkluch.Caption:='Отключение';

Podkluch.ImageIndex:=6;

RzGroup3.Items.Items[0].Caption:='Отключение';

RzGroup3.Items.Items[0].ImageIndex:=6;

RzGlyphStatus1.ImageIndex:=13;

Timer1.Enabled:=True;

RzMarqueeStatus1.Caption:='Подключен к серверу';

MenuEnable;

TcpServer1.Open;

S1:=TcpServer1.LookupHostAddr(TcpServer1.LookupHostName(''));

S2:=TcpServer1.LocalHostAddr;

S3:=TcpServer1.LocalHostName;

ConnectionBroker1.AppServer.IPAdress(S1,S2,S3);

end else

begin

ConnectionBroker1.Connected:=False;

ShowMessage('Имя пользователя или пароль не опознаны сервером');

end;

end;

form3.Free

end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

if ClientDataSetUser.Active then ClientDataSetUser.Close;

if TcpServer1.Active then TcpServer1.Close;

if ConnectionBroker1.Connected then ConnectionBroker1.Connected:=False;

ConnectionBroker1.Connection:=nil;

Action:=caFree;

end;

procedure TForm1.FormCreate(Sender: TObject);

var Ini:TiniFile;

PC:String;

procedure InitToolBar;

begin

ToolBttnAddUser.OnClick:=App_Edit_User.OnClick;

ToolBttnStudents.OnClick:=MListStudents.OnClick;

ToolBttnLectors.OnClick:=MListLectors.OnClick;

ToolBttnPredmet.OnClick:=MPredmet.OnClick;

ToolBttnVopros.OnClick:=MVopros.OnClick;

end;

begin

InitToolBar;

if not FileExists(ChangeFileExt( Application.ExeName, '.INI')) then

begin

try

ini:=TiniFile.Create(ChangeFileExt( Application.ExeName, '.INI'));

Ini.WriteString('CONNECT', 'PCName','PC');

Ini.WriteBool('CONNECT', 'TYPE',false);

ShowMessage('Не найден файл настроек. Необходимо заново настроить поключение');

finally

Ini.Free

end;

end else

begin

try

ini:=TiniFile.Create(ChangeFileExt( Application.ExeName, '.INI'));

PC:=Ini.ReadString('CONNECT', 'PCName','PC');

DCOMConnection1.ComputerName:=PC;

SocketConnection1.Host:=PC;

if Ini.ReadBool('CONNECT','TYPE',false)

then ConnectionBroker1.Connection:=SocketConnection1

else ConnectionBroker1.Connection:=DCOMConnection1;

finally

Ini.Free

end;

end;

end;

procedure TForm1.App_Edit_UserClick(Sender: TObject);

begin

UserListFrm:=TUserListFrm.Create(Self);

UserListFrm.ShowModal;

UserListFrm.Free

end;

procedure TForm1.Exit_ProgClick(Sender: TObject);

begin

Close

end;

procedure TForm1.MPredmetClick(Sender: TObject);

begin

ClientDataSetPredmet.Open;

ClientDataSetTema.Open;

AddPredmetFrm:=TAddPredmetFrm.Create(Self);

AddPredmetFrm.ShowModal;

AddPredmetFrm.Free;

ClientDataSetPredmet.Close;

ClientDataSetTema.Close;

end;

procedure TForm1.MVoprosClick(Sender: TObject);

begin

ClientDataSetPredmet.Open;

ClientDataSetTema.Open;

ClientDataSetVopros.Open;

ClientDataSetVariant.Open;

VoprosOtvetListFrm:=TVoprosOtvetListFrm.Create(Self);

VoprosOtvetListFrm.ShowModal;

VoprosOtvetListFrm.Free;

ClientDataSetPredmet.Close;

ClientDataSetTema.Close;

ClientDataSetVopros.Close;

ClientDataSetVariant.Close;

end;

procedure TForm1.MListStudentsClick(Sender: TObject);

begin

ClientDataSetStudents.Open;

StudentsListFrm:=TStudentsListFrm.Create(Self);

StudentsListFrm.ShowModal;

StudentsListFrm.Free;

ClientDataSetStudents.Close;

end;

procedure TForm1.MListLectorsClick(Sender: TObject);

begin

ClientDataSetLectors.Open;

FrmLectorList:=TFrmLectorList.Create(Self);

FrmLectorList.ShowModal;

FrmLectorList.Free;

ClientDataSetLectors.Close;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if RzGlyphStatus1.ImageIndex=14 then RzGlyphStatus1.ImageIndex:=13

{ if RzGlyphStatus1.ImageIndex=13 }else RzGlyphStatus1.ImageIndex:=14;

Application.ProcessMessages;

end;

procedure TForm1.ClientDataSetPredmetBeforeDelete(DataSet: TDataSet);

var Mes:integer;

id_predmet:LongInt;

begin

Mes:=MessageBox(AddPredmetFrm.Handle,'Вы действительно хотите удалить'+#10#13+' этот предмет и все что к нему относится','Удаление',

MB_YESNO OR MB_DEFBUTTON1 OR MB_ICONWARNING);

if Mes=mrYes then

begin

with Form1 do

begin

id_predmet:=ClientDataSetPredmet.FieldValues['PREDMET_ID'];

ClientDataSetQuery.CommandText:=

'DELETE FROM PREDMET WHERE PREDMET_ID='+IntToStr(id_predmet);

ClientDataSetQuery.Execute;

ClientDataSetPredmet.Refresh;

ClientDataSetQuery.CommandText:=

'DELETE FROM TEMA WHERE PREDMET_ID='+IntToStr(id_predmet);

ClientDataSetQuery.Execute;

ClientDataSetTema.Refresh;

ClientDataSetQuery.CommandText:=

'DELETE FROM VOPROS WHERE PREDMET_ID='+IntToStr(id_predmet);

ClientDataSetQuery.Execute;

ClientDataSetVopros.Refresh;

ClientDataSetQuery.CommandText:=

'DELETE FROM VARIANT WHERE PREDMET_ID='+IntToStr(id_predmet);

ClientDataSetQuery.Execute;

ClientDataSetVariant.Refresh;

end;

end else Abort;

end;

procedure TForm1.ClientDataSetTemaBeforeDelete(DataSet: TDataSet);

var Mes:integer;

id_predmet:LongInt;

id_tema:LongInt;

begin

Mes:=MessageBox(AddPredmetFrm.Handle,'Вы действительно хотите удалить'+#10#13+' эту тему и все что к ней относится','Удаление',

MB_YESNO OR MB_DEFBUTTON1 OR MB_ICONWARNING);

if Mes=mrYes then

begin

with Form1 do

begin

id_predmet:=ClientDataSetPredmet.FieldValues['PREDMET_ID'];

id_tema:=ClientDataSetTema.FieldValues['TEMA_ID'];

ClientDataSetQuery.CommandText:=

'DELETE FROM TEMA WHERE PREDMET_ID='+IntToStr(id_predmet)

+' AND TEMA_ID='+IntToStr(id_tema);

ClientDataSetQuery.Execute;

ClientDataSetTema.Refresh;

ClientDataSetQuery.CommandText:=

'DELETE FROM VOPROS WHERE PREDMET_ID='+IntToStr(id_predmet)

+' AND TEMA_ID='+IntToStr(id_tema);

ClientDataSetQuery.Execute;

ClientDataSetVopros.Refresh;

ClientDataSetQuery.CommandText:=

'DELETE FROM VARIANT WHERE PREDMET_ID='+IntToStr(id_predmet)

+' AND TEMA_ID='+IntToStr(id_tema);

ClientDataSetQuery.Execute;

ClientDataSetVariant.Refresh;

end;

end else Abort;

end;

procedure TForm1.ClientDataSetTemaBeforeRefresh(DataSet: TDataSet);

begin

if ClientDataSetTema.ApplyUpdates(-1)<>0 then Abort;

end;

procedure TForm1.ClientDataSetPredmetBeforeRefresh(DataSet: TDataSet);

begin

if ClientDataSetPredmet.ApplyUpdates(-1)<>0 then Abort;

end;

procedure TForm1.MAboutClick(Sender: TObject);

begin

AboutFrm:=TAboutFrm.Create(self);

AboutFrm.ShowModal;

AboutFrm.Free;

end;

procedure TForm1.ClientDataSetVoprosBeforeRefresh(DataSet: TDataSet);

begin

if ClientDataSetVopros.ApplyUpdates(-1)<>0 then Abort;

end;

procedure TForm1.ClientDataSetVoprosAfterPost(DataSet: TDataSet);

begin

if ClientDataSetVopros.ApplyUpdates(-1)<>0 then

ClientDataSetVopros.Refresh

end;

procedure TForm1.ClientDataSetVariantAfterPost(DataSet: TDataSet);

begin

if ClientDataSetVariant.ApplyUpdates(-1)<>0 then ClientDataSetVariant.Refresh;

end;

procedure TForm1.ClientDataSetPredmetBeforeInsert(DataSet: TDataSet);

begin

PredmetAdd:=TPredmetAdd.Create(self);

PredmetAdd.Label1.Visible:=False;

PredmetAdd.Edit2.Visible:=False;

PredmetAdd.Caption:='Добавить новый предмет';

PredmetAdd.GroupBox1.Caption:='Укажите название предмета';

PredmetAdd.ShowModal;

if PredmetAdd.ModalResult=mrOk then

begin

ClientDataSetQuery.CommandText:=

'INSERT INTO PREDMET (PREDMET) VALUES( '+''''+PredmetAdd.Edit1.Text+''')';

ClientDataSetQuery.Execute;

ClientDataSetPredmet.Refresh;

Abort;

end else Abort;

PredmetAdd.Free;

end;

procedure TForm1.ClientDataSetTemaBeforeInsert(DataSet: TDataSet);

begin

PredmetAdd:=TPredmetAdd.Create(self);

PredmetAdd.Label1.Visible:=True;

PredmetAdd.Edit2.Visible:=True;

PredmetAdd.Caption:='Добавить новую тему';

PredmetAdd.GroupBox1.Caption:='Укажите название темы';

PredmetAdd.ShowModal;

if PredmetAdd.ModalResult=mrOk then

begin

ClientDataSetQuery.CommandText:=

'INSERT INTO TEMA (PREDMET_ID,TEMA,VOPROS_COUNT)'+

' VALUES( '+String(ClientDataSetPredmet.FieldValues['PREDMET_ID'])+','

+''''+PredmetAdd.Edit1.Text+''','+PredmetAdd.Edit2.Text+')';

ClientDataSetQuery.Execute;

ClientDataSetTema.Refresh;

Abort;

end else Abort;

PredmetAdd.Free;

end;

procedure TForm1.ClientDataSetVoprosAfterInsert(DataSet: TDataSet);

begin

{ if AddVoprosFrm.DBLookupComboBox2.Text='' then

begin

abort;

exit;

end;

DlgFrmAddVopros:=TDlgFrmAddVopros.Create(self);

DlgFrmAddVopros.ShowModal;

DlgFrmAddVopros.Free;}

end;

end.

Диалоговое окно добавление и редактирования пользователей программного комплекса. Модуль Add_Edit_User.

unit Add_Edit_User;

interface

uses

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

Dialogs, ComCtrls, StdCtrls;

type

TAddEditUserFrm = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Edit1: TEdit;

Edit2: TEdit;

ComboBox1: TComboBox;

Button1: TButton;

Button2: TButton;

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

AddEditUserFrm: TAddEditUserFrm;

implementation

uses Unit1,UserList, AddStudents, AddLectors;

{$R *.dfm}

procedure TAddEditUserFrm.FormCreate(Sender: TObject);

begin

if Not Edit_App_Flag then

begin

Edit1.Text:=Form1.ClientDataSetUser.FieldValues['LOGIN'];

Edit2.Text:=Form1.ClientDataSetUser.FieldValues['PASS'];

if not Form1.ClientDataSetUser.FieldValues['STATUS'] then

ComboBox1.ItemIndex:=0 else ComboBox1.ItemIndex:=1;

end;

end;

procedure TAddEditUserFrm.Button2Click(Sender: TObject);

begin

Close

end;

procedure TAddEditUserFrm.Button1Click(Sender: TObject);

var User_id:LongInt;

begin

if Edit1.Text='' then Exit;

with Form1 do

begin

if Edit_App_Flag then ClientDataSetUser.Append

else ClientDataSetUser.Edit;

ClientDataSetUser.FieldValues['LOGIN']:=Edit1.Text;

ClientDataSetUser.FieldValues['PASS']:=Edit2.Text;

ClientDataSetUser.FieldValues['STATUS']:=

Boolean(ComboBox1.ItemIndex);

ClientDataSetUser.Post;

try

if ClientDataSetUser.ApplyUpdates(-1)=0 then ClientDataSetUser.refresh;

except

on E:Exception do

MessageDLG(Format('Ошибка нет подключения к серверу: %S',[E.Message]),

mtError,[mbOK],0);

end;

if Edit_App_Flag then

begin

ClientDataSetUser.Last;

User_id:=ClientDataSetUser.FieldValues['USER_ID'];

end else User_id:=ClientDataSetUser.FieldValues['USER_ID'];

end; //with

if ComboBox1.ItemIndex=0 then

begin

Form1.ClientDataSetStudents.Open;

if Edit_App_Flag then Form1.ClientDataSetStudents.Append

else begin

Form1.ClientDataSetStudents.Locate('USER_ID',User_Id,[]);

Form1.ClientDataSetStudents.Edit;

end;

AddStudentsFrm:=TAddStudentsFrm.Create(Self);

AddStudentsFrm.ShowModal;

Form1.ClientDataSetStudents.FieldValues['USER_ID']:=User_id;

if AddStudentsFrm.ModalResult=mrOK then

begin

with Form1 do

begin

ClientDataSetStudents.FieldValues['KOD']:=StrToInt(AddStudentsFrm.Edit1.Text);

ClientDataSetStudents.FieldValues['FM']:=AddStudentsFrm.Edit2.Text;

ClientDataSetStudents.FieldValues['IM']:= AddStudentsFrm.Edit3.Text;

ClientDataSetStudents.FieldValues['OT']:=AddStudentsFrm.Edit4.Text;

ClientDataSetStudents.FieldValues['KURS']:=StrToInt(AddStudentsFrm.Edit5.Text);

ClientDataSetStudents.FieldValues['DATR']:=

StrToDate(AddStudentsFrm.MaskEdit1.Text);

ClientDataSetStudents.FieldValues['SPEC']:=AddStudentsFrm.Edit6.Text;

end;

end;

Form1.ClientDataSetStudents.Post;

try

if Form1.ClientDataSetStudents.ApplyUpdates(-1)=0 then Form1.ClientDataSetStudents.refresh;

except

on E:Exception do

MessageDLG(Format('Ошибка нет подключения к серверу: %S',[E.Message]),

mtError,[mbOK],0);

end;

AddStudentsFrm.Free;

Form1.ClientDataSetStudents.Close;

end;// if ComboBox1.ItemIndex=0 then

if ComboBox1.ItemIndex=1 then

begin

Form1.ClientDataSetLectors.Open;

if Edit_App_Flag then Form1.ClientDataSetLectors.Append

else begin

Form1.ClientDataSetLectors.Locate('USER_ID',User_Id,[]);

Form1.ClientDataSetLectors.Edit;

end;

AddLectorsFrm:=TAddLectorsFrm.Create(Self);

AddLectorsFrm.ShowModal;

Form1.ClientDataSetLectors.FieldValues['USER_ID']:=User_id;

if AddLectorsFrm.ModalResult=mrOK then

begin

with Form1 do

begin

ClientDataSetLectors.FieldValues['FM']:=

AddLectorsFrm.Edit1.Text;

ClientDataSetLectors.FieldValues['IM']:=

AddLectorsFrm.Edit2.Text;

ClientDataSetLectors.FieldValues['OT']:=

AddLectorsFrm.Edit3.Text;

end;

end;

Form1.ClientDataSetLectors.Post;

try

if Form1.ClientDataSetLectors.ApplyUpdates(-1)=0 then Form1.ClientDataSetLectors.refresh;

except

on E:Exception do

MessageDLG(Format('Ошибка нет подключения к серверу: %S',[E.Message]),

mtError,[mbOK],0);

end;

AddLectorsFrm.Free;

Form1.ClientDataSetLectors.Close;

end;

Close;

end;

end.

Модуль AddLectors. Добавление нового пользователя со статусом «преподаватель».

unit AddLectors;

interface

uses

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

Dialogs, StdCtrls;

type

TAddLectorsFrm = class(TForm)

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

GroupBox2: TGroupBox;

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

AddLectorsFrm: TAddLectorsFrm;

implementation

uses Unit1,UserList;

{$R *.dfm}

procedure TAddLectorsFrm.Button1Click(Sender: TObject);

begin

if (Edit1.Text='') then Exit;

if (Edit2.Text='') then Exit;

if (Edit3.Text='') then Exit;

AddLectorsFrm.ModalResult:=mrOk;

end;

procedure TAddLectorsFrm.FormCreate(Sender: TObject);

begin

if not Edit_App_Flag then

begin

with Form1 do

begin

if ClientDataSetLectors.FieldValues['FM']<>Null then

Edit1.Text:=String(ClientDataSetLectors.FieldValues['FM'])

else Edit1.Text:='';

if ClientDataSetLectors.FieldValues['IM']<>Null then

Edit2.Text:=String(ClientDataSetLectors.FieldValues['IM'])

else Edit2.Text:='';

if ClientDataSetLectors.FieldValues['OT']<> Null then

Edit3.Text:=String(ClientDataSetLectors.FieldValues['OT'])

else Edit3.Text:='';

end;

end;

end;

end.

Модуль AddStudents. Добавление нового пользователя со статусом «студент».

unit AddStudents;

interface

uses

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

Dialogs, dbcgrids, StdCtrls, Mask, DBCtrls, ExtCtrls;

type

TAddStudentsFrm = class(TForm)

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

GroupBox2: TGroupBox;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

MaskEdit1: TMaskEdit;

Edit5: TEdit;

Label6: TLabel;

Edit6: TEdit;

Label7: TLabel;

Button1: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

public

{ Public declarations }

end;

var

AddStudentsFrm: TAddStudentsFrm;

implementation

uses Unit1,UserList;

{$R *.dfm}

procedure TAddStudentsFrm.FormCreate(Sender: TObject);

begin

if Edit_App_Flag then MaskEdit1.Text:=DateTostr(Now)

else begin

with Form1 do

begin

Edit1.Text:=IntToStr(ClientDataSetStudents.FieldValues['KOD']);

Edit2.Text:=String(ClientDataSetStudents.FieldValues['FM']);

Edit3.Text:=String(ClientDataSetStudents.FieldValues['IM']);

Edit4.Text:=String(ClientDataSetStudents.FieldValues['OT']);

Edit5.Text:=IntTostr(ClientDataSetStudents.FieldValues['KURS']);

MaskEdit1.Text:=DateToStr(ClientDataSetStudents.FieldValues['DATR']);

Edit6.Text:=ClientDataSetStudents.FieldValues['SPEC'];

end;

end;

end;

procedure TAddStudentsFrm.Button1Click(Sender: TObject);

begin

if (Edit1.Text='') then Exit;

if (Edit2.Text='') then Exit;

if (Edit3.Text='') then Exit;

if (Edit4.Text='') then Exit;

if (Edit5.Text='') then Exit;

if (Edit6.Text='') then Exit;

if (MaskEdit1.Text='') then Exit;

AddStudentsFrm.ModalResult:=mrOk;

end;

procedure TAddStudentsFrm.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

if (Edit1.Text='')OR

(Edit2.Text='')OR

(Edit3.Text='')OR

(Edit4.Text='')OR

(Edit5.Text='')OR

(Edit6.Text='')OR

(MaskEdit1.Text='')

then

begin

Action:=caNone;

ShowMessage('Не заданы все необходимые сведения');

end //else Action:=caFree;

end;

end.

Модуль UserList. Отображает список пользователей программного комплекса.

unit UserList;

interface

uses

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

Dialogs, StdCtrls, DB, Grids, DBGrids, ExtCtrls;

type

TUserListFrm = class(TForm)

GroupBox1: TGroupBox;

GroupBox2: TGroupBox;

DataSource1: TDataSource;

App_New_User: TButton;

Delete_User: TButton;

Edit_Old_User: TButton;

SaveCheng: TButton;

GroupBox3: TGroupBox;

DBGrid1: TDBGrid;

Button1: TButton;

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure App_New_UserClick(Sender: TObject);

procedure Delete_UserClick(Sender: TObject);

procedure Edit_Old_UserClick(Sender: TObject);

procedure SaveChengClick(Sender: TObject);

procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

UserListFrm: TUserListFrm;

Edit_App_Flag:Boolean=false;

implementation

uses Unit1, Add_Edit_User;

{$R *.dfm}

procedure TUserListFrm.FormCreate(Sender: TObject);

begin

Form1.ClientDataSetUser.Open;

end;

procedure TUserListFrm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Form1.ClientDataSetUser.Close;

end;

procedure TUserListFrm.App_New_UserClick(Sender: TObject);

begin

Edit_App_Flag:=True;//добавить нового

AddEditUserFrm:=TAddEditUserFrm.Create(Self);

AddEditUserFrm.ShowModal;

AddEditUserFrm.Free;

end;

procedure TUserListFrm.Delete_UserClick(Sender: TObject);

begin

try

Form1.ClientDataSetUser.Delete;

except

on E:Exception do

MessageDLG(Format('Ошибка удаления записи: %S',[E.Message]),

mtError,[mbOK],0);

end;

end;

procedure TUserListFrm.Edit_Old_UserClick(Sender: TObject);

begin

Edit_App_Flag:=false;//редактировать старого

AddEditUserFrm:=TAddEditUserFrm.Create(Self);

AddEditUserFrm.ShowModal;

AddEditUserFrm.Free;

end;

procedure TUserListFrm.SaveChengClick(Sender: TObject);

begin

with Form1 do

begin

if (ClientDataSetUser.ChangeCount > 0) then

if ClientDataSetUser.ApplyUpdates(-1)=0 then

ClientDataSetUser.refresh;

end;

end;

procedure TUserListFrm.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

if DataCol=2 then

begin

DBGrid1.Canvas.FillRect(Rect);

if Form1.ClientDataSetUser.FieldValues['STATUS'] then

DBGrid1.Canvas.TextOut(Rect.Left+5,Rect.Top,'Преподователь')

else DBGrid1.Canvas.TextOut(Rect.Left+5,Rect.Top,'Студент');

end;

end;

procedure TUserListFrm.Button1Click(Sender: TObject);

begin

Close

end;

end.

Модуль LectorList. Отображает список преподавателей.

unit LectorList;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, DBCtrls, RzDBNav, Grids, DBGrids, RzDBGrid;

type

TFrmLectorList = class(TForm)

GroupBox1: TGroupBox;

RzDBGrid1: TRzDBGrid;

GroupBox2: TGroupBox;

RzDBNavigator1: TRzDBNavigator;

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmLectorList: TFrmLectorList;

implementation

uses Unit1;

{$R *.dfm}

procedure TFrmLectorList.Button1Click(Sender: TObject);

begin

Close;

end;

end.

Модуль StudentList; Отображает список студентов и их оценки.

unit StudentList;

interface

uses

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

Dialogs, StdCtrls, Grids, DBGrids, RzDBGrid, ExtCtrls, DBCtrls, RzDBNav;

type

TStudentsListFrm = class(TForm)

GroupBox1: TGroupBox;

RzDBGrid1: TRzDBGrid;

GroupBox2: TGroupBox;

Button1: TButton;

Button2: TButton;

RzDBNavigator1: TRzDBNavigator;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

StudentsListFrm: TStudentsListFrm;

implementation

uses Unit1,Excel;

{$R *.dfm}

procedure TStudentsListFrm.Button1Click(Sender: TObject);

begin

Close;

end;

procedure TStudentsListFrm.Button2Click(Sender: TObject);

Var S:String;

UserID,PredmetId,TemaID:LongInt;

I:LongInt;

Pr,Tm,Oc:String;

begin

UserID:=Form1.ClientDataSetStudents.FieldValues['USER_ID'];

Excel.RunExcel;

Excel.NewWorkShet(True);

Excel.FormatCell('C2','H2',exCenter,exCenter,True,True,

true,'Times New Roman',16);

Excel.SetCellRangeValue('C2','C2','ВЕДОМОСТЬ УСПЕВАЕМОСТИ');

Excel.FormatCell('B4','I4',exCenter,exCenter,True,True,

true,'Times New Roman',14);

S:='Студента '+String(Form1.ClientDataSetStudents.FieldValues['KURS'])+

' курса. Cпециальность '+String(Form1.ClientDataSetStudents.FieldValues['SPEC']);

Excel.SetCellRangeValue('B4','B4',S);

Excel.FormatCell('C6','H6',exCenter,exCenter,True,True,

true,'Times New Roman',14);

S:=String(Form1.ClientDataSetStudents.FieldValues['FM'])+' '+

String(Form1.ClientDataSetStudents.FieldValues['IM'])+' '+

String(Form1.ClientDataSetStudents.FieldValues['OT']);

Excel.SetCellRangeValue('C6','C6',S);

Excel.FormatCell('A8','E10',exCenter,exCenter,True,True,

true,'Times New Roman',14);

Excel.FormatCell('F8','G10',exCenter,exCenter,True,True,

true,'Times New Roman',14);

Excel.FormatCell('H8','I10',exCenter,exCenter,True,True,

true,'Times New Roman',14);

Excel.BorderCell('A8','E10',btMedium);

Excel.BorderCell('F8','G10',btMedium);

Excel.BorderCell('H8','I10',btMedium);

Excel.SetCellRangeValue('A8','E10','Наименование предмета и тема');

Excel.SetCellRangeValue('F8','G10','Оценка');

Excel.SetCellRangeValue('H8','I10','Дата сдачи');

Form1.ClientDataSetOcenki.Open;

Form1.ClientDataSetOcenki.Filter:='USER_ID='+IntToStr(UserID);

Form1.ClientDataSetOcenki.Filtered:=True;

Form1.ClientDataSetOcenki.First;

Form1.ClientDataSetPredmet.Open;

Form1.ClientDataSetTema.Open;

while not Form1.ClientDataSetOcenki.Eof do

begin

I:=Form1.ClientDataSetOcenki.RecNo+10;

Excel.SetCellRangeHeight('A'+IntToStr(I),'D'+IntToStr(I),30);

Excel.FormatCell('A'+IntToStr(I),'E'+IntToStr(I),exCenter,exCenter,True,True,

false,'Times New Roman',12);

Excel.FormatCell('F'+IntToStr(I),'G'+IntToStr(I),exCenter,exCenter,True,True,

False,'Times New Roman',12);

Excel.FormatCell('H'+IntToStr(I),'I'+IntToStr(I),exCenter,exCenter,True,True,

False,'Times New Roman',12);

Excel.BorderCell('A'+IntToStr(I),'E'+IntToStr(I),btMedium);

Excel.BorderCell('F'+IntToStr(I),'G'+IntToStr(I),btMedium);

Excel.BorderCell('H'+IntToStr(I),'I'+IntToStr(I),btMedium);

PredmetID:=Form1.ClientDataSetOcenki.FieldValues['Predmet_id'];

TemaID:=Form1.ClientDataSetOcenki.FieldValues['Tema_id'];

if Form1.ClientDataSetPredmet.Locate('PREDMET_ID',PredmetID,[]) then

Pr:=Form1.ClientDataSetPredmet['PREDMET']

else Pr:='';

if Form1.ClientDataSetTema.Locate('PREDMET_ID;TEMA_ID',

VarArrayOf([PredmetID,TemaID]),[]) then

Tm:=Form1.ClientDataSetTema['TEMA']

else Tm:='';

Excel.SetCellRangeValue('A'+IntToStr(I),'E'+IntToStr(I),

Pr+ '., "'+Tm+'"');

Case Form1.ClientDataSetOcenki.FieldValues['OCENKA'] of

2 : Oc:='Не удовлетворительно';

3 : Oc:='Удовлетворительно';

4 : Oc:='Хорошо';

5 : Oc:='Отлично';

else Oc:='';

end;

Excel.SetCellRangeValue('F'+IntToStr(I),'G'+IntToStr(I),Oc);

Excel.SetCellRangeValue('H'+IntToStr(I),'I'+IntToStr(I),

Form1.ClientDataSetOcenki.FieldValues['DATA']);

Form1.ClientDataSetOcenki.Next;

end;

Form1.ClientDataSetOcenki.Filter:='';

Form1.ClientDataSetOcenki.Filtered:=False;

Form1.ClientDataSetOcenki.Close;

Form1.ClientDataSetPredmet.Close;

Form1.ClientDataSetTema.Close;

// Excel.SetCellValue(3,2,Form1.ClientDataSetStudents.FieldValues['FM']);

end;

end.

Модуль UserLogin. Диалоговое окно ввода логина и пароля при входе в программу.

unit UserLogin;

interface

uses

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

Dialogs, StdCtrls;

type

TForm3 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Button1: TButton;

Button2: TButton;

procedure Edit1KeyPress(Sender: TObject; var Key: Char);

procedure Edit2KeyPress(Sender: TObject; var Key: Char);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13 then

begin

Edit2.SetFocus;

key:=#0;

end;

end;

procedure TForm3.Edit2KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13 then

begin

Button1.SetFocus;

key:=#0;

end;

end;

end.

Модуль Nastr_Connect. Настройки соединения с серверной часть программного комплекса.

unit Nastr_Connect;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Buttons;

type

TForm2 = class(TForm)

Label1: TLabel;

Edit1: TEdit;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Button1: TButton;

Button2: TButton;

RadioGroup1: TRadioGroup;

SpeedButton1: TSpeedButton;

procedure FormCreate(Sender: TObject);