El código está escrito en Object Pascal con Lazarus y fue probado en Linux. En principio no debería ningún problema por compilarlo en Windows (u otro SO), pero por razones obvias que luego verás se hizo en Linux.
El programa: FTerraChat
Pues digamos que el programa lo único que hacía era dar formato a la conversación UDP (o TCP, I don't remember) generada entre el cliente de IRC de Terra y los servidores de IRCHispano. Nada más complicado, excepto para los que les ha sonado a chino la anterior oración XD.
Intentando explicarlo de forma más sencilla: Cuando alguien entra al chat de Terra, los textos enviados y recibidos tenían el siguiente formato:
:ALADIN!la641hm@BA5L1y.CWhlKX.virtual PRIVMSG PARDILLO:Me tengo que ir :Marymar_5!la641hm@B6fxQ3.DRMh13.virtual JOIN :#mas_de_40 :JOVENXMADURA_MADRID!mDc@BU9aIM.AEIp50.virtual NICK :zorra50 :invitado-337326!6A0B@DbBIXG.D2wdID.virtual JOIN :#mas_de_40 :invitado-633896!d@CQzhbI.AgXaWl.virtual NICK :Antonio_ :luz38!ce7g@BA5L1y.AH03TI.virtual PRIVMSG #mas_de_40 :hola hola, alguien de castellon :BecquerParis!s@BR7GQQ.CWhlKX.virtual PRIVMSG #mas_de_40 :alguien que le guste la poesia,romanticismo y paris?privados PRIVMSG ALADIN :adios :maria47!c7@Bzlt96.AH4dq0.virtual QUIT :Terra Chat
Ough, no proguntéis de cuando ni de quién lo he sacado... y el cómo... es tema aparte e interesante, porque obviamente no es mío ;-D. Entonces localizando esa conversación es un coñazo intentar seguirla si que me hice el programita para que limpiara un poquito y separara los canales abiertos (y privados >:-Q ) dejándolo:
#mas_de_40
<luz38> hola hola, alguien de castellon
<BecquerParis> alguien que le guste la poesia,romanticismo y paris?privados
----- -----
ALADIN
<ALADIN> Me tengo que ir
<PARDILLO> AdiosQue a pesar de posibles simbolillos para colores, puto analfabetismo en general y demás mariconadas, es más legible a gran escala. PARDILLO es el nombre para referirse a la persona que estaba a este lado del chat. El programa también tenía previsto poder manejar otros evento si es necesario como entradas, salidas, cambios de nick, etc; pero en verdad tan solo era reñadir morralla al asunto.
El código
program FChatTerraExe;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, strutils
{ you can add units after this };
const
Espacio = 25;
NPardillo = '<PARDILLO>';
type
{ TFChatTerra }
TFChatTerra = class(TCustomApplication)
private
Canales: array of TStringList;
function GetCanal(Nombre: UTF8String): TStringList;
protected
property Canal[Nombre:UTF8String]: TStringList read GetCanal;
procedure DoRun; override;
public
procedure WriteHelp; virtual;
procedure ProcesarLinea(aLinea: UTF8String);
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
{ TFChatTerra }
function TFChatTerra.GetCanal(Nombre: UTF8String): TStringList;
var
i: Integer;
NCanales: Integer;
begin
Result := nil;
NCanales := Length(Canales);
i := 0;
while (i < NCanales) and (Result = nil) do
begin
if Canales[i] <> nil then
begin
if Canales[i][0] = Nombre then
Result := Canales[i];
end;
Inc(i);
end;
if Result = nil then
begin
SetLength(Canales, NCanales + 1);
Canales[NCanales]:= TStringList.Create;
Canales[NCanales].Add(Nombre);
Canales[NCanales].Add('');
Result := Canales[NCanales];
end;
end;
procedure TFChatTerra.DoRun;
var
ErrorMsg: String;
ChatFile: TStringList;
i: Integer;
Fecha: TDateTime;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if (HasOption('h','help')) or (Params[1]= '') then begin
WriteHelp;
Terminate;
Exit;
end;
if not FileExists(Params[1]) then
begin
WriteLn('No se ha encontrado el archivo: ' + Params[1]);
Terminate;
Exit;
end;
// TODO 2: ¿Cómo se envían las multilíneas?
ChatFile := TStringList.Create;
try
ChatFile.LoadFromFile(Params[1]);
i:=0;
while i < ChatFile.Count do
begin
ProcesarLinea(ChatFile[i]);
Inc(i);
end;
finally
FreeAndNil(ChatFile);
end;
ChatFile := TStringList.Create;
try
i:=0;
while i < Length(Canales) do
begin
ChatFile.AddStrings(Canales[i]);
ChatFile.Add('');
ChatFile.Add('----- -----');
ChatFile.Add('');
Inc(i);
end;
finally
Fecha := FileDateToDateTime(FileAge(Params[1]));
ChatFile.SaveToFile(ExtractFilePath(Params[1]) +
FormatDateTime('yyyymmddhhnnss', Fecha) + ' - Terra.txt');
FreeAndNil(ChatFile);
end;
// stop program loop
Terminate;
end;
constructor TFChatTerra.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TFChatTerra.Destroy;
begin
inherited Destroy;
end;
procedure TFChatTerra.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
procedure TFChatTerra.ProcesarLinea(aLinea: UTF8String);
procedure DoPRIVMSG(aNick, aCanal, aMensaje: UTF8String);
var
CurCanal: TStringList;
begin
// ¿Es un mensaje privado al pardillo?
// Si es así el canal es el nick que envía el mensaje
if (aCanal[1] <> '#') and (aNick <> NPardillo) then
aCanal := aNick;
CurCanal := GetCanal(aCanal);
CurCanal.Add(RightStr(DupeString(' ', Espacio) + '<' + aNick + '> ', Espacio)
+ aMensaje);
end;
procedure DoQUIT(aNick, aCanal, aMensaje: UTF8String);
var
i: Integer;
CurCanal: TStringList;
NCanales: Integer;
begin
// TODO 2: Añadir un parametro para añadir esta info
Exit;
{
i := 0;
NCanales := Length(Canales);
while (i < NCanales) do
begin
CurCanal := Canales[i];
if CurCanal <> nil then
if CurCanal[0][1] = '#' then
CurCanal.Add(DupeString(' ', Espacio) + '<== QUIT <== ' + aNick +
' (' + aMensaje + ')');
Inc(i);
end;
}
end;
procedure DoPART(aNick, aCanal, aMensaje: UTF8String);
var
CurCanal: TStringList;
begin
// TODO 2: Añadir un parametro para añadir esta info
Exit;
{
if aCanal[1] <> '#' then
aCanal := '#' + aNick;
CurCanal := GetCanal(aCanal);
CurCanal.Add(DupeString(' ', Espacio) + '<-- PART ' + aNick + ' (' + aMensaje + ')');
}
end;
procedure DoJOIN(aNick, aCanal, aMensaje: UTF8String);
var
CurCanal: TStringList;
begin
// TODO 2: Añadir un parametro para añadir esta info
Exit;
{
// El JOIN no tiene canal, pero lo indica en el mensaje
if aMensaje[1] <> '#' then
aMensaje := '#' + aMensaje;
CurCanal := GetCanal(aMensaje);
CurCanal.Add(DupeString(' ', Espacio) + '==> JOIN ' + aNick + ' (' + aMensaje + ')');
}
end;
procedure DoPING(aNick, aCanal, aMensaje: UTF8String);
begin
// Por el momento lo ignoramos
Exit;
end;
procedure DoPONG(aNick, aCanal, aMensaje: UTF8String);
begin
// Por el momento lo ignoramos
Exit;
end;
procedure DoMODE(aNick, aCanal, aMensaje: UTF8String);
begin
// Ignoramos los baneos y cambios de modo, no interesan por el momento
Exit;
end;
procedure DoKICK(aNick, aCanal, aMensaje: UTF8String);
begin
// Ignoramos los kick, no interesan por el momento
Exit;
end;
procedure DoNICK(aNick, aCanal, aMensaje: UTF8String);
begin
// También ignoramos los cambios de nick...
Exit;
end;
procedure DoACTION(aNick, aAccion, aCanal, aMensaje: UTF8String);
var
i: Integer;
CurCanal: TStringList;
NCanales: Integer;
begin
if aCanal = '' then
begin
i := 0;
NCanales := Length(Canales);
while (i < NCanales) do
begin
CurCanal := Canales[i];
if CurCanal <> nil then
if CurCanal[0][1] = '#' then
CurCanal.Add('[' + aAccion + '] ' + aNick + ' (' + aMensaje + ')');
Inc(i);
end;
end
else
begin
if aCanal[1] <> '#' then
aCanal := '#' + aNick;
CurCanal := GetCanal(aCanal);
CurCanal.Add('[' + aAccion + '] ' + aNick + ' (' + aMensaje + ')');
end;
end;
var
aPos: Integer;
aNick: UTF8String;
aAccion: UTF8String;
aCanal: UTF8String;
aMensaje: UTF8String;
begin
// YEEEEP!!! Los mensajes a los canales se realizan con private message
// (PRIVMSG) peeeero los canales tienen # y los privados de verdad no.
// Esto me hace la tarea algo más fácil...
if aLinea[1] = ':' then
begin // Es un mensaje normal...
aLinea := Copy(aLinea, 2, MaxInt);
// NICK
// No creo que necesite el !blah@blah.blah
// Aunque... vendría perfecto para los cambios de nombre o
// cuando uno sale y entra on otro nick.
aNick := Copy(aLinea, 1, Pos('!', aLinea) - 1);
aLinea := Copy(aLinea, Pos(' ', aLinea) + 1, MaxInt);
end;
// ACCION
aAccion := Copy(aLinea, 1, Pos(' ', aLinea) - 1);
aLinea := Copy(aLinea, Pos(' ', aLinea) + 1, MaxInt);
// CANAL
if aLinea[1] = ':' then
begin
// Algunas acciones no tienen Canal -> ':nick!bla@bla QUIT :Terra Chat'
aCanal := '';
aLinea := Copy(aLinea, 2, MaxInt);
end
else
begin
// Algunas acciones no tienen mensaje: ':nick!bla@bla PART #canal'
aPos := Pos(' :', aLinea);
if aPos = 0 then
begin
aCanal := Copy(aLinea, 1, MaxInt);
aLinea := ''
end
else
aCanal := Copy(aLinea, 1, aPos - 1);
aLinea := Copy(aLinea, aPos + 2, MaxInt);
end;
// MENSAJE
// (Podía haberlo puesto dónde el canal pero así queda más ordenado)
aMensaje := aLinea;
if aNick = '' then
aNick := NPardillo;
if aAccion = 'PRIVMSG' then DoPRIVMSG(aNick, aCanal, aMensaje)
else if aAccion = 'QUIT' then DoQUIT(aNick, aCanal, aMensaje)
else if aAccion = 'PART' then DoPART(aNick, aCanal, aMensaje)
else if aAccion = 'JOIN' then DoJOIN(aNick, aCanal, aMensaje)
else if aAccion = 'PING' then DoPING(aNick, aCanal, aMensaje)
else if aAccion = 'PONG' then DoPONG(aNick, aCanal, aMensaje)
else if aAccion = 'MODE' then DoMODE(aNick, aCanal, aMensaje)
else if aAccion = 'NICK' then DoNICK(aNick, aCanal, aMensaje)
else if aAccion = 'KICK' then DoKICK(aNick, aCanal, aMensaje)
else DoACTION(aNick, aAccion, aCanal, aMensaje);
end;
var
Application: TFChatTerra;
{$IFDEF WINDOWS}{$R FChatTerraExe.rc}{$ENDIF}
begin
Application:=TFChatTerra.Create(nil);
Application.Title:='FChatTerra';
Application.Run;
Application.Free;
end.
Posibilidad de actualización
Puede que algún día me entretenga, analizando el nuevo formato y adapte el programa en consecuencia; ya que no es tan difícil de entender aunque esté algo ofuscado.
No hay comentarios:
Publicar un comentario