Автоматизация процесса тестирования, защита от изменения, подмены и перехвата при передаче данных и от беспрепятственного физического ко

 

SetWPtoNull(nom);

ShowWorkPlases(-1);

end;

 

procedure TFmExamServer.SpeedButton3Click(Sender: TObject);

begin

FinishExamAtAll(StringGrid1.Row,true);

end;

 

procedure TFmExamServer.SpeedButton4Click(Sender: TObject);

begin

FmSettings.ShowModal;

end;

 

procedure TFmExamServer.EmercyFinishExam(RowNom:integer;Speaker:boolean);

var nom:integer;

begin

if length(WorkPlaces)=0 then

begin

   if speaker then MessageDlg('Нет подключенных рабочих станций.'+#13+

                      'Нечего отменять.', mtinformation,      [mbOk], 0);

   exit;

   end;

 

nom:=FindNomberByTag(strtoint(StringGrid1.Cells[0,RowNom]));

if nom=-1 then

BEGIN

   if speaker then MessageDlg('Компьютер не доступен.'+#13+

                 'Нельзя отменить экзамен на недоступном компьютере.', mtinformation,      [mbOk], 0);

   exit;

   end;

 

if nom>=0 then

   if WorkPlaces[nom].ExamTeoryPK=0 then

BEGIN

   if speaker then  MessageDlg('На указанном компьютере не назначен экзамен.'+#13+

                 'Нельзя отменить экзамен, пока  он не назначен.', mtinformation,      [mbOk], 0);

   exit;

   end;

WorkPlaces[nom].ClientSocket.Socket.SendText(inttostr(-3));

    IBDsetEXAMTRwrite.Close;

    IBDsetEXAMTRwrite.SelectSQL.Clear;

    IBDsetEXAMTRwrite.SelectSQL.Add('Select * from EXAMTR where PK='+inttostr(WorkPlaces[nom].ExamTeoryPK));

    IBDsetEXAMTRwrite.Open;

    IBDsetEXAMTRwrite.Edit;

    IBDsetEXAMTRwrite.FieldByName('STATUS').AsInteger:=6;

    IBDsetEXAMTRwrite.Post;

    IBDsetEXAMTRwrite.Close;

    WriteIBTransaction.Commit;

SetWPtoNull(nom);

end;

 

procedure TFmExamServer.SpeedButton2Click(Sender: TObject);

begin

 EmercyFinishExam (StringGrid1.Row,true);

end;

 

function TFmExamServer.GetComputerNetName: string;

var

  buffer: array[0..255] of char;

  size: dword;

begin

  size := 256;

  if GetComputerName(buffer, size) then

    Result := buffer

  else

    Result := ''

end;

 

 

procedure TFmExamServer.ShowWorkPlases(InitiativeStantion:integer);

const defRows=5 ;

var i,j,tmpTag:integer;

    NEWstatus:integer;

    pref:string;

 

function GetShortName(inpName:string):string;

var Sp,d,i:integer;

  surOK,secOK:boolean;

begin

result:='';

Sp:=0;

d:=0;

surOK:=false;

secOK:=false;

for i:=1 to length(inpname) do

begin

   if inpname[i]=' ' then Sp:=Sp+1

    else

      begin

      if Sp=0 then result:=result+inpname[i];

      if (Sp=1) and (not surok) then

       begin

         surok:=true;

         result:=result+' '+inpname[i]+'.';

         end;

      if (Sp=2) and (not secok) then

       begin

         secok:=true;

         result:=result+inpname[i]+'.  ';

         end;

      end;

   if inpname[i]='[' then

    begin

      d:=d+1;

      result:=result+inpname[i];

      end

    else if d=1 then result:=result+inpname[i];

   if inpname[i]=']' then d:=0;

   end;

end;

 

begin

IBDataSetEXAMtr.Close;

IBDataSetEXAMtr.Open;

IBDataSetEXAMtr.FetchAll;

IBDataSetEXAMtr.First;

StringGrid1.ColCount:=defRows+10;

if length(WorkPlaces)=0 then StringGrid1.RowCount:=2 else StringGrid1.RowCount:=1+length(WorkPlaces);

for i := 0 to StringGrid1.RowCount - 1 do StringGrid1.Rows[i].Clear();

    StringGrid1.Cells[0,0]:= '№';

    StringGrid1.Cells[1,0]:= 'Компьютер';

    StringGrid1.Cells[2,0]:= 'Cтатус процесса';

    StringGrid1.Cells[3,0]:= 'Экзаменуемый';

    StringGrid1.Cells[4,0]:= 'Время';

    for j:=1 to 10 do

        begin

        StringGrid1.Cells[j+defRows-1,0]:=inttostr(j);

        StringGrid1.ColWidths[j+defRows-1]:=18;

        end;

 

for i:=0 to length(WorkPlaces)-1 do

    begin

    tmpTag:=WorkPlaces[i].ClientSocket.tag;

    StringGrid1.Cells[0,i+1]:= inttostr(abs(tmpTag));

    //if tmpTag<=0 then pref:= '{of   ';

    //if tmpTag>0 then pref:= '{on   ';

    if WorkPlaces[i].ClientSocket.Active then pref:= '{on   '

                                         else pref:= '{of   ';

    StringGrid1.Cells[1,i+1]:=pref+ WorkPlaces[i].ClientComputerName;

    if IBDataSetEXAMtr.Locate('PK', WorkPlaces[i].ExamTeoryPK , [loCaseInsensitive]) then

       begin

    NEWstatus:=IBDataSetEXAMtr.FieldByName('STATUS').Asinteger;

    WorkPlaces[i].Status:=NEWstatus;

    StringGrid1.Cells[2,i+1]:= Stat[WorkPlaces[i].Status];

       if (NEWstatus=7) or (NEWstatus=4) or (NEWstatus=5) then

         begin

         WorkPlaces[i].Resultat:= IBDataSetEXAMtr.FieldByName('RESULTAT').AsInteger;

         if WorkPlaces[i].Resultat= 1 then StringGrid1.Cells[2,i+1]:= 'Экзамен сдан' else StringGrid1.Cells[2,i+1]:= 'Экзамен НЕ сдан';

        end;

    StringGrid1.Cells[3,i+1]:=GetShortName(WorkPlaces[i].ClientManName);

 

    if i = InitiativeStantion then WorkPlaces[i].Time:=StrTimeToIntSec(IBDataSetEXAMtr.FieldByName('TOTALTIME').AsDateTime);

     StringGrid1.Cells[4,i+1]:=IntSecToStrTime(WorkPlaces[i].Time);

    for j:=1 to VOPR do StringGrid1.Cells[j+defRows-1,i+1]:='{'+inttostr(IBDataSetEXAMtr.FieldByName('Q'+inttostr(j)+'RES').Asinteger)+'}';

       end;

    end;

end;

 

procedure TFmExamServer.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

  Rect: TRect; State: TGridDrawState);

const

  clPaleGreen = TColor($AAFFAA);

  clPaleRed = TColor($AAAAFF);

begin

 

with (Sender as TStringGrid) do

  with Canvas do

  begin

    if StringGrid1.Cells[2,Arow]='Экзамен сдан' then

        begin

       if Acol=2 then FONT.Style:=[fsBold];

          if (gdSelected  in State) then

              begin

              Brush.color := clGreen;

              FONT.color := clWhite  ;

              end

              else

              begin

              Brush.Color := clPaleGreen ;

              FONT.color := clblack  ;

              end;

        FillRect(Rect);

        TextOut(Rect.Left+2, Rect.Top+2, StringGrid1.Cells[ACol, ARow]);

        end;

 

    if StringGrid1.Cells[2,Arow]='Экзамен НЕ сдан' then

        begin

       if Acol=2 then FONT.Style:=[fsBold];

          if (gdSelected  in State) then

              begin

              Brush.color := clMaroon;

              FONT.color := clWhite  ;

              end

              else

              begin

              Brush.Color := clPaleRed;

              FONT.color := clblack  ;

              end;

        FillRect(Rect);

        TextOut(Rect.Left+2, Rect.Top+2, StringGrid1.Cells[ACol, ARow]);

        end;

 

    if copy(StringGrid1.Cells[Acol,Arow],1,6)='{on   ' then

     begin

    Draw(Rect.Left, Rect.Top, Image4.Picture.Graphic);

     end;

    if copy(StringGrid1.Cells[Acol,Arow],1,6)='{of   ' then Draw(Rect.Left, Rect.Top, Image5.Picture.Graphic);

    if StringGrid1.Cells[Acol,Arow]='{0}' then

      begin

              FONT.color := Brush.Color;

              TextOut(Rect.Left+2, Rect.Top+2,StringGrid1.Cells[ACol, ARow]);

              Draw(Rect.Left+((Rect.right - Rect.Left) div 2)-(Image6.Picture.Graphic.Width div 2), Rect.Top+1, Image6.Picture.Graphic);

     end;

    if StringGrid1.Cells[Acol,Arow]='{1}' then

     begin

     FONT.color := Brush.Color;

     TextOut(Rect.Left+2, Rect.Top+2, StringGrid1.Cells[ACol, ARow]);

      Draw(Rect.Left+((Rect.right - Rect.Left) div 2)-(Image1.Picture.Graphic.Width div 2), Rect.Top+1, Image1.Picture.Graphic);

     end;

    if StringGrid1.Cells[Acol,Arow]='{2}' then

      begin

      FONT.color := Brush.Color;

     TextOut(Rect.Left+2, Rect.Top+2, StringGrid1.Cells[ACol, ARow]);

      Draw(Rect.Left+((Rect.right - Rect.Left) div 2)-(Image2.Picture.Graphic.Width div 2), Rect.Top+1, Image2.Picture.Graphic);

      end;

  end;

end;

 

procedure TFmExamServer.Timer1Timer(Sender: TObject);

var i:integer;

begin

if Timer1.Tag = 0 then

begin

   Timer1.Tag:=1;

StringGrid1.Refresh;

   end;

for i:=0 to length(WorkPlaces)-1 do

    begin

    if WorkPlaces[i].Status=3 then

        begin

        WorkPlaces[i].Time:=WorkPlaces[i].Time+1;

        StringGrid1.Cells[4,i+1]:=IntSecToStrTime(WorkPlaces[i].Time);

        end;

    end;

end;

 

procedure TFmExamServer.SpeedButton1Click(Sender: TObject);

begin

  StartNewExam(StringGrid1.Row,true);

end;

 

function TFmExamServer.FindNomberByTag(Tag:integer):integer;

var i:integer;

begin

result:=-1;

for i:=0 to length(WorkPlaces)-1 do

      begin

      if WorkPlaces[i].ClientSocket.Tag = tag then

          begin

          result:=i;

          exit;

          end;

      end;

end;

 

procedure TFmExamServer.ClientSocket1Connect(Sender: TObject;

  Socket: TCustomWinSocket);

var i:integer;

begin

i:=FindNomberByTag((Sender as TClientSocket).tag);

WorkPlaces[i].ClientSocket.Socket.SendText(inttostr(-1));

ShowWorkPlases(-1);

end;

 

procedure TFmExamServer.ClientSocket1Error(Sender: TObject;

  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;

  var ErrorCode: Integer);

begin

errorcode := 0;

with Sender as TClientSocket do

begin

tag:=-tag;

end;

ShowWorkPlases(-1);

end;

 

procedure TFmExamServer.ClientSocket1Disconnect(Sender: TObject;

  Socket: TCustomWinSocket);

begin

with Sender as TClientSocket do

begin

tag:=-tag;

Active:=false;

end;

ShowWorkPlases(-1);

end;

 

procedure TFmExamServer.ServerSocket1ClientRead(Sender: TObject;

  Socket: TCustomWinSocket);

begin

  Some(Socket.ReceiveText);

end;

 

procedure TFmExamServer.SetWPtoNull(nom:integer);

begin

         WorkPlaces[nom].ClientManName:='';

         WorkPlaces[nom].ExamTeoryPK:=0;

         WorkPlaces[nom].Time:=600;

         WorkPlaces[nom].Resultat:=0;

         WorkPlaces[nom].Status:=0;

end;

 

procedure TFmExamServer.AddAnAWorkPlace(Re,StantionNomber:integer);

var i,j:integer;                        // при Re=-1 добавляет нов. элемент в массив

    a:TServerExam;                      // при Re>=0 обновляет сокетное соединение

    CltCpuName,tmpname,FName:string;

    F:TextFile;

procedure writeToWP;

begin

         WorkPlaces[i].ClientManName:='';

         WorkPlaces[i].ExamTeoryPK:=0;

         WorkPlaces[i].Time:=0;

         WorkPlaces[i].Resultat:=0;

         WorkPlaces[i].Status:=0;

end;

 

begin

FName:=(ExtractFilePath(ParamStr(0))+'Set.cfg');

If FileExists(FName) then

begin

    AssignFile(F,FName);

    reset(F);

    j:=1;

  CltCpuName:='';

    while not Eof(F) do

     begin

      tmpname:='';

   readln(F,tmpname);

      if j=StantionNomber then CltCpuName:=tmpname;

      j:=j+1;

      end;

    CloseFile(F);

    if CltCpuName='' then

     begin

   MessageDlg('В файле настроек сервера не найдено имя компьютера для станции '+inttostr(StantionNomber)+#13+'Рабочее место не будет подключено.', mtError, [mbOk], 0);

      exit;

      end;

end

    else

    begin

    MessageDlg('Не найден файл настроек программы.'+#13+'Приложение будет закрыто.', mtError, [mbOk], 0);

    Application.Terminate

    end;

         if Re < 0 then

          begin

         setlength(WorkPlaces,length(WorkPlaces)+1);

         i:=length(WorkPlaces)-1;

            end

            else i:=Re;

if WorkPlaces[i].ExamTeoryPK=0 then writeToWP;

         WorkPlaces[i].ClientComputerName:=CltCpuName;

         if Re <0 then

            begin

          WorkPlaces[i].ClientSocket:=TClientSocket.Create(Self);

            WorkPlaces[i].ClientSocket.Name:='CltSct'+inttostr(i);

            end;

         with WorkPlaces[i].ClientSocket do

            begin

            Tag:=StantionNomber;

            Host:=WorkPlaces[i].ClientComputerName;

            Port:=1300+StantionNomber;

            OnConnect:=ClientSocket1Connect;

            OnError:=ClientSocket1Error;

            OnDisconnect:=ClientSocket1Disconnect;

            Active:=true;

            end;

end;

 

procedure TFmExamServer.Some(RecText:string);

var Stantion,Re, msg:integer;

begin

msg:=strtoint(RecText);

      if Msg>0 then

       begin

         Stantion:=msg;

         ShowWorkPlases(FindNomberByTag(Stantion));

         end;

      if msg<0 then

       begin

         Re:=-1;

         Stantion:=abs(msg);

         if FindNomberByTag(Stantion)<>-1 then

          begin

          MessageDlg('Отказано в подключении рабочей станции с № '+inttostr(Stantion)+' '+#13+

                 'Рабочая станция № '+inttostr(Stantion)+' уже подключена к серверу.'+#13+

                  'Измените конфигурационный файл рабочей станции.', mtError, [mbOk], 0);

            exit;

            end;

         if FindNomberByTag(-Stantion)<>-1 then

          begin

            Re:=FindNomberByTag(-Stantion)

            end;

         AddAnAWorkPlace(Re,Stantion);

         ShowWorkPlases(-1);

         end;

end;

 

procedure TFmExamServer.SpeedButton6Click(Sender: TObject);

var nom:integer;

begin

if length(WorkPlaces)=0 then

begin

MessageDlg('Нет подключенных рабочих станций.'+#13+

        'Нельзя распечатать экзаменационный лист пока нет подключенных станций.', mtinformation,      [mbOk], 0);

   exit;

   end;

nom:=FindNomberByTag(strtoint(StringGrid1.Cells[0,StringGrid1.Row]));

if nom=-1 then nom:=FindNomberByTag(-strtoint(StringGrid1.Cells[0,StringGrid1.Row]));

if (WorkPlaces[nom].Status<>7) and (WorkPlaces[nom].Status<>4) and (WorkPlaces[nom].Status<>5) then

BEGIN

   MessageDlg('Экзамен не завершен, либо не был назначен.'+#13+

            'Нельзя распечатать экзаменационный лист для не завершенного, либо не назначенного экзамена.', mtinformation,      [mbOk], 0);

   exit;

   end;

RptExamList.PrintList(WorkPlaces[nom].ExamTeoryPK,true);

end;

 

procedure TFmExamServer.SpeedButton5Click(Sender: TObject);

begin

Form7.ShowModal;

end;

end.