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

Подождите немного. Документ загружается.

About: TMenuItem;

Nasrt: TMenuItem;

Exit_prg: TMenuItem;

TcpClient1: TTcpClient;

ListBox1: TListBox;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure TrayNotifyIcon1DblClick(Sender: TObject);

procedure AboutClick(Sender: TObject);

procedure Exit_prgClick(Sender: TObject);

procedure NasrtClick(Sender: TObject);

procedure FormShow(Sender: TObject);

private

procedure WMChangeCaption(var Message:TMessage); message WM_CHANGECAPTION;

procedure WMHideTask(var Message:TMessage); message WM_HIDETASK;

procedure WMUserIPAdres(var Message:TMessage); message WM_USERIPADRES;

{ Private declarations }

public

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

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

procedure PathNastr;

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses RdMod,IniFiles, Nastr_Path;

{$R *.dfm}

procedure TForm1.WMUserIPAdres(var Message: TMessage);

var

P:pchar;

S:string;

N:integer;

begin

P:=pointer(Message.WParam);

S:=P;

FreeMem(P);

if Message.lParam=0 then

begin

ListBox1.Items.Add(S); //Connect

end else

begin

N:=ListBox1.Items.IndexOf(S);

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

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;

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;

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;

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

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;

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,

100

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;

101