Sep, tmpRange, NumCols: OleVariant;

Parfs: Paragraphs;

Par: Paragraph;

begin

WordDocument1. Activate;

WordDocument1. Range. Font. Bold:=0;

WordDocument1. Range. Font. Size:=14;

WordDocument1. PageSetup. LeftMargin:=20;

WordDocument1. PageSetup. TopMargin:=20;

WordDocument1. PageSetup. RightMargin:=20;

WordDocument1. PageSetup. BottomMargin:=60;

SetLength (StrArr, ReportGrid. RowCount);

RangeW:=WordDocument1. Range (emptyParam, emptyParam);

tmpRange:=RangeW;

Parfs:=WordDocument1. Paragraphs;

par:=Parfs. Add(tmpRange);

tmpRange:=Par. Range.get_end_;

RangeW:=WordDocument1. Range(tmpRange);

SData:='';

Data:='ФИО@Группа@Дисциплина@Верных@Неверных@Время@Оценка@';

for j:=1 to ReportGrid. RowCount do

begin

begin // вывод информации по одному преподавателю

SData:=SData+ReportGrid. Cells [0, j]+'@'+ReportGrid. Cells [1, j]+'@'+ReportGrid. Cells [2, j]+'@'

+ReportGrid. Cells [4, j]+'@'+ReportGrid. Cells [5, j]+'@'+ReportGrid. Cells [6, j]+'@'+

ReportGrid. Cells [7, j]+'@';

Data:=Data+SData;

SData:='';

end;

end;

tmpRange:=RangeW;

Par:=Parfs. Add(tmpRange);

Par. Range. InsertBefore(Data);

Sep:='@';

NumCols:=7;

RangeW. ConvertToTableOld (Sep, EmptyParam, NumCols, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam);

WordDocument1. Disconnect;

SetLength (StrArr, 0);

end;

procedure TServerForm. Button1Click (Sender: TObject);

var

MsWord: Variant;

begin

try

MsWord:= CreateOleObject ('Word. Application');

MsWord. Visible:= True;

MsWord. Caption:='Отчет по реультатам тестирования';

CreateReport;

except

ShowMessage ('Невозможно запустить Microsoft Word');

Exit;

end;

end;

procedure TServerForm. SpeedButton1Click (Sender: TObject);

var Command:byte;

begin

if ComboBox2. ItemIndex>=0 then

begin

Command:=NM_KickFromServer;

ServerSocket1. Socket. Connections [ComboBox2. ItemIndex].SendBuf (Command, 1);

end;

end;

procedure TServerForm. StringGrid1SelectCell (Sender: TObject; ACol,

ARow: Integer; var CanSelect: Boolean);

begin

SelectedRow:=ARow;

end;

procedure TServerForm. Button7Click (Sender: TObject);

begin

Memo1. Clear;

end;

procedure TServerForm. Button8Click (Sender: TObject);

begin

if SaveDialog1. Execute then Memo1. Lines. SaveToFile (SaveDialog1. FileName);

end;

procedure TServerForm. LogMessage (var Message: TMessage);

begin

Memo1. Lines. Add (DateTimeToStr(Now)+' '+PChar (Message.WParam));

end;

end.

unit QBaseWork;

interface

uses

Windows, Messages, SysUtils, Classes, Dialogs, IniFiles;

const

ErrWorkListLoad = 1;

ErrImputWorkNumberFault = 2;

ErrTeachersListLoad = 3;

ErrImputTeacherNumberFault = 4;

ErrQuestionsNotFound = 5;

ErrConfigIniFileWorkSetNotFound = 6;

ErrReadBuiletNumber = 7;

ErrQuestionWithInputedNumberNotFound = 8;

ErrQuestionFileWithInputedNumberNotFound = 9;

ErrInSelectedDirectoryNotQuestFileNameFound = 10;

ErrGenerationRndQuest = 11;

type

DBase=record

Works:HLringList;

Teachers:array of HLringList;

end;

type

TQuestDB = class

private

SelfParent:HWND;

NewBase:DBase;

WorksCount_:integer;

WorkTimeLimit_:String;

ProgRootDir:string;

ActiveWork:string;

ActiveTeacher:string;

ActiveWorkNum:byte;

ActiveTeacherNum:byte;

 ///////QUESTIONS /////////

ImgType:string;

QuestCount:integer;

QuestionsPathName:string;

ActivTransactionUser: String;

procedure ERROR_MESSAGE_FOR_DEBUG_LEVEL (ErrID:byte);

 ///////QUESTIONS /////////

function ConverHLrToIntNum (StringNum: string): integer;

function TestByDigit (DataString: string): boolean;

procedure SMessage (Message_: string);

function UpdateQuestionsSet: boolean;

 // function GetWorkIndex (WorkName: string): integer;

 // function GetTeacherIndex (TeacherName: string): integer;

public

constructor Create (ParentHwnd:HWND);

destructor Destroy; override;

function SetActiveTeacher (Num: byte):boolean;

function SetActiveWork (Num: byte):boolean;

function GetWorksStringList:string;

function GetTeachersStringList:string;

property ActivWorkName:string read ActiveWork;

property ActivTeacherName:string read ActiveTeacher;

property TransactionUser:string read ActivTransactionUser write ActivTransactionUser;

property PubActivWorkNum:byte read ActiveWorkNum;

property PubActivTeacherNum:byte read ActiveTeacherNum;

property QuestionsFullPath:string read QuestionsPathName;

function GetWorkByIndex (i: byte): string;

function GetTeacherByIndex (i: byte): string;

 ///////QUESTIONS /////////

property ImgFileType:string read ImgType;

property QuestionsCount:integer read QuestCount;

property WorkTimeLimit: String read WorkTimeLimit_;

function GetBuiletByNum (Num: integer): string;

function GetFileBuiletByNumBuilet (BuiletNum, FileNum: integer): string;

function GetRandomFileBuilet (BuiletNum: integer): string;

function GetTrueAnswerForBuilet (QuestionPath: string): integer;

function SetTrueAnswerForBuilet (QuestionPath: string; TrueAnswer: Integer): boolean;

end;

implementation

{TQuestDB}

constructor TQuestDB. Create (ParentHwnd:HWND);

var ExeName:PChar;

AppName: String;

ExeNameLen:byte;

 /////

NewSearch_:TSearchRec;

i, ii:byte;

QuestionPathName:string;

QCount:integer;

FOptions:TIniFile;

begin

SelfParent:=ParentHwnd;

GetMem (ExeName, 255);

ExeNameLen:=255;

GetModuleFileName (0, ExeName, ExeNameLen); // определяем имя исполняемого модуля

AppName:=StrPas(ExeName);

ProgRootDir:=ExtractFileDir(AppName);

WorksCount_:=0;

NewBase. Works:=HLringList. Create; // заполняем список работ

FindFirst (ProgRootDir+'\Questions\*', faDirectory, NewSearch_);

repeat

if NewSearch_.Name[1]<>'.' then

begin

NewBase. Works. Add (NewSearch_.Name);

inc (WorksCount_);

end;

until FindNext (NewSearch_)<>0;

FindClose (NewSearch_);

 // Заполняем списки преподов

SetLength (NewBase. Teachers, WorksCount_);

for i:=0 to WorksCount_-1 do

begin

NewBase. Teachers[i]:=HLringList. Create;

FindFirst (ProgRootDir+'\Questions\'+NewBase. Works. Strings[i]+'\*', faDirectory, NewSearch_);

repeat

if NewSearch_.Name[1]<>'.' then NewBase. Teachers[i].Add (NewSearch_.Name);

until FindNext (NewSearch_)<>0;

FindClose (NewSearch_);

end;

for i:=0 to NewBase. Works. Count-1 do

begin

for ii:=0 to NewBase. Teachers[i].Count-1 do

begin

QuestionPathName:=ProgRootDir+'\Questions\'+NewBase. Works. Strings[i]+'\'+ NewBase. Teachers[i].Strings[ii];

if FileExists (QuestionPathName+'\WorkSet.ini') then

begin

FOptions:=TIniFile. Create (QuestionPathName+'\WorkSet.ini');

QCount:=0;

FindFirst (QuestionPathName+'\*', faDirectory, NewSearch_);

repeat

if NewSearch_.Name[1]<>'.' then

if TestByDigit (NewSearch_.Name) then inc(QCount);

until FindNext (NewSearch_)<>0;

FindClose (NewSearch_);

FOptions. WriteInteger ('QuestionCount', 'value', QCount);

FOptions. Free;

if QCount>0 then QuestCount:=QCount else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrQuestionsNotFound);

end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrConfigIniFileWorkSetNotFound);

end;

end;

end;

destructor TQuestDB. Destroy;

var i:integer;

begin

for i:=0 to NewBase. Works. Count-1 do

begin

NewBase. Teachers[i].Destroy;

end;

SetLength (NewBase. Teachers, 0);

NewBase. Works. Destroy;

inherited;

end;

function TQuestDB. SetActiveWork (Num:byte):boolean;

begin

result:=false;

if Num<NewBase. Works. Count then

begin

ActiveWork:=NewBase. Works. Strings[Num];

ActiveWorkNum:=Num;

result:=true;

end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrImputWorkNumberFault);

end;

function TQuestDB. SetActiveTeacher (Num:byte):boolean;

begin

result:=false;

if Num<NewBase. Teachers[ActiveWorkNum].Count then

begin

ActiveTeacher:=NewBase. Teachers[ActiveWorkNum].Strings[Num];

ActiveTeacherNum:=Num;

if UpdateQuestionsSet then result:=true;

end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrImputTeacherNumberFault);

end;

function TQuestDB. GetTeachersStringList: string;

var i:integer;

begin

Result:='';

for i:=0 to NewBase. Teachers[ActiveWorkNum].Count-1 do Result:=Result+NewBase. Teachers[ActiveWorkNum].Strings[i]+'|';

Result:=Result+'>';

end;

function TQuestDB. GetWorksStringList: string;

var i:integer;

begin

Result:='';

for i:=0 to NewBase. Works. Count-1 do Result:=Result+NewBase. Works. Strings[i]+'|';

Result:=Result+'>';

end;

function TQuestDB. GetWorkByIndex (i:byte): string;

begin

if i<=NewBase. Works. Count-1 then Result:=NewBase. Works. Strings[i] else Result:='';

end;

function TQuestDB. GetTeacherByIndex (i:byte): string;

begin

if i<=NewBase. Teachers[ActiveWorkNum].Count-1 then

Result:=NewBase. Teachers[ActiveWorkNum].Strings[i] else

Result:='';

end;

procedure TQuestDB.ERROR_MESSAGE_FOR_DEBUG_LEVEL (ErrID: byte);

begin

Case ErrID of

ErrWorkListLoad:

begin

SMessage ('Base read works error');

end;

ErrTeachersListLoad:

begin

SMessage ('Base read teachers error');

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11