martes, 22 de agosto de 2017

Obtener el número de serie de los discos en Linux


En este caso vamos a averiguar los serial number de los discos sin necesitar privilegios de administrador.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, Forms, FileUtil, Controls, Graphics, Dialogs, StdCtrls, RegExpr, LazFileUtils;

type

        { TForm1 }

    TForm1 = class(TForm)
                Button1: TButton;
                lblSerial: TLabel;
                ListBox1: TListBox;
                procedure Button1Click(Sender: TObject);
                procedure FormCreate(Sender: TObject);
    private
        { private declarations }
    public
        { public declarations }
    end;

var
    Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  devList, disklist:TStringList;
  RegexObj: TRegExpr;
  diskid, symlnk, RegexpInput:String;
  i:integer;
begin
  RegexpInput:='';
  if ListBox1.SelCount=0 then exit;
  diskid:=ListBox1.Items.Strings[ListBox1.ItemIndex];
  devList := TStringList.Create;
  devList.Sorted:=True;
  devList.Duplicates:=dupIgnore;
  disklist:=TStringList.Create;
  disklist.Sorted:=True;
  disklist.Duplicates:=dupIgnore;
  devList:=FindAllFiles('/dev/disk/by-id');
  for i:=0 to devList.Count-1 do
  begin
    symlnk:=ReadAllLinks(devList[i],False);
    disklist.Add(symlnk);
    if (symlnk=diskid) then RegexpInput:=RegexpInput+devList[i]+LineEnding;
  end;
  RegexObj:=TRegExpr.Create;
  RegexObj.Expression:='ata.*_([^ ]*)\n';
  if RegexObj.Exec(RegexpInput) then
    lblSerial.Caption:=RegexObj.Match[1];
   devList.Free;
  disklist.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  devList, disklist:TStringList;
  RegexObj: TRegExpr;
  diskid, symlnk, RegexpInput:String;
  i:integer;
  maximo:Integer;
begin
  lblSerial.Caption:='';
  devList := TStringList.Create;
  devList.Sorted:=True;
  devList.Duplicates:=dupIgnore;
  disklist:=TStringList.Create;
  disklist.Sorted:=True;
  disklist.Duplicates:=dupIgnore;
  devList:=FindAllFiles('/dev/disk/by-id');
  for i:=0 to devList.Count-1 do
  begin
    symlnk:=ReadAllLinks(devList[i],False);
    disklist.Add(symlnk);
    if (symlnk=diskid) then RegexpInput:=RegexpInput+devList[i]+LineEnding;
  end;
  disklist.sort;
  ListBox1.Items:=disklist;
  maximo:=Length(ListBox1.Items.Strings[0]);
  for i:=ListBox1.Items.Count-1 downto 0 do
  begin
    if Length(ListBox1.Items.Strings[i])>maximo then
      ListBox1.Items.Delete(i);
    end;
  devList.Free;
  disklist.Free;
end;

end.

Código fuente: DiskSerialNumberLinux.7z


viernes, 18 de agosto de 2017

Qué significa {$mode objfpc}{$H+}

Cada vez que creamos una unidad en Lazarus, vemos esto:

unit Unit1;

{$mode objfpc}{$H+}       

Son interruptores (switch) que indican al compilador como debe compilar. En el caso de {$H+} se le está indicando que cuando se defina un string deberá el compilador asumir que es un AnsiString, es decir, que el string no tendrá una limitación en cuanto al tamaño, a no ser que se especifique un tamaño, en tal caso, será tratado como un ShortSting cuyo tamaño máximo es de 255 caracteres. Si necesitamos que en una unidad de nuestro proyecto todo lo que definamos como string sea tratado como ShortString, podemos utilizar el switch $H- de la siguiente forma:

unit Unit1;

{$mode objfpc}{$H-}     

Lo habitual (y por eso viene así por default) es {$H+}.

{$mode objfpc} le indica al compilador el modo de compilación Object Free Pascal Compiler, lo que implica por ejemplo que se pueden utilizar comentarios anidados, se permite la sobrecarga (overloading) de funciones, los PChar son convertidos en Strings automáticamente y otras cosas más que pueden leerse aquí en inglés.

TListBox 2 - seleccionar todo y arrastrar y soltar

Esta entrada es la continuación TListBox 1


Visualmente le hemos agregado 4 botones para seleccionar todos los ítems o elementos y otro para des-seleccionar. También hemos activado el drag and drop del ListBox1 hacia el ListBox2.

Cómo hacer el drag and drop entre dos ListBox?

Desde el inspector de objetos, seleccionamos ListBox1y vamos a la pestaña de eventos, allí debemos seleccionar dmAutomatic en DragMode.


Ahora pasamos al ListBox2 y debemos definir los eventos OnDragOver y OnDragDrop.


Para ello debemos hacer click sobre los ... tanto en OnDragDrop como en OnDragOver para que Lazarus nos escriba el código de los eventos.


En el evento OnDragOver tenemos que decir que pasa cuando "sobre vuela" sobre el ListBox2 un elemento arrastrado con el mouse.

procedure TForm1.ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
        State: TDragState; var Accept: Boolean);
begin
  Accept:=(Source is TListBox);
end;

Con esta línea de código indicamos que se acepte si viene de otro TListBox.

Es con el evento OnDragDrop donde especificamos que hacer con el elemento recibido, en este caso es agregar dicho elemento a la lista, pero podríamos definir cualquier otra acción.

procedure TForm1.ListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  btnAgregarClick(Self);
end;

Como ya tenemos un procedimiento para agregar, que es el evento OnClick del botón Agregar, por qué no utilizarlo y evitar escribir el código dos veces.

Eso es todo respecto de arrastrar y soltar.

Seleccionar todo y desmarcar todo: como ya está definido, resulta algo muy sencillo, no obstante, hay que saber de su existencia para no reinventar la rueda.

procedure TForm1.btnTodoL1Click(Sender: TObject);
begin
  ListBox1.SelectAll;
end;

procedure TForm1.btnTodoL2Click(Sender: TObject);
begin
  ListBox2.SelectAll;
end;

No hace falta explicar nada, SelectAll lo dice todo.

Para hacer lo contrario, des-seleccionar todo:

procedure TForm1.btnQuitarL1Click(Sender: TObject);
begin
  ListBox1.ClearSelection;
end;

procedure TForm1.btnQuitarL2Click(Sender: TObject);
begin
  ListBox2.ClearSelection;
end;

ClearSelection, es todo.

El código entonces queda de la siguiente forma:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons;

type

        { TForm1 }

    TForm1 = class(TForm)
                btnQuitarL1: TBitBtn;
                btnQuitarL2: TBitBtn;
                btnTodoL1: TBitBtn;
                btnAgregar: TBitBtn;
                btnAgregarTodos: TBitBtn;
                btnQuitar: TBitBtn;
                btnQuitarTodos: TBitBtn;
                btnTodoL2: TBitBtn;
                ListBox1: TListBox;
                ListBox2: TListBox;
                StaticText1: TStaticText;
                StaticText2: TStaticText;
                procedure btnAgregarClick(Sender: TObject);
                procedure btnAgregarTodosClick(Sender: TObject);
                procedure btnQuitarClick(Sender: TObject);
                procedure btnQuitarL1Click(Sender: TObject);
                procedure btnQuitarL2Click(Sender: TObject);
                procedure btnQuitarTodosClick(Sender: TObject);
                procedure btnTodoL1Click(Sender: TObject);
                procedure btnTodoL2Click(Sender: TObject);
                procedure ListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
                procedure ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
                        State: TDragState; var Accept: Boolean);
    private
        { private declarations }
    public
        function YaExiste (elemento:String):Boolean;
        { public declarations }
    end;

var
    Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnAgregarClick(Sender: TObject);
var
  i:Integer;
begin
  if ListBox1.Count<1 then exit; //Si no hay elementos no hace nada
  for i:=0 to ListBox1.Count-1 do  //Recorre todo el ListBox1
    if ListBox1.Selected[i] then  //Si el ítem está seleccionado
       if not (YaExiste(ListBox1.Items.Strings[i])) then //Si el ítem a agregar ya existe no lo agrega
         ListBox2.AddItem(ListBox1.Items.Strings[i],ListBox2);  //Agrega el ítem
  ListBox1.ClearSelection;
end;

procedure TForm1.btnAgregarTodosClick(Sender: TObject);
begin
  ListBox2.Items:=ListBox1.Items;
  ListBox1.ClearSelection;
end;

procedure TForm1.btnQuitarClick(Sender: TObject);
var
  i:Integer;
begin
  if ListBox2.SelCount > 0 then  //Si hay ítems seleccionados
    for i:=ListBox2.Items.Count-1 downto 0 do  //Recorre todo el ListBox2
      if ListBox2.Selected[i] then   //Si el ítem está seleccionado
        ListBox2.Items.Delete(i);  //Borra el ítem
end;

procedure TForm1.btnQuitarL1Click(Sender: TObject);
begin
  ListBox1.ClearSelection;
end;

procedure TForm1.btnQuitarL2Click(Sender: TObject);
begin
  ListBox2.ClearSelection;
end;

procedure TForm1.btnQuitarTodosClick(Sender: TObject);
begin
  ListBox2.Clear;
end;

procedure TForm1.btnTodoL1Click(Sender: TObject);
begin
  ListBox1.SelectAll;
end;

procedure TForm1.btnTodoL2Click(Sender: TObject);
begin
  ListBox2.SelectAll;
end;

procedure TForm1.ListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  btnAgregarClick(Self);
end;

procedure TForm1.ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
        State: TDragState; var Accept: Boolean);
begin
  Accept:=(Source is TListBox);
end;

function TForm1.YaExiste(elemento: String): Boolean;
var
  i:Integer;
  ret:Boolean;
begin
  ret:=False;
  for i:=0 to ListBox2.Count-1 do
    if elemento=ListBox2.Items.Strings[i] then ret:=True;
  YaExiste:=ret;
end;

end.

Código fuente de TListBox-2

Al final del video presiono todos los botones sin sentido con el fin de demostrar que el programa funciona correctamente "a pesar del usuario".


sábado, 12 de agosto de 2017

TListBox 1 - Pasar ítems entre dos ListBox


Al ListBox1 le hemos agregado los ítems desde el inspector de objetos; el ListBox2 lo hemos creado vacío. Ambos elementos fueron agregados al Form desde la paleta Standard. Los botones son del tipo TBitBtn, disponibles desde la paleta Additional, pero puede usarse en su lugar un TButton simple, claro que no se le podrá anexar una imagen, pero para este ejemplo es lo mismo.
También desde e inspector de objetos hemos marcado (True) la opción MultiSelect de ambos ListBox.

El código:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons;

type

        { TForm1 }

    TForm1 = class(TForm)
                btnAgregar: TBitBtn;
                btnAgregarTodos: TBitBtn;
                btnQuitar: TBitBtn;
                btnQuitarTodos: TBitBtn;
                ListBox1: TListBox;
                ListBox2: TListBox;
                StaticText1: TStaticText;
                StaticText2: TStaticText;
                procedure btnAgregarClick(Sender: TObject);
                procedure btnAgregarTodosClick(Sender: TObject);
                procedure btnQuitarClick(Sender: TObject);
                procedure btnQuitarTodosClick(Sender: TObject);
    private
        { private declarations }
    public
        function YaExiste (elemento:String):Boolean;
        { public declarations }
    end;

var
    Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnAgregarClick(Sender: TObject);
var
  i:Integer;
begin
  if ListBox1.Count<1 then exit; //Si no hay elementos no hace nada
  for i:=0 to ListBox1.Count-1 do  //Recorre todo el ListBox1
    if ListBox1.Selected[i] then  //Si el ítem está seleccionado
       if not (YaExiste(ListBox1.Items.Strings[i])) then //Si el ítem a agregar ya existe no lo agrega
         ListBox2.AddItem(ListBox1.Items.Strings[i],ListBox2);  //Agrega el ítem
end;

procedure TForm1.btnAgregarTodosClick(Sender: TObject);
begin
  ListBox2.Items:=ListBox1.Items;
end;

procedure TForm1.btnQuitarClick(Sender: TObject);
var
  i:Integer;
begin
  if ListBox2.SelCount > 0 then  //Si hay ítems seleccionados
    for i:=ListBox2.Items.Count-1 downto 0 do  //Recorre todo el ListBox2
      if ListBox2.Selected[i] then   //Si el ítem está seleccionado
        ListBox2.Items.Delete(i);  //Borra el ítem
end;

procedure TForm1.btnQuitarTodosClick(Sender: TObject);
begin
  ListBox2.Clear;
end;

function TForm1.YaExiste(elemento: String): Boolean;
var
  i:Integer;
  ret:Boolean;
begin
  ret:=False;
  for i:=0 to ListBox2.Count-1 do
    if elemento=ListBox2.Items.Strings[i] then ret:=True;
  YaExiste:=ret;
end;

end.       

Si se intenta agregar un elemento que ya existe, lo ignora.
Pasar todos los elementos de una lista a otra es cuestión de una sola linea:

  ListBox2.Items:=ListBox1.Items;

Quitar todos los elementos de una lista, basta con:

  ListBox2.Clear;

 Código fuente del proyecto: TListBox-1.7z


Si queremos que los elementos de las listas se muestren siempre ordenados, desde el inspector de objetos, en ambas listas marcamos la propiedad Sorted (True).



Deshabilitar todos los componentes de un formulario

  for i:=0 to ComponentCount-1 do
    if Components[i] is TControl then TControl(Components[i]).Enabled:=False;