Proyecto

General

Perfil

Descargar (8,81 KB) Estadísticas
| Rama: | Revisión:
unit main;

{$mode objfpc}{$H+}

interface

uses
unix, IniFiles, HTTPDefs,clrespuesta,Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, Buttons;

type

{ TfrmMain }

TfrmMain = class(TForm)
Image1: TImage;
lblPregunta: TLabel;
lblTiempo: TStaticText;
tmrCuestion: TTimer;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure tmrCuestionTimer(Sender: TObject);
procedure btnOpcionesClick(sender:TObject);
private
procedure CrearMemos;
procedure LeerConf(archivo: string);
function LeerIni(): boolean;
function ObtenerMiIp(): string;
function tiempo(value: integer): string;
{ private declarations }
public
procedure Finalizar;
{ public declarations }
end;

var
frmMain: TfrmMain;
lblOpciones:Array of Tlabel;
btnOpciones:Array of TButton;
f_contador:integer;
f_existe_custion:boolean;


implementation

uses global;
var
fInterface:string='eth0';
DIR_CUSTION:string='/tmp/aulalinex/recibidos_profesor/.cuestion.ini';
Const
DIR_CONF:string='/etc/aulalinex-red.conf';
procedure TfrmMain.FormCreate(Sender: TObject);
begin
try
//setbounds(0,0,screen.width,screen.height);
//lblpregunta.top:=round((lblpregunta.top* (screen.height / 600)));
//lblTiempo.top:=round((lblTiempo.top * (screen.height / 600)));
g_mihost:=ObtenerMiIp();
g_hostprofe:='192.168.0.254';

if FileExists(DIR_CONF) then LeerConf(DIR_CONF);
g_mihost:=ObtenerMiIp();
g_dirpersonal:=getenvironmentvariable('HOME');
g_usuario:=getenvironmentvariable('USER');
DIR_CUSTION:=g_dirpersonal+'/recibidos_profesor/.cuestion.ini'
except
WriteLn('No existe el archivo de configuración');
end
end;

procedure TfrmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
try
if FileExists(DIR_CUSTION)then DeleteFile(DIR_CUSTION);
except
//writeln('Error al eliminar archivo');
end;
end;

function TfrmMain.ObtenerMiIp():string;
const
ORDEN_IP:String='/sbin/ifconfig %s 2>> /dev/null| grep -oiE "([0-9]{1,3}\.){3}[0-9]{1,3}" | grep -v 255 | grep -v 127.0.0.1 2>> /dev/null';

var
i:integer;
orden:String;
mis_tarjetas:array[0..4] of String=('','eth0','wlan0','eth1','wlan1');
mip:String;
begin
mis_tarjetas[0]:=fInterface;
g_tarjeta_red:='';
mip:='';
for i:=0 to Length(mis_tarjetas)-1 do
begin
orden:=Format( ORDEN_IP,[ mis_tarjetas[i]]);
mip:=trim(HallarDatos(orden));
if (mip<>'') then
begin
g_tarjeta_red:= mis_tarjetas[i];
break;
end
end;
result:=mip
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
try
if not LeerIni() then close;
except
writeln('Error al cargar el archivo de la cuestión');
end;
end;

procedure TfrmMain.tmrCuestionTimer(Sender: TObject);
var
comando:string;
begin
f_contador:=f_contador-1;
lbltiempo.caption:=Tiempo(f_contador);
if f_contador = 0 then
begin
enabled:=false;
hide;
tmrCuestion.enabled:=false;
g_tiempoempleado:=g_tiempo-f_contador;
comando:='respuestaCuestion '+ HTTPEncode(g_mihost) +' '+HTTPEncode(g_Codigo)+' '+HTTPEncode('0')+' '+HTTPEncode(inttostr(g_tiempoempleado))+' '+HTTPEncode(g_usuario);

with ThrRespuesta.create(g_hostprofe,comando) do resume;
end;
end;

procedure Tfrmmain.Finalizar;
begin
close;
end;

function Tfrmmain.tiempo(value:integer):string;
var
minutos,segundos:string;
nsegundos:integer;
begin
minutos:='0'+inttostr(value div 60);
nsegundos:=value mod 60;
if value <10 then
segundos:='0'+inttostr(nsegundos)
else
segundos:=inttostr(nsegundos);
result:=minutos+':'+segundos;
end;
procedure Tfrmmain.LeerConf(archivo:string);
var
FicheroIni:TMemIniFile;
begin
try
FicheroIni:=TMemIniFile.create(archivo);
try
with FicheroIni do
begin
//g_hostprofe:=ReadString('Profesor','IP Profesor','192.168.0.254');
fInterface:=ReadString('Red','Interface','eth0');
end;
finally
FicheroIni.free;
end;
except
writeLn('Error al cargar datos');
end;
end;
Function Tfrmmain.LeerIni():boolean;
var
Mifichero:TMemIniFile;
i:integer;
begin
result:=false;
try
if FileExists(DIR_CUSTION) then
begin
Mifichero:= TMemIniFile.create(DIR_CUSTION);
try
with MiFichero do
begin
g_hostprofe:=ReadString('TIPO','Profesor','192.168.0.254');
g_codigo:=ReadString('TIPO','Codigo','');
g_tipoc:=ReadString('TIPO','Tipo','0');
g_tiempo:=ReadInteger('TIPO','Tiempo',30);
g_num_opciones:=ReadInteger('TIPO','Numero_Opciones',0);
if g_num_opciones>0 then
begin
setlength(g_opciones,g_num_opciones);
setlength(lblOpciones,g_num_opciones);
setlength(btnOpciones,g_num_opciones);
g_pregunta:=ReadString('CUESTION','Pregunta', '');
lblPregunta.caption:=HTTPDecode(g_pregunta);
for i:=0 to high(g_opciones) do
g_opciones[i]:=ReadString('CUESTION','Opcion_'+inttostr(i+1), '');
CrearMemos()
end;
end;
f_contador:=g_tiempo;
tmrCuestion.enabled:=true;
finally
Mifichero.free;
end;
result:=true;
end ;
except
result:=false;
end;
end;

procedure Tfrmmain.CrearMemos;
var i:integer;
begin
lblPregunta.font.size:=14;
for i:=0 to high(lblOpciones) do
begin
lblOpciones[i]:=Tlabel.Create(self);
btnOpciones[i]:=TButton.Create(self);
with btnOpciones[i] do
begin
font.name:='Sans';
font.size:=14;
width:=35;
height:=35;
cursor:=crHandPoint;
Caption:= intToStr(i+1);
Parent:=self;
tag:=i+1;
left:= lblpregunta.left-5;
top:= lblpregunta.top + lblpregunta.height + 30 + (i*(10+lblpregunta.height-10));
onClick:=@btnOpcionesClick;
end;
with lblOpciones[i] do
begin
font.name:='Sans';
font.size:=14;
width:=lblpregunta.width-btnOpciones[i].width-10;
height:=lblpregunta.height-10;
Parent:=self;
tag:=i+1;
left:= btnOpciones[i].left+btnOpciones[i].width+10;
top:= btnOpciones[i].top+5;
text:=HTTPDecode(g_opciones[i]);
end;
end;
end;

procedure Tfrmmain.btnOpcionesClick(sender:TObject);
var
respuesta:integer;
comando:string;
begin
try
application.ProcessMessages;
tmrCuestion.enabled:=false;
hide;
g_tiempoempleado:=g_tiempo-f_contador;
respuesta:=(sender as Tbutton).tag;
comando:='respuestaCuestion '+ HTTPEncode(g_mihost) +' '+HTTPEncode(g_Codigo)+' '+HTTPEncode(inttostr(respuesta))+' '+HTTPEncode(inttostr(g_tiempoempleado))+' '+HTTPEncode(g_usuario);
//writeln(comando);
with ThrRespuesta.create(g_hostprofe,comando) do resume;
//writeln('la ip del profesor '+g_hostprofe);
except
writeln('error al contestar ');
end;
end;
initialization
{$I main.lrs}

end.

(7-7/7)