uses Dos,Crt;
var
DirInfo: SearchRec;
FileName:Array [1..20] of String[20];
Cadena:Array [0..1150] of String [47];
Usuario:Array [0..255] Of String [17];
ConteoTotal:Integer;
Hora:Array [0..25] Of String [5];
Horario:Array [1..25] Of Integer;
Horarios,
NombreResultado,
TxtMin,TxtH:String;
HoraAux:String[3];
NumFileName,
NumCadena,
LugarA,
LugarB,
ContadorUsuario,
Coincidencias,NumUsuario:Integer;
i,N,S,f,
MaxNumControl01,
NumMaxCadena,
ErrorNum:Integer;
SaltodeLinea,
CapturarTexto,
CadenaCorrecta,
UsuarioIngresado,
IncluirCadena:Boolean;
NombreArchivo,
Result:Text;
AuxUsuario:String[17];
{Fecha} y, m, d, dow : Word;
Dia,
Mes,
Manana,
HoyEs,
MananaEs,
CreaNombre:String;
{Horarios} h, min, seg, hund, NDia : Word;
Procedure SepararUsuarios;
Begin
{Se crea un listado con los Usuarios, recorriendo las variables y encontrando las repetidas}
ContadorUsuario:=1;
For i:= 1 to NumMaxCadena Do
Begin
Usuario[Contadorusuario]:='';
LugarA:=Pos(' - ',Cadena[i]); LugarB:=Pos(': ',Cadena[i]); AuxUsuario:=Copy(Cadena[i], LugarA+3, LugarB-LugarA-3);
UsuarioIngresado:=False;
{Writeln(AuxUsuario);} {Verifica que el nuevo uauario no esta en la lista} For N:= 1 to ContadorUsuario Do
If Usuario[N]=AuxUsuario Then
UsuarioIngresado:=True;
{Si el usuario no esta entonces se toma un valor}
If Not UsuarioIngresado Then
Begin
Usuario[ContadorUsuario]:=AuxUsuario;
Inc(ContadorUsuario);
End;
End;{For} Dec(ContadorUsuario);
End;
Procedure ContarCoincidencias;
Begin
{Ya teniendo los usuarios (255 como maximo) se inicia el conteo las veces que se repite la coincidencia en todas las cadenas de texto}
Coincidencias:=0;
NumUsuario:=0;
For f:= 1 to 25 Do
Horario[f]:=0;
Horarios:='';
For N:= 1 To ContadorUsuario Do {Checa usuario por usuario (max 255)} Begin
IncluirCadena:=False;
For i:= 1 to NumMaxCadena Do {Recorre todo el contenido (max 1000)} Begin
{Writeln(Cadena[i]);} {LugarHora:=
AQUI VA A BUSCAR LA COINCIDENCIA DE LOS HORARIOS
DEPENDIENDO DEL HORARIO SE DEBEN INGRESAR TABULACIONES}
LugarA:=Pos(' - ',Cadena[i]); LugarB:=Pos(': ',Cadena[i]); AuxUsuario:=Copy(Cadena[i], LugarA+3, LugarB-LugarA-3);
If Usuario[N]=AuxUsuario Then
Begin
If Pos(HoyEs, Cadena[i]) > 0 Then
Begin
For F:= 1 to 18 Do
If Pos(Hora[F],Cadena[i])>0 Then
Begin
Inc(Horario[F]);
Inc(Coincidencias);
IncluirCadena:=True;
End;
End; {If HoyEs}
If Pos(MananaEs, Cadena[i]) > 0 Then
Begin
For F:= 19 to 25 Do
If Pos(Hora[F],Cadena[i])>0 Then
Begin
Inc(Horario[F]);
Inc(Coincidencias);
IncluirCadena:=True;
End;
End;{If MananaEs}
End;{If Usuario [N]} End; {For i}
ConteoTotal:=ConteoTotal+Coincidencias;
{ Writeln(Usuario[N],'------',Coincidencias);} If IncluirCadena Then {Se evita escriba registros vacios} Begin
For F:= 1 to 25 Do
Begin
Str(Horario[F],HoraAux);
If Horario[F] = 0 Then
HoraAux:='';
Horarios:=Horarios+'<td>'+HoraAux+'</td>';
End;
Inc(NumUsuario);
Writeln(Result,'<tr><td>',NumUsuario,'</td>',
'<td>',Usuario[N],'</td>',
'<td>',Coincidencias,'</td>',
Horarios,'</tr>');
End; {If IncluirCadena} Horarios:='';
Coincidencias:=0;
For f:= 1 to 25 Do
Horario[f]:=0;
End;{For N} End;{Procedure}
Procedure LeerArchivo(Nombre:String);
var
f : text;
ch: char;
Begin
SaltodeLinea:=False;
CadenaCorrecta:=False;
NumMaxcadena:=0;
{Leer archivo} Assign(F, Nombre);
Reset(F);
While not Eof(f) do
Begin
Read(F,Ch);
{Saber si el caracter ANTERIOR coincide con un "salto de linea", si es asi verificar que el siguiente caracter sea un numero
para dar pauta a que probablemente se trata de la hora y fecha}
If SaltodeLinea Then
If Ord(Ch) in [48..57] Then
Begin
Inc(NumCadena);
{ESTE CONTROL EVITA UN DESBORDAMIENTO DE VARIABLES} If NumCadena>1148 Then
Begin
Dec(NumCadena);
Writeln('ALERTA: Se ha sobrepasado el maximo de variables'); End;
NumMaxCadena:=NumCadena;
SaltodeLinea:=False;
CapturarTexto:=True;
End;
{Encontrar "salto de linea"} If Ord(Ch) in [10,13] Then
SaltodeLinea:=True;
{Si se detecto que el segundo caracter es numero se almacena en una variable cadena tipo arreglo}
If CapturarTexto And
Not (Ord(Ch) In [Ord(226),Ord(128),Ord(170),Ord(43),Ord(172)]) Then
Begin
Cadena[NumCadena]:=Cadena[NumCadena]+Ch;
End;
{Ahora tambien se verifica que contenga un separador de fecha en el segundo o tercer caracter por ejemplo 2/12/2017 o 12/12/2017, de lo contrario se continua con la misma variable}
If Length(Cadena[NumCadena]) = 6 Then
If ((Pos(HoyEs, Cadena[NumCadena]) > 0) Or
(Pos(MananaEs, Cadena[NumCadena]) > 0)) Then
CadenaCorrecta:=True
Else
Begin
CadenaCorrecta:=False;
CapturarTexto:=False;
Cadena[NumCadena]:='';
{ESTE CONTROL EVITA UN ERROR ALEATORIO "-1", FALTA DEPURAR} If NumCadena>0 Then
Dec(NumCadena);
{Writeln(Cadena[NumCadena],'--------',numcadena);} End;
{Si se considera que las pruebas han sido superadas se continua almacenando en una variable}
{ If CadenaCorrecta Then Writeln(Cadena[NumCadena],'--------',numcadena);}
end;
Close(F);
End;{Procedure}
Procedure FijarHorarios;
Begin
Hora[1] :='8 06:';
Hora[2] :='8 07:';
Hora[3] :='8 08:';
Hora[4] :='8 09:';
Hora[5] :='8 10:';
Hora[6] :='8 11:';
Hora[7] :='8 12:';
Hora[8] :='8 13:';
Hora[9] :='8 14:';
Hora[10]:='8 15:';
Hora[11]:='8 16:';
Hora[12]:='8 17:';
Hora[13]:='8 18:';
Hora[14]:='8 19:';
Hora[15]:='8 20:';
Hora[16]:='8 21:';
Hora[17]:='8 22:';
Hora[18]:='8 23:';
Hora[19]:='8 00:';
Hora[20]:='8 01:';
Hora[21]:='8 02:';
Hora[22]:='8 03:';
Hora[23]:='8 04:';
Hora[24]:='8 05:';
Hora[25]:='8 06:';
End;
Function CrearNombre:String;
Begin
If Length (Mes)= 1 Then Mes:='0' + Mes;
If Length (Dia)= 1 Then Dia:='0' + Dia;
Str(H,TxtH);
Str(Min,TxtMin);
If Length (TxtH)= 1 Then TxtH:='0' + TxtH;
If Length (TxtMin)= 1 Then TxtMin:='0' + TxtMin;
CreaNombre:=Concat(Mes,Dia,TxtH,TxtMin,'.HTML');
End;
function IntToStr(i: Longint): string;
{ Convert any Integer type to a string } var
s: string[11];
begin
Str(i, s);
IntToStr := s;
end;
Begin
ClrScr;
GetDate(y,m,d,dow);
GetTime(h,min,seg,hund);
{WriteLn(h,':',min);} {WriteLn('Today is ',m:0, '/', d:0, '/', y);} Writeln('Contador de eventos para Chats de Whatsapp'); Writeln('Correo tusdatosaqui@gmail.com'); Writeln;
Writeln('Escribe el numero del dia a procesar y oprime ENVIAR default( HOY ES ',d,')'); Readln(Dia);
If Dia<>'' Then
Begin
Val(Dia,NDia,ErrorNum);
{ Error during conversion to Integer? } if ErrorNum <> 0 then
WriteLn('Escriba un numero del 1 al 31') Else
Begin
Str(NDia,Dia);
Str(NDia+1,Manana);
End;
End
Else
Begin
Str(d,Dia);
Str(d+1,Manana);
WriteLn('...Dia: ',Dia); WriteLn;
End;
Str(m,Mes);
HoyEs :=Concat(Mes, '/', Dia, '/');
MananaEs:=Concat(Mes, '/', Manana, '/');
Write;
Write('Escribe el nombre del archivo resultante y oprime ENVIAR (default "MES+DIA.Htm")'); NombreResultado:='';
Readln(NombreResultado);
If NombreResultado='' Then
Begin
If Length (Mes)= 1 Then Mes:='0' + Mes;
If Length (Dia)= 1 Then Dia:='0' + Dia;
Str(H,TxtH);
Str(Min,TxtMin);
If Length (TxtH)= 1 Then TxtH:='0' + TxtH;
If Length (TxtMin)= 1 Then TxtMin:='0' + TxtMin;
NombreResultado:=Concat(Mes,Dia,TxtH,TxtMin,'.HTM');
Write('...Nombre del archivo: ',NombreResultado); WriteLn;
End
Else
NombreResultado:=NombreResultado+'.htm';
WriteLn;
WriteLn('--------------------------------------------------------------'); If y <> 2018 Then
Begin
Writeln('Actualice el Programa... Whatsapp 5215541491959 o tusdatosaqui@gmail.com'); halt(0);
End;
FijarHorarios;
NumFileName:=0;
FindFirst('*.txt', Archive, DirInfo); while DosError = 0 do
begin
{WriteLn(DirInfo.Name);} Inc(NumFileName);
Filename[NumFileName]:=DirInfo.Name;
FindNext(DirInfo);
end;
MaxNumControl01:=NumFileName;
Assign(Result,NombreResultado);
Rewrite(Result);
Append(Result);
For S:= 1 to MaxNumControl01 Do
Begin
ConteoTotal:=0; {Procedure ContarCoincidencias} Writeln('Trabajando en Archivo: ',FileName[S]); Writeln('fecha: ',HoyEs,'2017'); Writeln('horario de corte: ',h,':',min,' horas'); Writeln;
Writeln(Result,'<Br>');
Writeln(Result,'<Br>');
Writeln(Result,'<Br>');
Writeln(Result,'<Br>');
Writeln(Result,'Conteo de reportes de Grupo "',FileName[S],'"<Br>');
Writeln(Result,'Fecha: ',HoyEs,'2017 <Br>');
Writeln(Result,'Cierre del conteo: ',h,':',min,' horas <Br>');
Writeln(Result,'<Table Border="1" CellPadding="0" CellSpacing="0" Width="35%">');
Writeln(Result,'<tr><td>-#-</td><td>xxxxxxxxxxUsuarioxxxxxxxxxx</td><td>Registros</td><td>06:00</td>',
'<td>07:00</td><td>08:00</td>',
'<td>09:00</td><td>10:00</td><td>11:00</td><td>12:00</td><td>13:00</td>',
'<td>14:00</td><td>15:00</td><td>16:00</td><td>17:00</td><td>18:00</td>',
'<td>19:00</td><td>20:00</td><td>21:00</td><td>22:00</td><td>23:00</td>',
'<td>00:00</td><td>01:00</td><td>02:00</td><td>03:00</td><td>04:00</td>',
'<td>05:00</td><td>06:00</td></tr>');
For i:= 0 to 1000 Do
Cadena[i]:='';
NumCadena:=0;
LeerArchivo(FileName[S]);
SepararUsuarios;
ContarCoincidencias;
Writeln(Result,'</Table><Br><H2>Registros:',IntToStr(ConteoTotal),'</H2>');
End;
Close(Result);
ConteoTotal:=0;{Procedure ContarCoincidencias} end.
