Tuesday, 23 December 2008

Instalar un componente de traducción para los componentes de DevExpress

Desde la web de jp-software, podemos encontrar unos Addons gratuitos de traducción para los componentes de DevExpress.
En este caso instalaré el componente cxIntl6 (para la versión 6 de los componentes), y fichero de traducción al español.
En los siguientes links, podemos descargarnos el cxIntl6, y la traducción al español.
También en esta página podéis encontrar la traducción que hice al catalán de la versión 5.
Primero, creamos un nuevo Package desde Delphi, y añadimos los ficheros que hay dentro de cxIntl6:



Luego Compilamos, buildeamos y instalamos el paquete.

En la paleta de componentes, luego encontraremos el siguiente componente:



Una vez insertamos el componente en nuestra grid, cargamos el fichero de traducción desde el mismo componente:



Luego, configuramos las propiedades del componente, para que quede habilitada la traducción para los diferentes componentes.



Ahora cuando arranquemos nuestra aplicación saldrá totalmente traducida al español.

Friday, 19 December 2008

Verificar si una IP es correcta

Para verificar si una IP es correcta, he creado una pequeña función que comprueba como esta escrita la IP.

Si tenemos la IP : 89.45.34.80
Primero compruebo que la longitud del texto no sea menor de 7 caracteres o mayor de 15:

X.X.X.X
XXX.XXX.XXX.XXX

Luego busco la posición de los puntos y la guardo en un pequeño array.
Compruebo que la posición de los puntos sea la correcta. Las posibilidades de la posición del punto son:

X. (Pos = 2)
XX. (Pos = 3)
XXX. (Pos = 4)

Estas posiciones son relativas a cada byte de la IP.

Por último, recorto cada byte según la posición relativa del punto y compruebo el valor de cada byte. Para el primer byte los valores posibles van de 1 a 223 y para los siguientes bytes de 0 a 255.

Aquí os dejo el código. (Fletaría implementar el de la máscara que lo único que hay que cambiar es que el primer byte también puede ir de 0 a 255).
Seguro que hay mejores maneras de implementarla, pero las que he visto por ahí dependían de alguna API.



function EsIpCorrecta(ip: string): Boolean;
var
ContarCaracter, i, j, iCount, ipValor, iCorte: integer;
ipSector: array[1..3] of byte;
bIpBuena, bFallo: boolean;
sValor: string;
begin
bIpBuena := false;
if (Length(ip) > 15) or (Length(ip) < 7) then //X.X.X.X o XXX.XXX.XXX.XXX
begin
result := bIpBuena;
exit;
end;

for i := 1 to 3 do
ipSector[i] := 0;
ContarCaracter := 0;
bFallo := false;
i := 1;
j := 1;
while (not bFallo) and (i <= Length(ip)) do
begin
if not (ip[i] in ['0'..'9']) then
begin
if ip[i] = '.' then
begin
inc(ContarCaracter);
if ContarCaracter < 4 then
begin
ipSector[ContarCaracter] := j;
j := 1;
end
else
bFallo := true;
end
else
bFallo := true;
end
else
inc(j);
inc(i);
end;

if (ContarCaracter <> 3) or bFallo then
begin
result := bIpBuena;
exit;
end;

for i := 1 to 3 do //X. XX. XXX.
if (ipSector[i] < 1) or (ipSector[i] > 4) then
begin
result := bIpBuena;
exit;
end;

iCorte := 0;
iCount := 0;
i := 1;
while (not bFallo) and (i <= 4) do
begin
if i <> 4 then
iCount := ipSector[i]
else
iCount := Length(ip) - iCorte + 1;
sValor := AnsiLeftStr(AnsiRightStr(ip, Length(ip) - iCorte), iCount - 1);
ipValor := StrToInt(sValor);
if i = 1 then
begin
if (ipValor > 223) or (ipValor = 0) then //Primer valor de 1 a 223
bFallo := true;
end
else if (ipValor > 255) then //Otros valores de 0 a 255
bFallo := true;
iCorte := iCorte + Length(sValor) + 1;
inc(i);
end;

bIpBuena := not bFallo;
result := bIpBuena;
end;

Capturar la salida del Debug con OutputDebugString

OutputDebugString() es una API del SO, que permite a tu aplicación hablar con el Debugger. Desde Delphi, cuando generamos un error en el IDE, este empieza ha hacer llamadas al Debugger, enviando un String con la información del error que se esta generando. Son los típicos errores o warnings que aparecen en la ventana de Messages.

En este caso, por ejemplo:



En la línea del uses, he añadido un uses que no existe. El delphi lo detecta como muestro en la ventana de la izquierda, y esto hace que el IDE empieze a lanzar errores. Estos errores se lanzan a través del Kernel o a través de Win32, y pueden ser capturados.

Como es de esperar, como que esta función es del windows, microsoft tiene una pequeña herramienta que es capaz de capturar estos mensajes con una aplicación que se llama DebugView. Esta aplicación la podeis encontrar aquí.

Con el delphi, podemos generar llamadas de este tipo. Aquí os dejo un ejemplo muy sencillo:





procedure TForm1.Button1Click(Sender: TObject);
function FormataFecha(aDateTime: TDateTime): string;
begin
Result := FormatDateTime('dd.mm.yy hh:nn:ss zzz', aDateTime);
end;
var
StartDT : TDatetime;
begin
StartDT := Now;
OutputDebugString(PChar(Format('[%s][%s] %s',
['Funcion', FormataFecha(StartDT),'texto prueba evento Button1Click'])));
end;



Desde el Event Log del Delphi, podemos ver la salida del mensaje que hemos generado:



Con el DebugView, podemos ver la verbose que genera el IDE del Delphi, i capturarlo con la herramienta:



Thursday, 18 December 2008

Trabajando con XML-RPC en Delphi


Para trabajar con esta librería hecha por UserLand Software, y podéis encontrar la especificación de la librería en esta web: www.xmlrpc.com
  • Que és XML-RPC?
Tal como se define en la Wikipedia, el XML-RPC, es un protocolo de llamada a procedimiento remoto que usa XML para codificar los datos y HTTP como protocolo de transmisión de mensajes. En la web de UserLand, podemos encontrar el protocolo escrito en diferentes lenguajes. El proyecto para delphi, lo podemos encontrar en SourceForge : delphixml-rpc.

  • Se utiliza el XML-RPC?
Aquí os dejo un claro ejemplo de su utilización en Second Life. Donde Utilizan un Servidor XML-RPC, para enviar los datos de la Web en PHP y mediante el servidor RPC al Second Life.









  • Implementación en Delphi.
Su implementación es bastante sencilla. Una vez nos hemos descargado los ficheros del proyecto, los añadimos a nuestro proyecto:

Dentro de la misma carpeta, nos vienen pequeños ejemplos de como hacer las llamadas y como responder a estas. Un ejemplo básico enviando un pequeño string, es el siguiente:

  • Desde el lado del Cliente:
uses XmlRpcTypes, XmlRpcClient; //uses necesarios

procedure TForm1.FormCreate(Sender: TObject);
begin
  FRpcFunction := TRpcFunction.Create;
  FRpcCaller := TRpcCaller.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FRpcCaller.Free;
  FRpcFunction := nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  RpcResult: IRpcResult;
begin
  FRpcCaller.HostName := Host; //Ip del Servidor RPC (XXX.XXX.XXX.XXX) o la local (localhost)
  FRpcCaller.HostPort := Port; //Puerto 8080
  FRpcCaller.EndPoint := '/RPC2'; //Punto final del XML

  FRpcFunction.Clear;
  FRpcFunction.ObjectMethod := 'ObtenerLLamada';
  FRpcFunction.AddItem(ebMessage.Text);
  Log('Iniciando Llamada');

  try
    RpcResult := FRpcCaller.Execute(FRpcFunction);
    if RpcResult.IsError then
      Log(Format('Error: (%d) %s', [RpcResult.ErrorCode, RpcResult.ErrorMsg]))
    else
      AddMessage(RpcResult.AsString);
  except
    on E: Exception do
      Log(StringReplace(E.Message, #13#10, ': ', [rfReplaceAll]));
  end;
end;
  • Desde el lado del Servidor:
uses SyncObjs, XmlRpcServer, XmlRpcTypes; //Uses necesarios

procedure TForm1.FormCreate(Sender: TObject);
begin
  FCriticalSection := TCriticalSection.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FCriticalSection.Free;
  FRpcServer.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Assigned(FRpcServer) then
    FRpcServer := TRpcServer.Create;
  if not FRpcServer.Active then
  begin
    FRpcServer.ListenPort := Port; //Puerto donde escuchar 8080
    if not Assigned(FRpcMethodHandler) then
    begin
      FRpcMethodHandler := TRpcMethodHandler.Create;
      try
        FRpcMethodHandler.Name := 'ObtenerLLamada';
        FRpcMethodHandler.Method := CallMethod;
        FRpcServer.RegisterMethodHandler(FRpcMethodHandler);
        FRpcMethodHandler := nil;
      finally
        FRpcMethodHandler.Free;
      end;
    end;
    FRpcServer.Active := True;
    Button1.Caption := 'Stop Server';
    FMessage := 'xml-rpc server has been started';
    AddLog;
  end
  else
  begin
    FRpcServer.Active := False;
    Button1.Caption := 'Start Server';
    FMessage := 'xml-rpc server has been stopped';
    AddLog;
  end;
end;

procedure TForm1.CallMethod(Thread: TRpcThread; const MethodName: string;
    List: TList; Return: TRpcReturn);
var
  Msg: string;
begin
  Msg := TRpcParameter(List[0]).AsString; //Mensaje obtenido
  Return.AddItem('Has enviado ' + Msg); //Devolvemos el mensaje
  FCriticalSection.Enter; //Sincronizamos los logs
  try
    FMessage := IntToStr(GetCurrentThreadId) + ' ' + Msg;
    Thread.Synchronize(AddLog);
  finally
    FCriticalSection.Leave;
  end;
end;


El ejemplo lo podemos ver aquí:



También os podeis descargar los ejemplos compilados aquí.

Tuesday, 16 December 2008

"H2443 Inline function 'DeleteFile' has not been expanded because unit 'Windows' is not specified in USES list"

Para que desaparezca este Hint del Delphi, solo hay cambiar un par de cosas en el uses del fichero .pas.

Cuando hacemos:

        if FileExists(sArchivo) then
DeleteFile(sArchivo);


Y solo tenemos en el uses la llamada a SysUtils, nos aparece el siguiente mensaje:

"H2443 Inline function 'DeleteFile' has not been expanded because unit 'Windows' is not specified in USES list"

Si luego añadimos la llamada Windows en el uses, nos aparecerá el siguiente error:

"[DCC Error] fichero.pas(123): E2010 Incompatible types: 'string' and 'PAnsiChar'".

Para solucionar esto, hay que colocar la llamada de Windows antes del SysUtils. Es una mala solución ya que fuerza a que tengamos que añadir la llamada de Windows a nuestro uses, pero supongo que los de Codegear ya sacarán alguna historia para solucionarlo.

Por lo tanto, hay que dejar el uses de la siguiente manera:

uses Windows, SysUtils, ...

Visualizar siempre la última línea añadida en un TMemo o TRichEdit

Para que al añadir líneas en un TMemo o TRichEdit siempre muestre la última línea, hay que llamar al método del Scroll del componente.



Lo podemos hacer con una de las siguientes maneras:



procedure TForm1.Button2Click(Sender: TObject);
begin
RichEdit1.Lines.Add(DateTimeToStr(now) + ' ' + 'Mensaje de prueba');
SendMessage(RichEdit1.Handle, EM_SCROLL, SB_LINEDOWN, 0);
end;

O de estra otra manera:

procedure TForm1.Button2Click(Sender: TObject);
begin
RichEdit1.Lines.Add(DateTimeToStr(now) + ' ' + 'Mensaje de prueba');
RichEdit1.Perform( EM_SCROLL, SB_LINEDOWN, 0);
end;

Sunday, 14 December 2008

Obtener la dirección IP de una máquina con Delphi 2009

Para obtener la IP de un PC, así como su nombre de Host, hay un pequeño método muy útil que nos puede servir para esto:




type
Names = array[0..100] of AnsiChar;
PName = ^Names;


function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
var
HEnt: pHostEnt;
HName: PName;
WSAData: TWSAData;
i: Integer;
begin
Result := False;
if WSAStartup($0101, WSAData) <> 0 then
begin
WSAErr := 'Winsock is not responding."';
Exit;
end;
IPaddr := '';
New(HName);
if GetHostName(HName^, SizeOf(Names)) = 0 then
begin
HostName := StrPas(HName^);
HEnt := GetHostByName(HName^);
for i := 0 to HEnt^.h_length - 1 do
IPaddr :=
Concat(IPaddr,
IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.');
SetLength(IPaddr, Length(IPaddr) - 1);
Result := True;
end
else
begin
case WSAGetLastError of
WSANOTINITIALISED: WSAErr := 'WSANotInitialised';
WSAENETDOWN: WSAErr := 'WSAENetDown';
WSAEINPROGRESS: WSAErr := 'WSAEInProgress';
end;
end;
Dispose(HName);
WSACleanup;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
HostName, IPAddr, Err: string;
begin
GetIPFromHost(HostName, IPAddr, Err);
end;




En la aplicación del post anterior : Creando una pequeña herramienta de xat, utilizo este método para obtener la IP de la máquina donde arranca el host.
El método da un pequeño warning por conversiones implícitas por todo el tema del unicode del delphi 2009. Tengo que arreglarlo, una vez lo tenga lo subo.

Creando una pequeña herramienta de xat con Indy 10 y Delphi 2009

Después de unos días sin postear nada, vengo un un pequeño programa que hice hace un par de días, con el que mediante los componentes de Indy 10 (idTCPClient y idTCPServer) creo una comunicación bidireccional mediante una dirección IP y un puerto.

La aplicación tiene el siguiente aspecto:



El código fuente para hacer funcionar los 2 componentes enviando un String, es el siguiente:



procedure TForm1.Button1Click(Sender: TObject);
var
Bindings: TIdSocketHandles;
begin
Bindings := TIdSocketHandles.Create(IdTCPServer1);
try
with Bindings.Add do
begin
IP := DefaultServerIP.text;
Port := StrToInt(DefaultServerPort.text);
end;
try
IdTCPServer1.Bindings := Bindings;
IdTCPServer1.Active := True;
Log('Server Iniciado en ' + DefaultServerIP.text);
Log('Esperando comunicación cliente...');
except on E: Exception do
ShowMessage(E.Message);
end;
finally
Bindings.Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
IdTCPClient1.Host := IPRemota.text;
IdTCPClient1.Port := StrToInt(PuertoRemoto.text);
try
IdTCPClient1.Connect;
except
raise exception.Create('Error');
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
try
if IdTCPClient1.Connected then
IdTCPClient1.Disconnect;
except
on E: Exception do
//nothing
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
timer.enabled := true;
end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
if key = chr(13) then
Button4Click(Sender);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Button3Click(sender);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
HostName, IPAddr, Err: string;
begin
Memo1.Clear;
Richedit1.Clear;
GetIPFromHost(HostName, IPAddr, Err);
DefaultServerIP.text := IPAddr;
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
Log('Conectado al Servidor ' + DefaultServerIP.text + ':' + DefaultServerPort.text);
end;

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
Log('Desconectado del Servidor' + DefaultServerIP.text + ':' + DefaultServerPort.text);
end;

procedure TForm1.Log(s: string);
begin
Memo1.Lines.Add(DateTimeToStr(now) + ' ' + s);
end;

procedure TForm1.TimerTimer(Sender: TObject);
var
sCommand: string;
size : integer;
begin
if not IdTCPClient1.Connected then
Exit;

IdTCPClient1.Socket.WriteLn('PuedoEnviar?');
Log('Enviando petición al servidor');
sCommand := IdTCPClient1.IOHandler.ReadLn;
if sCommand = 'Enviame' then
begin
IdTCPClient1.IOHandler.WriteBufferOpen;
size := Length(Edit2.text) * SizeOf(Char);
IdTCPClient1.IOHandler.Write(Integer(Length(Edit2.text)));
IdTCPClient1.IOHandler.Write(Edit2.text);
IdTCPClient1.IOHandler.WriteBufferClose;
IdTCPClient1.IOHandler.ReadLn;
RIchEdit1.SelStart := RIchEdit1.GetTextLen;
RIchEdit1.SelText := DateTimeToStr(now) + ' - ' + Edit2.text + #13#10;
RichEdit1.SelStart := RichEdit1.Perform(EM_LINEINDEX, richedit1.Lines.Count -1, 0);
Log('Tamaño paquete enviado ' + Inttostr(size) + ' bytes');
end;
timer.enabled := false;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
Log('Connectado a : ' + AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port));
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
Log('Desconectado de : ' + AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port));
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
Command: string;
Size: integer;
textoRecibido: string;
begin
if AContext.Connection.Connected then
begin
Command := '';
Command := AContext.Connection.Socket.ReadLn;
if Command = 'PuedoEnviar?' then
begin
AContext.Connection.IOHandler.WriteLn('Enviame');
Size := AContext.Connection.IOHandler.ReadLongInt(true);
textoRecibido := AContext.Connection.IOHandler.ReadString(Size);
AContext.Connection.IOHandler.WriteLn('Enviado');
Log('Tamaño paquete recibido ' + Inttostr(2*size) + ' bytes');
RIchEdit1.SelStart := RIchEdit1.GetTextLen;
RIchEdit1.SelAttributes.Style := [fsBold];
RIchEdit1.SelAttributes.Color := clRed;
RIchEdit1.SelText := DateTimeToStr(now) + ' - ' + textoRecibido + #13#10;
RichEdit1.SelStart := RichEdit1.Perform(EM_LINEINDEX, richedit1.Lines.Count -1, 0);
end;
end;
end;

procedure TForm1.IdTCPServer1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
Memo1.Lines.Add('Status : ' + AStatusText);
end;



Podeis encontrar el ejemplo de la aplicación aquí.
El resultado és el siguiente:



Hay que configurar en las secciones de conexión las IP: puerto del ordenador con el que queremos conectarnos. De momento esta versión és bidireccionar y no permite múltiples conexiones, pero bueno, y a la mejoraré.

Monday, 1 December 2008

Migrando a Delphi 2009. Preparandonos para Unicode.

La nueva versión de delphi 2009, trae grandes cambios con todo el tema del unicode. Ahora tanto la RTL como la VCL soportan totalmente unicode. Por lo tanto uno de los cambios es que el tipo "string", pertenece a "UnicodeString" en vez de "AnsiString". "Widestring" aún existe y seguirá funcionando, pero si queremos notar las mejoras del reference counting i del Delphi's fast memory manager, debemos sustituir los "WideString" por "UnicodeString". Entonces al declarar una variable de tipo "String", esta proviene de "UnicodeString" y no de "AnsiString" como estábamos acostumbrados.

Esta vez al asignar variables "AnsiString" a "WideString" o viceversa, en delphi 2009 obtendremos un warning. Una de las muchas diferencias que tenemos ahora, es que los char no miden 1 byte, sino 2. Así que si hacemos SizeOf(Char), este valdrá 2 bytes en vez de 1. Siguiendo esta casuística, la longitud de un String ya no es la medida de sus bytes, sino que la cosa ha cambiado un poco.
Si hacemos la llamada Length(String) esta nos creará bastantes problemas, porqué ahora para el cálculo tendremos que realizar Length(String) * SizeOf(Char).

  • Resumiendo:
  1. String proviene de UnicodeString y no de AnsiString.
  2. WideString no ha cambiado y seguirá funcionando correctamente, pero lo tendríamos que reemplazar por UnicodeString. WideString lo direcciona windows memory manager.
  3. Char proviene de WideChar y ahora es de 16 bits y no de 8.
  4. Los tipos de 8 bits desaparecen. AnsiChar y AnsiString (de 8 bits), seguirán funcionando, pero hay que ir con cuidado al castear, ya que UnicodeString es de 16 bits y si lo asignamos a un AnsiChar o AnsiString perderemos 8 bits. AnsiChar y AnsiString pasan a ser Deprecated.
  5. Para todo el tema de las llamadas API o comunicación con objetos COM, se complica un poco más debido que hay muchas llamadas que quieren la medida de lo que vas a enviar, y si ahora hacemos un SizeOf(String) siempre nos devolverá 4 bytes, ya que este és un puntero.
Podemos encontrar más información en los siguientes enlaces:

Codegear Delphi 2009 - What's new.
Micro-ISV.asia.