segunda-feira, 27 de dezembro de 2010

Meus vídeos favoritos do youtube até agora

Fazendo uma pequena limpeza nos meus favoritos do youtube encontrei esses videos. Tem sátiras, paródias, filmes amadores e games amadores. Assuntos de games prevalecem. Have Fun.

O ultimo vídeo é uma tentativa de jogar um hack do Super Mario World, o Kaizo Mario, muito difícil. É engraçado ver o cara tentando e se ferrando toda hora.

 

http://www.youtube.com/watch?v=9h1swNWgP8Q

http://www.youtube.com/watch?v=WYII2Oau_VY

http://www.youtube.com/watch?v=3xCY2K9kQz4

http://www.youtube.com/watch?v=hpvlTVgeivU

http://www.youtube.com/watch?v=CtztrcGkCBw

http://www.youtube.com/watch?v=CfWuTu30aJQ

http://www.youtube.com/watch?v=JM0MXvE2lnU

http://www.youtube.com/watch?v=h2ZXSzaUIBQ

http://www.youtube.com/watch?v=wvWN7kTBzRw

http://www.youtube.com/watch?v=n4RjJKxsamQ

http://www.youtube.com/watch?v=f5uzgPqwTr4

http://www.youtube.com/watch?v=pUdXhhDDnaY

http://www.youtube.com/watch?v=oIzAqcsT1Sc

http://www.youtube.com/watch?v=SGD6r4ebmEY

http://www.youtube.com/watch?v=Wx1uhGNGgas

http://www.youtube.com/watch?v=2lXh2n0aPyw

http://www.youtube.com/watch?v=JVHGy9XEF9I

http://www.youtube.com/watch?v=F5jeQPr4424

http://www.youtube.com/watch?v=8KyGHmRSS9c

http://www.youtube.com/watch?v=iG0OZmkJxvI

http://www.youtube.com/watch?v=d8eqVjyrdDg

http://www.youtube.com/watch?v=3hFs2cKJ2jg

http://www.youtube.com/watch?v=nwUtSgTkjSg

http://www.youtube.com/watch?v=Ua6pbz3ROvQ

Have Fun ;)

 

 

quinta-feira, 9 de dezembro de 2010

Clube Delphi 124

Já está no site da DevMedia a revista Clube Delphi n° 124.

Com um artigo de capa muito interessante e há muito que queríamos ler: controle de versão já integrado no Delphi XE.

Nesta edição você poderá ver também meu artigo sobre compressão de arquivos e a terceira parte do artigo sobre design patterns.

Neste artigo você verá como criar um programa OO multibanco e multicomponente de acesso usando factory method e abstract factoey.

Também é mostrada nessa série de artigos uma maneira mais simples de se criar um singleton do que a que já foi mostrada nesse blog.

Espero que gostem, divirtam-se.

quinta-feira, 2 de dezembro de 2010

Clube Delphi 123

Tanta correria esse mês, com a pós graduação, artigos e projetos que nem deu tempo de postar nada sobre a revista Clube Delphi 123.

A revista está excelente, pra variar, com ótimos artigos.

Começando por um artigo sobre injeção de dependência do Paulo Quicoli, e mais um artigo sobre Lazarus e Free Pascal de Daniel Simões Almeida, esses dois apenas para citar.

Nesta edição há a segunda parte do meu artigo sobre design patterns onde falamos mais um pouco sobre factory methods. Espero que seja útil a todos.

Uma técnica que ficou de fora desse artigo, para elaborar factories é a técnica de registrar classes com registerclass e depois usar o tipo/metaclasse TPersistentClass para obter a classe pelo nome (string) e criá-la.

Esse método você pode conferir no meu último post sobre metaprogramação no delphi e no lazarus.

Espero que seja útil a todos e happy coding ;)

sexta-feira, 12 de novembro de 2010

Metaprogramação no lazarus

No meu último post eu falei sobre o componente Pascal Script da RemObjects. A melhor notícia é que a versão 3 do componente, com um belo instalador automático e uma série de melhorias, tem uma versão para lázarus muito fácil de se instalar.

Além disso tem uma versão também para o visual studio / .net, então imagina usar metaprogramação "via script" no ambiente .net que já permite metaprogramação. Vai ser show de bola, e um perigo também, se mal usado.

Esse é  o tipo de recurso que quando agente usa fala: "e porque não?".

Bom, pelo menos como aprendizado e prova de conceito darei uma estudada e desenvolverei mais alguns exemplinhos.

Por hora, fiz no lázarus o mesmíssimo exemplo feito em Delphi no último post, espero que gostem. Uma das mudanças foi colocar um SynEdit para digitar o código, em vez de um memo comum.



O Synedit é show!

Faça o download do exemplo aqui:

Have fun ;)

quarta-feira, 10 de novembro de 2010

Chamando Formulários com PascalScript + RTTI + Factory Methods

Um desenvolvedor que leu meu artigo sobre metaprogramação no Delphi me perguntou hoje como criar e abrir formulários a partir de scripts com o Pascal Script.
Não há uma maneira muito fácil de se fazer isso, e pode haver outras maneiras de se fazer.

Você não pode simplesmente registrar a form1 simplesmente porque o tipo TForm1 não existe. Ele não é nativo do Delphi, mas foi escrito por você.

O Pascal Script não conhece o tipo TForm1 e não tem como, dentro do script, você criar uma variável desse tipo.

Uma das maneiras seria você registrar a unit1, fazendo com que o pascal script a use, ou declarar a TForm1 todinha dentro do pascal script. Essas duas opções são complicadas, pois um dos meios é passar o fonte .pas junto com a aplicação e deixar  o cliente ver / manipular livremente. E se por acaso a unit1 usa ou depende de outras units você teria um enorme problema em cascata.

Além disso o pascal script é limitado. Ele se limita apenas às operações básicas do pascal.

Uma maneira elegante de resolver esse impasse seria usar uma mistura de FactoryMethod com RTTI e pascal script.

Use a função registerclass para "registrar" a classe da form que você quer que seja aberta no script. Faça isso na seção initilization como segue:

unit uFrmChamada;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfrmChamada = class(TForm)
    Label1: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmChamada: TfrmChamada;

implementation

{$R *.dfm}


initialization
  RegisterClass(TfrmChamada);

end.


RegisterClass exige um parâmetro do tipo TPersistentClass, que é um tipo que define um tipo (?!?!?) Sim, é um metatipo, ou metaclasse se você preferir.

Como forms são descendentes de TPersistent, qualquer tipo de classe de form é do mesmo tipo do metatipo TPersistentClass (?!?!?). Estou falando de classes, não de objetos, repare bem nisso. Você pode ter variáveis que são do TIPO CLASSE e não DO TIPO DE UMA CLASSE.

E não podemos esquecer que na unit forms existe a declaração:

  TFormClass = class of TForm;

Para facilitar nossa vida, porque TFormClass também é um TPersistentClass, mas é específico da classe TForm, ou seja, TFormClass é um descendente indireto (bastardo) de TPersistentClass.

São os truques da RTTI para se trabalhar dinamicamente com tipos sobre tipos. (variáveis de tipos).

Partindo do pressuposto que você já tem uma form com um memo para digitar o código e o componente do pascal script colado nela, crie nessa form (ou numa unit separada para não gerar acoplamentos desnecessários) uma function estática global assim:

function ConstrutorDeForms(NomeClasse: string): TForm;
var
  ClasseDaForm: TFormClass;
begin
  ClasseDaForm := TFormClass(FindClass(NomeClasse));
  Result := ClasseDaForm.Create(Application);
end;

Usei Application como owner aqui porque não estamos dentro de um objeto ou classe (form) estamos direto na unit. Poderia ser nil, mas assegure-se de que o objeto seja destruído para não criar leaks.

E registre a função assim, no evento OnCompile do pascal script:

 psExecutar.AddFunction(@ConstrutorDeForms, 'function ConstrutorDeForms(NomeClasse: string):TForm;');


Não esqueça de registrar outras funções e variáveis que vá utilizar, como foi explicado no artigo.

unit uFrmEditor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, dateutils, DB, ADODB, uPSComponent, uPSCompiler,
  uPSRuntime, uPSComponent_DB, uPSComponent_Default;

type
  TfrmEditor = class(TForm)
    btExecutar: TBitBtn;
    psExecutar: TPSScript;
    mMensagens: TMemo;
    mSaida: TMemo;
    mFonte: TMemo;
    PSImport_DB1: TPSImport_DB;
    PSImport_Classes1: TPSImport_Classes;
    procedure btExecutarClick(Sender: TObject);
    procedure psExecutarCompile(Sender: TPSScript);
    procedure psExecutarExecute(Sender: TPSScript);
    procedure psExecutarCompImport(Sender: TObject; x: TPSPascalCompiler);
    procedure psExecutarExecImport(Sender: TObject; se: TPSExec;
      x: TPSRuntimeClassImporter);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


procedure NossoWriteLn(const s: string);
procedure NossoReadLn(var s: string);
//function para simular factory method com as classes de forms registradas
//ela cria a form e devolve a quem a chamar
function ConstrutorDeForms(NomeClasse: string): TForm;


var
  frmEditor: TfrmEditor;

implementation
uses
  uPSR_std,
  uPSC_std,
  uPSR_stdctrls,
  uPSC_stdctrls,
  uPSR_forms,
  uPSC_forms,
  uPSC_graphics,
  uPSC_controls,
  uPSC_classes,
  uPSR_graphics,
  uPSR_controls,
  uPSR_classes, uFrmChamada;

{$R *.dfm}


procedure NossoWriteLn(const s: string);
begin
  frmEditor.mSaida.Lines.Add(s);
end;

procedure NossoReadLn(var s: string);
begin
  s := InputBox('Digite um valor:', 'Digite um valor:', '');
end;

function ConstrutorDeForms(NomeClasse: string): TForm;
var
  ClasseDaForm: TFormClass;
begin
  ClasseDaForm := TFormClass(FindClass(NomeClasse));
  Result := ClasseDaForm.Create(Application);
end;



procedure TfrmEditor.btExecutarClick(Sender: TObject);
var
  Compilou, Executou: boolean;
  i: integer;
begin
  mMensagens.Clear;
  mSaida.Clear;


  psExecutar.Script.Text := mFonte.Text;
  Compilou := psExecutar.Compile;

  if Compilou then
  begin
    mMensagens.Lines.Add('Programa compilado com sucesso!');
    Executou := psExecutar.Execute;

    if Executou then
    begin
      mMensagens.Lines.Add('Programa executado com sucesso!');
    end
    else
    begin
      mMensagens.Lines.Add('Ocorreu o erro de execução: ' +
        psExecutar.ExecErrorToString +' onde? '+
        Inttostr(psExecutar.ExecErrorProcNo)+'.'+
        Inttostr(psExecutar.ExecErrorByteCodePosition));
    end;

  end
  else
     mMensagens.Lines.Add('Erro de compilação:');

  for i := 0 to psExecutar.CompilerMessageCount - 1 do
  begin
    mMensagens.Lines.Add('Compilador: '+ psExecutar.CompilerErrorToStr(i));
  end;

end;

procedure TfrmEditor.psExecutarCompile(Sender: TPSScript);
begin
  psExecutar.AddFunction(@NossoWriteLn, 'procedure Writeln(s: string);');
  psExecutar.AddFunction(@NossoReadLn, 'procedure ReadLn(var s: string);');
  psExecutar.AddFunction(@ShowMessage, 'procedure ShowMessage(s: string);');

  psExecutar.AddFunction(@ConstrutorDeForms, 'function ConstrutorDeForms(NomeClasse: string):TForm;');

  //adicionamos isso para existir a variável
  psExecutar.AddRegisteredVariable('Application', 'TApplication');
  psExecutar.AddRegisteredVariable('Self', 'TForm');
end;



procedure TfrmEditor.psExecutarCompImport(Sender: TObject;
  x: TPSPascalCompiler);
begin
  SIRegister_Std(x);
  SIRegister_Classes(x, true);
  SIRegister_Graphics(x, true);
  SIRegister_Controls(x);
  SIRegister_stdctrls(x);
  SIRegister_Forms(x);
end;

procedure TfrmEditor.psExecutarExecImport(Sender: TObject; se: TPSExec;
  x: TPSRuntimeClassImporter);
begin
  RIRegister_Std(x);
  RIRegister_Classes(x, True);
  RIRegister_Graphics(x, True);
  RIRegister_Controls(x);
  RIRegister_stdctrls(x);
  RIRegister_Forms(x);
end;

procedure TfrmEditor.psExecutarExecute(Sender: TPSScript);
begin
  psExecutar.SetVarToInstance('Application', Application);
  psExecutar.SetVarToInstance('Self', Self);
end;

end.


E para chamar a dita cuja segunda form faça assim:

program DoUsuario;

var frmChamada: Tform;


begin

frmChamada := ConstrutorDeForms('TFrmChamada');
frmChamada.ShowModal;
frmChamada.free;

end.


O legal é que a função ConstrutorDeForms pode ser usada também fora do pascal script para chamar qualquer form que esteja registrada com RegisterClass.

Para acessar componentes internos da form criada use os métodos FindComponent, exemplo:

program DoUsuario;

var frmChamada: Tform;
lbl1: TLabel;


begin

frmChamada := ConstrutorDeForms('TFrmChamada');
lbl1:= TLabel(frmChamada.FindComponent('Label1'));
lbl1.Caption := 'Uia, dá pra mudar propiedades dos componentes!';

frmChamada.ShowModal;
frmChamada.free;

end.


O pascal script, pelo menos nesta versão e do modo como eu o uso, não tem os operadores de RTTI is e as, por isso usamos a conversão de tipo "forçada" e "não segura" TLabel(frmChamada.FindComponent('Label1')); que não é verificada pelo compilador.

Baixe o fonte desse exemplo, juntamente com o componente.

Espero ter ajudado ^^

sexta-feira, 5 de novembro de 2010

Faça backup do seu blog

Se você tem um blog no blogspot você pode fazer backup de seus posts através de XML, para poder armazenar o conteúdo e até portar para outras plataformas.

Backup é a única medida de segurança barata/viável em um monte de situações, e no caso do blogger é a medida mais segura que você pode tomar.

Uma das ferramentas que pode te ajudar com isso é o blogger backup utility que você pode baixar no codeplex.

Ele é open-source, então você pode baixar sem medo, e alterar a seu gosto.


Na caixa de seleção logo acima escolha "add/edit / remove blogs" para adicionar seu blog na lista. (você pode ter múltiplos).
Depois de colocar seu login e senha simplesmente diga se você quer fazer backup de tudo ou apenas a partir de uma data, e se quer tudo em um arquivo ou um arquivo por post. Simples assim.

Have fun ;)

Existem 1001 maneiras de preparar SINGLETON, invente uma!

Falando-se de POO e Padrões de projeto, não podemos deixar de falar em Singleton. Singleton é um tipo de classe que só pode ser instanciada uma e apenas uma vez. Esse tipo de classe é ideal para objetos que carregam configurações do sistema, objetos que manipulam o horario do sistema, objetos que usamo recursos compartilhados, e por isso necessitam ser serializados ou sincronizados pelas threads, por não poderem executar ao mesmo tempo.
Concrete Factories e Builders também são ótimos exemplos de padrões de projeto que podem ser criados a partir de um singleton. Afinal, se você precisa de um objeto que crie, ou que crie e configure outros objetos para você, seria ideal que todos os objetos criados e montados fossem fabricados do mesmo jeito. Logo, você não deveria ter duas instancias diferentes de um mesmo factory ou de um mesmo buider.
A maneira mais simples de se criar um singleton no Delphi é comona listagem abaixo.
unit uSingleton;

interface

uses
  DateUtils, SysUtils, Windows, dialogs;

type

  TObjetoNormal = class
  private
    FDataHora: string;
  public
    constructor Create; 
    function GetDataHora: string;
  end;


  TObjetoUnico = class
  private
    FDataHora: string;
  public
    constructor Create;
    class function CreateUnico: TObjetoUnico;
    destructor Destroy; override;
    function GetDataHora: string;
  end;

procedure VerificaObjetoUnicoCriado;

implementation




var
  _ObjetoUnico: TObjetoUnico;
  _Contador: Integer = 0;

procedure VerificaObjetoUnicoCriado;
begin
  if (_Contador >= 1) and (_ObjetoUnico <> nil) then
    ShowMessage('=========== verificação ===========' + #13#10 +
    'Nome da classe: ' + _ObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação: ' + _ObjetoUnico.GetDataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(_ObjetoUnico))
  );
end;

{ TObjetoNormal }

constructor TObjetoNormal.Create;
begin
  inherited Create;
  FDataHora := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
end;

function TObjetoNormal.GetDataHora: string;
begin
  Result := FDataHora;
end;

{ TObjetoUnico }

constructor TObjetoUnico.Create;
begin

    if (_Contador = 0) then
    begin
      inherited Create;  //aqui tudo bem usar o inherited create e destroy porque a classe base não faz nada de mais
      InterlockedIncrement(_Contador);
      FDataHora := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
    end
    else
      raise Exception.Create('Ei! Não use esse constructor, use o CreateUnico!');
    //o inherited fica dentro do if assim o objeto não será criado caso ja esteja o contador > 0

end;

class function TObjetoUnico.CreateUnico: TObjetoUnico;
begin
  if _ObjetoUnico = nil then
    _ObjetoUnico := TObjetoUnico.Create;
  Result := _ObjetoUnico;
end;

destructor TObjetoUnico.Destroy;
begin

  //aqui permitimos que o objeto seja destruido.
  //logico que isso dará problemas para quem tentar usar o objeto
  //mas caso necessário ele pode ser recriado automaticamente
  //desde que seja recriado uma unica vez.

  //por isso é importante não guardar referencias ao singleton em
  //variáveis, mas chama-lo apenas através de um método

  _ObjetoUnico := nil;
  InterlockedDecrement(_Contador);
  inherited;

end;

function TObjetoUnico.GetDataHora: string;
begin
  Result := FDataHora;
end;



initialization
  _ObjetoUnico := nil;
  _Contador := 0;

finalization
  if (_ObjetoUnico <> nil) then
  try
    _ObjetoUnico.Free;
  except
    //tratamento de excessão
  end;

end.


    

Estou criando um objeto, e no momento da criação estou gravando em um atributo privado o horário de criação. Repare que um objeto normal permite que se crie várias instâncias, e cada nova instância vai sendo gravada com o novo horário, mas o objeto singleton permanece o mesmo.
Podemos também alterar o método create do objeto para que grave mensagens únicas em um listbox, num formulário. Se em cada linha do listbox adicionássemos um objeto diferente, o singleton seria adicionado uma única vez.
Veja também que para saber se o objeto já está criado usamos uma variavel estática. Mas ela não é Pública global. Ela não está na seção interface da unit, mas sim na seção implementation. E seu nome começa com "_". Com isso garantimos que ela será invisível às outras units e na própria unit ela não será usada "sem querer" por um programador desavisado.
Seria interessante se fosse possível criar um constructor privado. Só que existe um outro problema: Criar um constructor privado não impede de se chamar o método create da classe. Só que quando isso acontecer será executado o constructor create público da classe ancestral. Isso fará com que a string FDataHora interna da classe, e qualquer outro objeto a ser carregado no constructor não sejam carregados, setados e construidos corretamente. Isso criaria varios erros de access violations.
Construtores privados apenas no Prism e no C#.net :)
Podemos contornar esse problema mantendo o constructor público, mas implementando um contador de objetos. Se ele passar de 1, disparamos uma exception.
O grande problema de se criar uma classe singleton assim é que ela não pode ser facilmente herdada, a não ser que existam outras variáveis para controlar o contador e o conteiner de instancias da classe filha. Para isso todos os métodos devem ser sobrecarregados, ou seja, o singleton deve ser refeito.
Outra desvantagem é que é estritamente necessário criar esse objeto pela class function (método estático) CreateUnico.

É interessante salientar que o CreateUnico é um método de classe estático (construtores também são métodos estáticos) que poderia ser substituido por uma function estática global tradicional, mas resolvemos usar uma class function para usar o "namespace" (nome da classe) e não se distanciar muito da POO. O método CreateUnico também pode ser caracterizado como um factory method se você desejar, pois a função dele é criar um objeto. (construtores também são fábricas degeneradas)






Podemos usar o seguinte exemplo, na listagem abaixo, para testar nosso singleton. Repare que temos dois botões no formulário. (crie um formulário como o da figura)

Um vai criar uma instância de uma classe normal (TObjetoNormal) e o outro vai criar uma instância do singleton (TObjetoUnico) pelo método CreateUnico.
Estamos mostrando, para cada objeto criado, sua data de criação, seu endereço na memória (um integer, deve ser único) e o nome da classe. Monitore memory leaks no seu projeto.
Você verá que a cada instância do objeto normal, mesmo que gravado em uma mesmoa variável, é uma nova instância, com endereço de memória e data diferentes. Mas ao criar o singleton, mesmo que crie 200 vezes, o endereço será sempre o mesmo, e a data também, indicando que a instância é a mesma. Ao fechar o programa as várias instâncias da classe normal serão reportadas como leaks, mas a classe singleton será dstruida no finalization.
O controle de instâncias é feito por uma variável estática privada e por um contador de referências. Caso passar de 1 ou a variável do tipo singleton não for nil é disparada uma excessão (no método create). O método CreateUnico verifica se já está criada (variável _ObjetoUnico <> de nil e contador de referencias exatamente igual a 1). Se já estiver criada retorna a mesma, caso contrário cria armazena na hora de retornar e retorna (lazy binding).



codigo:

procedure TfrmUmaInstancia.btNormalClick(Sender: TObject);
var FObjetoNormal: TObjetoNormal;
begin

  //cuidado, você está prestes a criar varias instancias de
  //um objeto colocando na mesma variável, perdendo
  //posteriormente a referencia aos objetosanteriores
  //você não poderá destruir os objetos anteriores, causando
  //um memory leak
  FObjetoNormal := TObjetoNormal.Create;

  //mostrando a classe do objeto, hora de criação e endereço do objeto
  //veja que é sempre diferente
  ShowMessage('Nome da classe: ' + FObjetoNormal.ClassName+ #13#10 +
    'Hora de Criação: ' + FObjetoNormal.GetDataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(FObjetoNormal))
  );
end;

procedure TfrmUmaInstancia.btUnicoClick(Sender: TObject);
var FObjetoUnico: TObjetoUnico;
begin

  //veja que é possivel executar o create
  //Mas dessa forma não é garantido que o objeto seja unico
  //para garantir que seja único é imprescindível o uso do método  CreateUnico

  FObjetoUnico := TObjetoUnico.CreateUnico;

  //mostrando a classe do objeto, hora de criação e endereço do objeto
  //veja que é sempre igual
  ShowMessage('Nome da classe: ' + FObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação: ' + FObjetoUnico.GetDataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(FObjetoUnico))
  );


end;

    




Repare que esse singleton que fizemos pode ser refeito em Lazarus sem grandes problemas. Mas seria difícil usar herança com ele. Para que uma classe derivada funcione corretamente sem misturar instâncias com a classe ancestral, sem gravar uma instância nas variáveis estáticas locais da unit ancestral e sem usar métodos indevidos da classe ancestral, como o método que incrementa a contagem, obrigatoriamente deve-se reimplementar todos os métodos da classe filha sem invocar o inherited.
Criar um descendente para este singleton não é impossível, e pode ser exemplificado pelo código abaixo:


unit uSingletonDerivado;

interface

uses
  uSingleton, SysUtils, DateUtils, Windows, dialogs;

type

  TObjetoUnicoDerivado = class(TObjetoUnico)
  private
    FDataHora: string;
  public
    constructor Create;
    class function CreateUnico: TObjetoUnicoDerivado;
    destructor Destroy; override;
    function GetDataHora: string;
  end;

procedure VerificaObjetoUnicoDerivadoCriado;

implementation

var
  _ObjetoUnico: TObjetoUnicoDerivado;
  _Contador: Integer = 0;

procedure VerificaObjetoUnicoDerivadoCriado;
begin
  if (_Contador >= 1) and (_ObjetoUnico <> nil) then
    ShowMessage('=========== verificação ===========' + #13#10 +
    'Nome da classe: ' + _ObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação: ' + _ObjetoUnico.GetDataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(_ObjetoUnico))
  );
end;

{ TObjetoUnicoDerivado }

constructor TObjetoUnicoDerivado.Create;
begin

    if (_Contador = 0) then
    begin
      //aqui há o perigo de criar mais um objeto _ObjetoUnico que perderá sua referência e causará leak
      //ou, no mínimo, incrementar o seu contador
      //experimente descomentar o inherited para ver o que acontece
      //inherited Create;
      InterlockedIncrement(_Contador);
      FDataHora := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
    end
    else
      raise Exception.Create('Ei! Não use esse constructor, use o CreateUnico!');
    //o inherited fica dentro do if assim o objeto não será criado caso ja esteja o contador > 0

end;

class function TObjetoUnicoDerivado.CreateUnico: TObjetoUnicoDerivado;
begin
  //aqui não se pode usar inherited porque senão trará uma instância do objeto ancestral
  if _ObjetoUnico = nil then
    _ObjetoUnico := TObjetoUnicoDerivado.Create;
  Result := _ObjetoUnico;
end;

destructor TObjetoUnicoDerivado.Destroy;
begin
  _ObjetoUnico := nil;
  InterlockedDecrement(_Contador);
  //aqui há o perigo de destruir um objeto _ObjetoUnico que pode estar em uso na unit do ancestral
  //expedrimente descomentar o inherited para ver o que acontece
  //inherited;
end;

function TObjetoUnicoDerivado.GetDataHora: string;
begin
  //aqui não haveria perigo de chamar inherited
  //mas se você não chamar o inherited do create então  o campo privado
  //FDataHora ficará vazio (seria usado o do ancestral)
  //por isso é melhor refazer
  //isso é polimorfismo :)
  Result := 'Data desta classe nova: ' +  FDataHora;;
end;

initialization
  _ObjetoUnico := nil;
  _Contador := 0;

finalization
  if (_ObjetoUnico <> nil) then
  try
    _ObjetoUnico.Free;
  except
    //tratamento de excessão
  end;


end.

    


E testado assim:

procedure TfrmUmaInstancia.btDerivadoClick(Sender: TObject);
var FObjetoUnico: TObjetoUnicoDerivado;
begin
  //veja que é possivel executar o create
  //Mas dessa forma não é garantido que o objeto seja unico
  //para garantir que seja único é imprescindível o uso do método  CreateUnico

  FObjetoUnico := TObjetoUnicoDerivado.CreateUnico;

  //mostrando a classe do objeto, hora de criação e endereço do objeto
  //veja que é sempre igual
  ShowMessage('Nome da classe: ' + FObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação: ' + FObjetoUnico.GetDataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(FObjetoUnico))
  );

end;
    


Uma outra maneira muito elegante de criar singletons em Delphi muito mais facilmente "herdáveis" seria cria-los usando class properties e class vars estáticas (e privadas) assim a classe filha poderia herdar essas caracteristicas já adaptadas para a nova classe, sem misturar instâncias.
A desvantagem é que dessa maneira ele não funcionaria com o lazarus, pelo menos não enquando o lazarus não suportar propriedades e campos de classe.
Na parte 2 desse post veremos como implementar com class vars no Delphi XE.

Você pode fazer download desse exemplo aqui. O uso da FastMM4 vai depender de você estar usando Delphi 7 ou não. Este exemplo foi compilado em Delphi XE.

Até + :)



Links úteis, leia todos ;)



Existem 1001 maneiras de preparar SINGLETON, invente uma! - Parte 1

http://blog.vitorrubio.com.br/2010/11/existem-1001-maneiras-de-preparar.html

Existem 1001 maneiras de preparar SINGLETON, invente uma! - Parte 2

http://blog.vitorrubio.com.br/2011/01/existem-1001-maneiras-de-preparar.html

Existem 1001 maneiras de preparar SINGLETON, invente uma! - Parte 3

http://blog.vitorrubio.com.br/2011/02/existem-1001-maneiras-de-preparar.html

Existem 1001 maneiras de preparar SINGLETON, invente uma! - Parte 4
http://blog.vitorrubio.com.br/2011/02/existem-1001-maneiras-de-preparar_08.html

Criando uma classe singleton verdadeira em delphi

http://www.comofazertudo.com.br/computadores-e-internet/criando-uma-classe-singleton-verdadeira-em-delphi

Creating a real singleton class in Delphi 5

http://edn.embarcadero.com/article/22576

Introdução: Singleton - Design Pattern Delphi - Parte 1

http://www.devmedia.com.br/post-17889-Introducao--Singleton-Design-Pattern-Delphi-Parte-1.html

Tentativa de Singleton usando Delphi

http://www.marcosdellantonio.net/2006/12/01/tentativa-de-singleton-usando-delphi/

Implementing the Singleton pattern in delphi

http://www.delphi3000.com/articles/article_1736.asp?SK=

Essa é uma abordagem nova que eu nunca imaginei:

http://stackoverflow.com/questions/1409593/creating-a-singleton-in-delphi-using-the-new-features-of-d2009-and-d2010

Class (, Static, or Shared) Constructors (and Destructors)

http://blogs.embarcadero.com/abauer/2009/09/03/38898

Design Patterns in Delphi

http://delphi.about.com/od/oopindelphi/a/aa010201a.htm

No forum antigo:

Tópico no forum devmedia sobre singleton

no forum novo:

http://www.devmedia.com.br/forum/viewtopic.asp?id=374670

quarta-feira, 27 de outubro de 2010

Como hoje estou de bom humor ... campanha!

A mensagem está dada.

De pensar que um jogo pra crianças incentivava essas coisas ...

Vida de Programador ... Estranho

Cara, hoje eu sou programador, mas já trabalhei 2 anos com suporte e daí eu tirei as histórias mais hilárias da minha carreira. (e perdi 70% dos meus cabelos também).

Mas você pensa que o único problema do pessoal do suporte são os usuários? Nada, os programadores são boa parte do problema. No blog Vida de Suporte me identifiquei muito com o personagem Mauro que fala .... estranho. Eu falo igualzinho quando dá algum problema.

A explicação é simples: se o programador desenvolve sem uma metodologia fixa (vamos desconsiderar aqui as pressões por preço e prazo) ele testa a aplicação num universo ou contexto familiar a ele.

Quando ocorre algum problema ou é descoberto um bug, ou a maneira de reproduzir o bug é desconhecida do universo de testes do programador ou ele até já esqueceu que funcionalidade é esta que ele construiu, o que ela fazia, para que servia e como usá-la.

Ele só sabe que não era para dar erro. Se der é no mínimo ..... estranho. Agora vai saber (ou imaginar) por que ocorreu o erro e se o problema não é inconsistência dos dados legados, portados, repetidos ou "mal-inseridos".





Tem também o estressado Gerson, um programador Delphi que bota medo até em gerente.


Bom pessoal, as tirinhas do André Farias são muito legais, vale a pena ler.

segunda-feira, 25 de outubro de 2010

Obtendo e formatando datas no .Net com C# e Iron Python

Formatos para obter a data:
1.  Use dd para obter simplesmente o dia
2. Use ddd para obter um nome curto para o dia 
3. Use dddd para obter  o nome completo do dia
4. Use MM em maiúsculo para obter o mês
5. Use yyyy para obter o ano com 4 dígitos
6. Use hh para obter as horas
7. Use mm em minúsculo para obter os minutos
8. Use ss para obter os segundos


Código no C# para imprimir a data (no console)

using System;
using System.Text;
namespace TesteDatas
{
    class FormatoData
    {
        static void Main(string[] args)
        {
            Console.WriteLine("Current Date and Time:");
            Console.WriteLine(System.DateTime.Now);
            Console.WriteLine("Data: {0:dd}", System.DateTime.Now);
            Console.WriteLine("Dia: {0:ddd}", System.DateTime.Now);
            Console.WriteLine("Dia Longo: {0:dddd}", System.DateTime.Now);
            Console.WriteLine("Data Completa: {0:dddd - dd \\de MMMM \\de yyyy - hh:mm:ss}", System.DateTime.Now);
            Console.ReadLine();
        }
    }
}

Repare que na string de formatação temos um \\ antes do "De". Duas barras significa que estamos usando uma barra como caracter de escape para escrever uma barra dentro de uma string de formatação dentro de outra string. Então duas contrabarras são viram uma contrabarra (uma é escape e a outra é o caractere em si) e uma contrabarra + d serve para imprimir/mostrar a letra d de "de" em vez do dia.


Agora em Iron Python:


Depois de instalar o Iron Python adicione "C:\Arquivos de programas\IronPython 2.7\" na variável de ambiente path ou digite no cmd path "C:\Arquivos de programas\IronPython 2.7\"

Crie o arquivo Datas.py assim:  (Sem identações)


import System

System.Console.WriteLine("Data:")
System.Console.WriteLine(System.DateTime.Now)
System.Console.WriteLine("Data: {0:dd}", System.DateTime.Now)
System.Console.WriteLine("Dia: {0:ddd}", System.DateTime.Now)
System.Console.WriteLine("Dia Longo: {0:dddd}", System.DateTime.Now)
System.Console.WriteLine("Data Completa: {0:dddd - dd \\de MMMM \\de yyyy - hh:mm:ss}", System.DateTime.Now)
System.Console.ReadLine()


Execute com o comando ipy Datas.py


O resultado será o mesmo conseguido com C#. 


Have Fun ;)

domingo, 24 de outubro de 2010

Como "matar" um processo no Delphi

Para fechar um programa executável pelo seu nome crie a seguinte função:


function killtask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while Integer(ContinueLoop) <> 0 do
  begin 
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then 
      Result := Integer(TerminateProcess(
                        OpenProcess(PROCESS_TERMINATE,
                                    BOOL(0),
                                    FProcessEntry32.th32ProcessID),
                                    0));
     ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;


E use-a assim:

killtask('notepad.exe');

Essa foi uma "dica expressa" só código, sem mais delongas.

Até a próxima ;)

Migração do Live Spaces para o Wordpress

Uma boa notícia (ou não) para quem tem um blog no Live Spaces mas acha uma droga. A Microsoft, em parceria com o Wordpress resolveu migrar os blogs feitos no Live para a plataforma Wordpress.

Eu acho isso uma boa idéia pois assim a microsoft pode focar no que ela tem de melhor e realmente sabe fazer, e deixar a parte que ela não tem muito know how para terceiros.

Pelo calendário da microsoft você tem até 4 de janeiro de 2011 para baixar o conteúdo e migrar, até essa data você ainda pode postar conteúdo. Passando de 4 de janeiro o blog será travado para novas pstagens, permitindo-se apenas consultas e o download do conteúdo. No dia 16 de março de 2011 o live spaces será fechado de vez.

Veja abaixo a mensagem original que enviaram para os usuários:



Dear Windows Live Spaces customer,
We are very excited to announce our collaboration with a premier and innovative blogging service, WordPress.com, to offer you an upgraded blogging experience. We'll help you migrate your current Windows Live Spaces blog to WordPress.com or you can download it to save for later. On March 16th, 2011 your current space will close.
With the new release of Windows Live services, we've made a series of changes and improvements across our products. We chose to partner to provide our users with a fantastic blogging solution. However, we realize the changes will have an impact on you - this email aims to address any concerns you may have.

Why is this happening?
Our customers have asked for richer blog functionality including an integrated statistics system, continuous saving of drafts and improvements to spam-fighting technology. To deliver the best possible blogging experience, we are collaborating with WordPress.com to provide their free service to you. For those of you that already have a blog on Windows Live Spaces, we will make it easier for you to get started while helping you move what you've already built up on Spaces.


What is the timeline?
Starting the end of September, 2010, when you visit your Windows Live Space you'll be given the opportunity to upgrade your blog by migrating it to WordPress.com and to download your content to save for later. 

As of January 4th, 2011, you won't be able to make changes to your Spaces blog, but you can continue to review past posts, download your content to save for later and upgrade your blog to WordPress.com. 

On March 16th, 2011 Windows Live Spaces will close and you will not be able to access or migrate your blog on Spaces.


What you need to do before Windows Live Spaces closes
Starting the end of September, when you visit your space you'll have the following options:
  • Upgrade your blog by migrating to WordPress.com - We will provide a simple way to move your blog posts and comments to WordPress.com.
  • Download your blog – You can download your old posts to keep a copy with you. You can also do this and then migrate to WordPress.com.
  • Delete your space - If you decide that you do not want to have a space anymore, you have the option to delete it permanently. If you want to save your content, please make sure to do that before deleting your space.
  • If you can't decide, take some time – Over the next few months, Windows Live Spaces will continue to be accessible while you make your decision. But we're very excited about what you can do on WordPress.com and hope you'll decide to take advantage of this improved blogging experience.
Note: some content such as gadgets, guestbook, lists, notes and draft posts won't be migrated. See FAQs for more info on how to preserve this type of content. 

Go to your space to choose an option that's right for you.


What you can expect by moving to WordPress.com
All of your posts, comments, and links will transfer, and you will have the option to share your blogging updates with your Messenger friends.

On WordPress.com, you'll get tools to help you track how your blog is doing and who's visiting. You'll get tagging that enables people to find you, and for you to find like-minded people. It includes great blog comment functionality, and trackback spam prevention to help keep your experience clean. Check out more.
Thanks for using Windows Live and we hope you enjoy the new blogging experience.
Sincerely,
The Windows Live team
Frequently Asked Questions
Q: What is WordPress.com ?
A: WordPress.com is a free blogging site, similar to Windows Live Spaces. On WordPress.com, you'll find great themes and widgets to customize your experience, tools to help you track how your blog is doing and who's visiting. You'll get tagging that enables people to find you, and for you to find like-minded people. It includes great blog comment functionality, and trackback spam prevention to help keep your experience clean.


Q: What happens to my Windows Live Spaces content and what can I migrate?
A: Here's a list of different functionality available on Windows Live Spaces today and what you can expect:

  • Blogs and comments: If you choose to migrate or download, your blog content (including inserted photos, videos and comments) comes with you.
  • Photos: Photos not part of your blog but part of Windows Live will continue to live on SkyDrive and, if you choose, you can continue to share them with others. Photos that were part of your blog will be migrated if you choose to migrate your blog. If you add any other modules provided by other services that shared your photos, those will not be migrated.
  • Visitors will know where to find you: If you migrate, existing links to your blog and specific articles will continue to work and your visitors will be redirected to your new location on WordPress.com. You'll also be able to keep your friends up to date with your latest posts on Windows Live Messenger.          
  • Private blogs: If you have a private blog, your blog will be checked as private unless you choose another option during migration. You'll be able to share your blog back with your Windows Live Messenger friends or just choose to select a few people to invite to WordPress.com.
  • Gadgets, guestbook, lists, notes, and draft posts: Unfortunately, you won't be able to move these. You might consider publishing your draft posts over the coming months and moving content in lists and notes into your blog before migrating.
  • Profile and Contacts modules: That information stays on Windows Live. You can add your new blog to your Profile and share it with your friends.


Q: What can I expect between now and the date Windows Live Spaces closes?
A: Starting at the end of September 2010, when you visit your space you'll be given the opportunity to upgrade your blog by migrating it to WordPress.com and to download your content to save for later. Your space will continue to be available for you to publish to. As of January 4th, 2011, you will lose the ability to make changes to your Windows Live Spaces blog, but you can continue to review past posts, download your content to save for later and upgrade your blog to WordPress.com. On March 16th, 2011, Windows Live Spaces will close and you will not be able to access or migrate your blog.


Q: Where can I learn more?
A: Are you a parent of a child who uses Windows Live Spaces? Do you have a private blog? Do you use Writer to publish to Windows Live Spaces? Do you have other questions? Please visit our Help Center for additional information and resources.


Eu mostrarei a seguir como fazer a migração:

1) Clique no link logo na primeira página:
Clique em "Começar"
 2) Você será avisado de que as listas, gadgets, recados e rascunhos não serão portados e isso é irreverível. "E eu tenho escolha?" Vamo que vamo.

        
3) Quando solicitar que você se logue, use seu login do live spaces.

4) Escolha domínio, título, linguagem e fuso horário.

5) Clique em "Criar Blog" e seja o que Deus quiser.


Depois de passada a barra de progresso você terá um novo blog (ou não) http://vitorrubio.wordpress.com/

Acho que vou aproveitar o blog novo, já que o wordpress é infinitamente melhor que o live spaces, e vou postar nele todos os assuntos referentes a reflexões, protestos, reclamações etc. Assim eu deixo este blog dedicado apenas à programação.

Have fun (ou não) :p

Olá, mundo!

Welcome to WordPress.com. This is your first post. Edit or delete it and start blogging!

sexta-feira, 22 de outubro de 2010

Barrinha Social Wibia

Sabe essa barrinha de ferramentas vista no rodapé deste blog? Ela é feita pelo site http://www.wibiya.com/

Entre no site, cadastre-se e aqui você poderá instalá-la. O site publicará um widget no seu blogspot, a única coisa que você precisa fazer agora é coloca o widget em um lugar mais apropriado e talvez remover o título.




Será colocado um script como esse

<script src="http://cdn.wibiya.com/Toolbars/dir_[[dir id]]/Toolbar_[[seu id]]/Loader_[[seu id]].js" type="text/javascript"></script>

No próximo post falaremos da barra do meebo

Até lá ;)

Hook sem usar bibliotecas externas

Hooking, ou API Hooking é quando substituimos a entrada de um método qualquer por um método nosso. Assim todas as chamadas de um determinado método chamarão na verdade o método novo.

Existem outras técnicas e bibliotecas para fazer isso. Para dizer a verdade eu não sou expert nesse assunto. Geralmente as bibliotecas tem uma opção/função de callback onde você armazena uma referência à função original, assim pode chamar a função original dentro da substituta, antes ou depois do seu próprio código, para que ela possa ser mais parecida ou equivalente à original, com pouco esforço da sua parte.

Nesta biblioteca que fizemos aqui nós não temos essa opção. Uma vez substituindo a função original  não teremos mais acesso a ela, só a nova, até o momento do UnHook. Além disso não podemos chamar a função original, apenas a nova. Chamar a original dentro da nova é como a nova chamar ela mesma, e isso resulta em loop recursivo e stack overflow.

Isso significa que você é obrigado a sobrescrever inteiramente a lógica da nova.

Esses tipos, funções de API e algoritmos eu retirei (copiei) de sites que fazem patches em bugs da VCL para versões antigas do Delphi, ou que fazem substituições ao Memory Manager. O FastMM por exemplo tem um código muito parecido com esse para substituir o memory manager nativo do delphi pelo proposto por eles.

Não entendo plenamente como e porque funciona isso aqui, mas .... funciona. Quem puder me dar uma ajuda para elucidar e complementar esse assunto aqui neste blog agradeço.

Abaixo o código que eu dei uma alterada:
unit uLazHook;
{**************************************************************************************************}
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ The Original Code is VCLFixPack.pas.                                                             }
{                                                                                                  }
{ The Initial Developer of the Original Code is Andreas Hausladen (Andreas.Hausladen@gmx.de).      }
{ Portions created by Andreas Hausladen are Copyright © 2008 Andreas Hausladen.                  }
{ All Rights Reserved.                                                                             }
{                                                                                                  }
{**************************************************************************************************}

{$mode objfpc}{$H+}

{$R-} // range check off
interface

type

  //abaixo alguns tipos de estruturas para obter informações da função ReadProcessMemory
  TJumpOfs = Integer;
  PPointer = ^Pointer;

  //esse serve para armazenar a distância entre os pontos de entrada da função original e da sua
  PXRedirCode = ^TXRedirCode;
  TXRedirCode = packed record
    Jump: Byte;
    Offset: TJumpOfs;
  end;

  //não faço idéia ;P
  PWin9xDebugThunk = ^TWin9xDebugThunk;
  TWin9xDebugThunk = packed record
    PUSH: Byte;
    Addr: Pointer;
    JMP: TXRedirCode;
  end;

  //menos ainda
  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   //$FF25(Jmp, FF /4)
    Addr: PPointer;
  end;

  { TLazHook }
  TLazHook = class
  private
         FProc: Pointer;
         FDestinationProc: Pointer;
         FBackupRedirCode: TXRedirCode;
  public
        constructor Create(Proc, Dest: Pointer);
        destructor Destroy; override;
  end;


implementation
uses
  SysUtils,
  Windows,
  Classes;



//obtem o endereço do método baseado no tipo de SO
function GetActualAddr(Proc: Pointer): Pointer;

  function IsWin9xDebugThunk(AAddr: Pointer): Boolean;
  begin
    //não faço idéia do que significam esses endereços
    Result := (AAddr <> nil) and
              (PWin9xDebugThunk(AAddr)^.PUSH = $68) and
              (PWin9xDebugThunk(AAddr)^.JMP.Jump = $E9);
  end;

begin
  if Proc <> nil then
  begin
    if (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
      Proc := PWin9xDebugThunk(Proc)^.Addr;
    //não faço idéia do que significa esse $25ff
    if (PAbsoluteIndirectJmp(Proc)^.OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc)^.Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;


//cria o hook (substitui uma função na memória pela sua)
procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
  n: DWORD;
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);
  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
  begin
    //não sei porque deve ser $E9 nem o que significa, só sei que é 233 em hexadecimal
    Code.Jump := $E9;
    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;

//faz voltar ao normal
procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
  n: Cardinal;
begin
  if (BackupCode.Jump <> 0) and (Proc <> nil) then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);
    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
    BackupCode.Jump := 0;
  end;
end;




{ TLazHook }

//atalho para criar o hook com a facilidade de se usar uma classe
constructor TLazHook.Create(Proc, Dest: Pointer);
begin
     FProc:=Proc;
     FDestinationProc:=Dest;
     HookProc(FProc ,FDestinationProc, FBackupRedirCode);
end;

//destruindo o hook e voltando a procedure ao normal
destructor TLazHook.Destroy;
begin
  UnhookProc(FProc, FBackupRedirCode);
  inherited Destroy;
end;

end.


Agora o código usado para testar o Hook. Repare que são necessários 3 passos:
1) Definir a sua propria função, que deve ter a mesma assinatura que a função (método ou procedimento) hookada/substituída.
2) Criar o objeto de Hook passando como parâmetro ponteiros para os métodos de origem e destino e manter uma referência a este objeto até a hora de destruí-lo
3) quando o hook não for mais necessário ou no momento de fechar o programa devemos desfazer o hook.

No exemplo eu uso uma função com a mesma assinatura que a ShowMessage, chamada MyShowMessage, mas que internamente usa a messagebox, para substituir a ShowMessage. Eu comentei esse exemplo e abaixo fiz outro mais complexo, o contrário: eu sobrescrevo a api do windows MessageBox com uma função minha de mesma assinatura mas com chamada ao ShowMessage internamente. É importante aqui o uso de stdcall para indicar a ordem correta dos argumentos da função, pois a api do windows foi feita em C/C++.

unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, uLazHook, windows;

type

  { TfrmHook }

  TfrmHook = class(TForm)
    btCriaHook: TButton;
    btMetodoOriginal: TButton;
    btMeuMetodo: TButton;
    btDestroiHook: TButton;
    procedure btCriaHookClick(Sender: TObject);
    procedure btMetodoOriginalClick(Sender: TObject);
    procedure btMeuMetodoClick(Sender: TObject);

  private
    { private declarations }
  public
    { public declarations }
    FHook: TLazHook;
  end;


var
  frmHook: TfrmHook;

  //minha procedure personalizada
  procedure MyShowMessage(const aMsg: string);
  function MyMessageBox(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; stdcall; //stdcall pq a api foi feita em C


implementation

//minha procedure personalizada
procedure MyShowMessage(const aMsg: string);
begin

     //algo feito no início

     //chamada a procedure original
     MessageBox(0, pchar(aMsg), 'Mensagem', MB_ICONINFORMATION);

     //algo feito no fim

end;

function MyMessageBox(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; stdcall;
begin
     ShowMessage(string(lpText));
     Result := 0;
end;

{ TfrmHook }

procedure TfrmHook.btCriaHookClick(Sender: TObject);
begin
     {
     FHook := TLazHook.Create(
           @ShowMessage, //ponteiro para a procedure original (seu código vai ser copiado na procedure acima)
           @MyShowMessage //procedure Destino, a que fizemos para substituir
     );
     }

     FHook := TLazHook.Create(
           @MessageBox, //ponteiro para a procedure original (seu código vai ser copiado na procedure acima)
           @MyMessageBox //procedure Destino, a que fizemos para substituir
     );
end;

procedure TfrmHook.btMetodoOriginalClick(Sender: TObject);
begin
     //ShowMessage('Hello World');
     MessageBox(0, 'Hello World', 'Mensagem', 0);
end;

procedure TfrmHook.btMeuMetodoClick(Sender: TObject);
begin
  //MyShowMessage('Hello World');
  MyMessageBox(0, 'Hello World', 'Mensagem', 0);
end;



initialization
  {$I unit1.lrs}

end.


Nesse exemplo só podemos hookar/enganchar/sobrescrever (não faço idéia do termo correto em português) funções no próprio processo e não no windows inteiro. Ainda não sei fazer a parte de injeção de "código" em dll's.
Funciona em Delphi e Lazarus. Para alternar entre os exemplos descomente os de cima e comente os de baixo.

Faça o download e divirta-se ;)

quinta-feira, 21 de outubro de 2010

Tweet Button oficial no blogspot

Há outras formas de colocar o Tweet Button no seu blog. Eu vou abordar  a mais "complicada" ;)

Ao editar o HTML do blogspot você o faz na verdade em XML. É um formato de XML que dirá ao mecanismo do blogger como será seu HTML depois. E esse XML aceita alguns "comandos" como veremos.

O botão Tweet é uma tag de âncora de hiperlink <a> comum que além dos atributos class e href possui esses atributos especiais, tradados pelo script que vem junto:


data-count='vertical'  --> tipo de contador: pode ser vertical, horizontal ou none
data-via='vitorrubio' --> seu nome  no twitter
data-text='titulo do post'  --> título do post :p
data-url='url do post' --> url do post ;)



Dentro de marcadores de tags < > você não pode colocar outros marcadores como estes. E para obter automaticamente o titulo do post e a url devemos usar os já ditos "comandos" do blogspot.

Para obter o títilo do post você deve utilizar data:post.title e para obter a url você deve utilizar data:post.url.

No entanto para utilizar os comandos citados você não pode simplesmente atribuí-los aos atributos, mas deve preceder os nomes dos atributos com "expr:" para que eles possam ser "calculados" antes de "montados".

Ou seja, colocar:



data-text='data:post.title'  
data-url='data:post.url' 
Estará errado pois fará com que seu título se torne a palavra "data:post.title" e a url seja a expressão "data:post.url" em vez dos respectivos título e endereço corretos. Você deve preceder os atributos com expr: assim:

expr:data-text='data:post.title' 
expr:data-url='data:post.url' 

Se quiser "concatenar" ou adicionar algo mais no titulo deve "somar" com a sua mensagem envolvendo em aspas, mas deve usar "&quot;" uma "html entitie" que se tornará aspas depois do cálculo. Não use aspas "de verdade"

expr:data-text='data:post.title + &quot; algo mais que eu queira dizer &quot;' 
expr:data-url='data:post.url' 

O código completo "normal" ficará assim:

<a 
  class='twitter-share-button' 
  data-count='vertical' 
  data-via='vitorrubio' 
  expr:data-text='data:post.title' 
  expr:data-url='data:post.url' 
  href='http://twitter.com/share'>Tweet</a>
   <script src='http://platform.twitter.com/widgets.js' type='text/javascript'></script>


Com o resultado:




O código com "um algo mais" ficará assim:

<a 
  class='twitter-share-button' 
  data-count='vertical' 
  data-via='vitorrubio' 
  data-text='Teste de Tweet Button no Blogspot' 
  expr:data-url='data:post.url' 
  href='http://twitter.com/share'>Tweet</a>
<script src='http://platform.twitter.com/widgets.js' type='text/javascript'></script>

Com o resultado:





Espero ter ajudado ;)

Clube Delphi número 122

Pela primeira vez a Revista Clube Delphi traz em sua capa um artigo sobre Lazarus e Free Pascal. Para quem não conhece o Lazarus trata-se de uma IDE para se trabalhar com Free Pascal e auxiliar o Desenvolvimento RAD ou OO de uma maneira muito semelhante ao Delphi 7.

O Compilador AINDA não tem todos os recursos que o moderno compilador do Delphi XE, como generics por exemplo, mas isso não é um impedimento. Já é possível criar aplicações robustas em Lazarus.

Na capa podemos ver um lindo Guepardo. Para quem não sabe a diferença entre Guepardo e Leopardo veja aqui.

Para quem gosta de POO e Design Patterns foi publicado um artigo meu, a ser dividido em 3 partes, sobre Abstract Factory e Factory Methods. No começo do artigo é explicado como criar classes e formulários de acordo com variáveis externas, sem usar nenhum IF. O que fazemos é delegar a responsabilidade de criar uma instância de um objeto a alguém que realmente saiba como criar e preparar esse objeto. Assim nós podemos isolar a classe que precisa de um objeto de uma linhagem ou interface qualquer da unidade que a implementa concretamente.

Na última parte falaremos sobre como criar uma aplicação totalmente independente de Banco de Dados e de Tecnologia de Acesso (componente) utilizando estas tecnicas.

Espero que todos tenham uma agradável leitura ;)

quarta-feira, 20 de outubro de 2010

Obtendo atributos de arquivos com o Lazarus

Como saber se um arquivo é oculto, de sistema, somente leitura e tal? Como saber a data de criação e última alteração de um arquivo?

E para saber se é arquivo, diretório ou unidade?

Criamos essa pequena classe no Lazarus (e por extensão Delphi) onde você passa um arquivo qualquer e ela te identifica quais são os atributos e ainda pode mudar alguns dos atributos em runtime.

A classe ainda não está completa, a idéia é expandi-la, mas ela já é bastante funcional. É muito mais fácil e intuitivo usar uma classe do que a API do Windows.

A classe:
unit uLazFile;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, windows;

type

  { TLazFile }

  TLazFile = class
  private
    FFileName: string;
    function Attributes: word;
    procedure Verify;
    //gets
    function GetFileName: string;
    function GetAttributeFile: boolean;
    function GetAttributeHidden: boolean;
    function GetAttributeSystem: boolean;
    function GetAttributeReadOnly: boolean;
    function GetAttributeDirectory: boolean;
    function GetAttributeVolume: boolean;

    function GetFileCreationDate: TDateTime;
    function GetLastFileAccessDate: TDateTime;
    function GetLastWriteFileDate: TDateTime;
    function GetFileSize: int64;
    //sets
    procedure SetFileName(const value: string);
    procedure SetAttributeFile(const value: boolean);
    procedure SetAttributeHidden(const value: boolean);
    procedure SetAttributeSystem(const value: boolean);
    procedure SetAttributeReadOnly(const value: boolean);
  public
    constructor Create(const filename: string);   overload;
    constructor Create; overload;
  published
    property  AttributeFile: boolean read GetAttributeFile write SetAttributeFile;
    property  AttributeHidden: boolean read GetAttributeHidden write SetAttributeHidden;
    property  AttributeSystem: boolean read GetAttributeSystem write SetAttributeSystem;
    property  AttributeReadOnly: boolean read GetAttributeReadOnly write SetAttributeReadOnly;
    property  IsDirectory: boolean read GetAttributeDirectory;
    property  IsVolume: boolean read GetAttributeVolume;
    property  FileName: string read GetFileName write SetFileName;

    property  FileCreationDate: TDateTime read GetFileCreationDate;
    property  LastFileAccessDate: TDateTime read GetLastFileAccessDate;
    property  LastWriteFileDate: TDateTime read GetLastWriteFileDate;
    property  FileSize: int64 read GetFileSize;
  end;


implementation

{ TLazFile }

Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
var
  lft : TFileTime;
begin
  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
                FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
end;

function TLazFile.Attributes: word;
begin
     Verify;
     Result := FileGetAttr(FFileName);
end;

procedure TLazFile.Verify;
begin
       if (FFileName = '') then
        raise Exception.Create('File Inexistente.');
end;

function TLazFile.GetFileName: string;
begin
  Result := FFileName;
end;

function TLazFile.GetAttributeFile: boolean;
begin
     Result := (Attributes and faArchive) = faArchive
end;

function TLazFile.GetAttributeHidden: boolean;
begin
     Result := (Attributes and faHidden) = faHidden
end;

function TLazFile.GetAttributeSystem: boolean;
begin
     Result := (Attributes and faSysFile) = faSysFile;
end;

function TLazFile.GetAttributeReadOnly: boolean;
begin
     Result := (Attributes and faReadOnly) = faReadOnly;
end;

function TLazFile.GetAttributeDirectory: boolean;
begin
     Result := (Attributes and faDirectory) = faDirectory;
end;

function TLazFile.GetAttributeVolume: boolean;
begin
     Result := (Attributes and faVolumeId) = faVolumeId;
end;

function TLazFile.GetFileCreationDate: TDateTime;
var
  Handle: THandle;
  FindData: TWin32FindData;
  temp: Longint;
begin
  Handle := FindFirstFile(Pchar(FFileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Handle);
        If WinToDosTime(FindData.ftCreationTime,temp) then
          Result := FileDateToDateTime(temp);
    end
    else
        Result := 0;
end;

function TLazFile.GetLastFileAccessDate: TDateTime;
var
  Handle: THandle;
  FindData: TWin32FindData;
  temp: Longint;
begin
  Handle := FindFirstFile(Pchar(FFileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Handle);
        If WinToDosTime(FindData.ftLastAccessTime,temp) then
          Result := FileDateToDateTime(temp);
    end
    else
        Result := 0;

end;

function TLazFile.GetLastWriteFileDate: TDateTime;
var
  Handle: THandle;
  FindData: TWin32FindData;
  temp: Longint;
begin
  Handle := FindFirstFile(Pchar(FFileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Handle);
        If WinToDosTime(FindData.ftLastWriteTime,temp) then
          Result := FileDateToDateTime(temp);
    end
    else
        Result := 0;

end;



function TLazFile.GetFileSize: int64;
var
  Handle: THandle;
  FindData: TWin32FindData;
begin
  Handle := FindFirstFile(Pchar(FFileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Handle);
      Result := FindData.nFileSizeHigh;
      Result := Result shl 32;
      Result := Result + FindData.nFileSizeLow;
    end;
end;


procedure TLazFile.SetFileName(const value: string);
begin
  FFileName:= value;
end;

procedure TLazFile.SetAttributeFile(const value: boolean);
begin
     Verify;
     if value then
        FileSetAttr(FFileName, Attributes or faArchive)
     else
        FileSetAttr(FFileName, Attributes and not faArchive);
end;

procedure TLazFile.SetAttributeHidden(const value: boolean);
begin
     Verify;
     if value then
        FileSetAttr(FFileName, Attributes or faHidden)
     else
         FileSetAttr(FFileName, Attributes and not faHidden)

end;

procedure TLazFile.SetAttributeSystem(const value: boolean);
begin
     Verify;
     if value then
        FileSetAttr(FFileName, Attributes or faSysFile)
     else
         FileSetAttr(FFileName, Attributes and not faSysFile)
end;

procedure TLazFile.SetAttributeReadOnly(const value: boolean);
begin
     Verify;
     if value then
        FileSetAttr(FFileName, Attributes or faReadOnly)
     else
         FileSetAttr(FFileName, Attributes and not faReadOnly)
end;

constructor TLazFile.Create(const filename: string);
begin

  FFileName:= filename;
end;

constructor TLazFile.Create;
begin

end;

end.



Modo de usar
unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, uLazFile;

type

  { TForm1 }

  TForm1 = class(TForm)
    btLeSomenteLeitura: TButton;
    btLeSistema: TButton;
    btLeEscondido: TButton;
    btLeArquivo: TButton;
    btSetaSomenteLeitura: TButton;
    btSetaSistema: TButton;
    btSetaEscondido: TButton;
    btSetaArquivo: TButton;
    btVerificaDiretorio: TButton;
    btVerificaUnidade: TButton;
    btInformacoes: TButton;
    edArquivo: TEdit;
    Label1: TLabel;
    procedure btInformacoesClick(Sender: TObject);
    procedure btLeArquivoClick(Sender: TObject);
    procedure btLeEscondidoClick(Sender: TObject);
    procedure btLeSistemaClick(Sender: TObject);
    procedure btLeSomenteLeituraClick(Sender: TObject);
    procedure btSetaArquivoClick(Sender: TObject);
    procedure btSetaEscondidoClick(Sender: TObject);
    procedure btSetaSistemaClick(Sender: TObject);
    procedure btSetaSomenteLeituraClick(Sender: TObject);
    procedure btVerificaDiretorioClick(Sender: TObject);
    procedure btVerificaUnidadeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    Arquivo: TLazFile;
  end; 

var
  Form1: TForm1; 

implementation

{ TForm1 }

procedure TForm1.btLeSomenteLeituraClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.AttributeReadOnly));
end;

procedure TForm1.btSetaArquivoClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  Arquivo.AttributeFile:= not Arquivo.AttributeFile;
end;

procedure TForm1.btSetaEscondidoClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  Arquivo.AttributeHidden:= not Arquivo.AttributeHidden;
end;

procedure TForm1.btSetaSistemaClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  Arquivo.AttributeSystem:= not Arquivo.AttributeSystem;
end;

procedure TForm1.btSetaSomenteLeituraClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  Arquivo.AttributeReadOnly:= not Arquivo.AttributeReadOnly;
end;



procedure TForm1.btVerificaDiretorioClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.IsDirectory));
end;

procedure TForm1.btVerificaUnidadeClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.IsVolume));
end;

procedure TForm1.btLeSistemaClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.AttributeSystem));
end;

procedure TForm1.btLeEscondidoClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.AttributeHidden));
end;

procedure TForm1.btLeArquivoClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.AttributeFile));
end;

procedure TForm1.btInformacoesClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(
              'Data Criação ' + DateTimeToStr(Arquivo.FileCreationDate) + #13#10 +
              'Data Modificação ' + DateTimeToStr(Arquivo.LastWriteFileDate) + #13#10 +
              'Data Ultimo Acesso ' + DateTimeToStr(Arquivo.LastFileAccessDate) + #13#10 +
              'Tamanho ' + IntToStr(Arquivo.FileSize) + #13#10
  );

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     Arquivo := TLazFile.Create;
end;

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

initialization
  {$I unit1.lrs}

end.




Download

Have fun ;)

terça-feira, 19 de outubro de 2010

Códigos de versões do Delphi e Diretivas de compilação

Sabe aqueles componentes feitos para múltiplas versões do Delphi que tem várias diretivas para saber qual é a versão do Delphi e assim mudar o código em tempo de compilação?

Segue abaixo uma lista das diretivas de compilação/comnplicação :)

São mais ou menos assim:
{$IFDEF VER210}
//algum código aqui compatível com essa versão
{$ELSE}
//outro código genérico
{$ENDIF}

Seguem abaixo os códigos das versões:


VER80 - Delphi 1
VER90 - Delphi 2
VER100 - Delphi 3
VER120 - Delphi 4
VER130 - Delphi 5
VER140 - Delphi 6
VER150 - Delphi 7
VER160 - Delphi 8
VER170 - Delphi 2005
VER180 - Delphi 2006
VER180 - Delphi 2007
VER185 - Delphi 2007
VER200 - Delphi 2009
VER210 - Delphi 2010
VER220 - Delphi XE

É útil para você criar bibliotecas que compilem tanto em Delphi como em Lazarus, pois você pode usar um {$IFDEF FPC}.

Tente rodar o exemplo abaixo nos Delphis 2010, XE e 7.


procedure TForm1.Button1Click(Sender: TObject);
begin
{$IFDEF VER210}
  ShowMessage('Delphi 2010');
{$ELSE}
  {$IFDEF VER220}
    ShowMessage('Delphi XE');
  {$ELSE}
    ShowMessage('Whatever Version');
  {$ENDIF}
{$ENDIF}
end;

Happy Coding ;)

12° Congresso de Tecnologia FATEC-SP

Esta semana está rolando o 12° Congresso de Tecnologia FATEC-SP (Av. Tiradentes / Rua três rios, proximo ao metrô tiradentes)

Ontem dei uma passada lá só pra ver o movimento (tá certo, eu tava perdido e sem programação). Legal foi eu encontrar vários colegas da Adv Tecnologia (grande abraço pra todos vocês) que estavam só de passagem também. :)

Hoje vai rolar um evento bastante interessante: palestra sobre XBOX e Kinect pelo MVP Maurício Alegretti e eu assistirei.

Amanhã rola uma palestra interessante também sobre windows phone 7. Infelizmente perderei esta. Quem assistir e quiser me passar o que foi abordado agradeço.

É isso aí, para quem for, nos vemos lá :)


Mais informações em:
http://www.fatecsp.br/
http://www.objectiveclub.com.br/

IIF

Quem já programou em Clipper e Visual Fox Pro deve lembrar da função IIF. Esta função simplesmente aceitava três parâmetros, um booleano, ou condição, e dois valores, caso verdadeiro e caso falso.
Ela era interessante porque substituia (em partes) o operador ternário ?: do C e poderia ser usada em expressões para se somar ou concatenar o valor correto dependendo da condição.
Ela servia para substituir um if ... else e uma variável temporária colocando tudo na mesma linha.

O seu formato era:

iif(condição, valor se verdadeiro, valor se falso): valor;

Ela retornava um valor que seria do mesmo tipo do segundo e terceiro argumento.

É possível criar inúmeras variantes dessa função, tanto no Lazarus como no Delphi. Usando variants poderiamos  criar uma vertente da função que funcionaria para qualquer tipo de dado primitivo.

Mas o Delphi é ainda mais flexível porque hoje temos Generics e o tipo TValue, que são mais flexíveis ainda. Com Generics, Variants e sobrecarga de operadores podemos utilizar sim qualquer tipo de valor, classes, objetos instanciados e assim por diante. Além disso, com expressões lambda e funções "inline" podemos inclusive colocar função/execução de código no IIF o que extrapola o seu objetivo de substituir o operador ternário. Ele se torna realmente um if...else. Esse tipo de coisa poderíamos fazer nas versões antigas do Delphi e no Lazarus apenas com ponteiros para métodos.

Esse código abaixo mostra um exemplo da função IIF e seu uso, inclusive com generics nas versões modernas do Delphi.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

function iif(condicao: Boolean; ValorVerdadeiro, ValorFalso: T): T;

implementation

{$R *.dfm}

function iif(condicao: Boolean; ValorVerdadeiro, ValorFalso: T): T; 
begin
  if condicao then
    Result := ValorVerdadeiro
  else
    Result := ValorFalso;
end;

function iif(condicao: Boolean; ValorVerdadeiro, ValorFalso: string): string;
begin
  if condicao then
    Result := ValorVerdadeiro
  else
    Result := ValorFalso;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  a,b, resultado: string;
  x,y: integer;
  debita: boolean;
begin

  a := 'Clube';
  b := 'Delphi';

  x := 1;
  y := 2;

  debita := true;
  resultado:= inttostr(iif(debita, y-1, y+1));
  ShowMessage(resultado);

  debita := false;
  resultado:= inttostr(iif(debita, y-1, y+1));
  ShowMessage(resultado);

  resultado:= iif(x=y, 'x é igual a y', 'x é diferente de y');
  ShowMessage(resultado);

  x := y;
  resultado:= iif(x=y, 'x é igual a y', 'x é diferente de y');
  ShowMessage(resultado);

  resultado:= iif((a<>'')and (b<>''), a + ' ' + b , 'um dos dois é vazio');
  ShowMessage(resultado);

  a := '';
  resultado:= iif((a<>'')and (b<>''), a + ' ' + b , 'um dos dois é vazio');
  ShowMessage(resultado);

  resultado:= iif(a=b, 'a e b são iguais', 'a e b são diferentes');
  ShowMessage(resultado);

end;

end.



Aqui criamos apenas duas versões, uma com generics (que funcionará para tudo) e uma com strings. Poderíamos criar com variants ou qualquer outra coisa.

Uma alteração interessante que pode ser feita também é declarar os argumentos/parâmetros das funções como const, assim eles não poderão ser temporariamente modificados por expressões lambda ou código dentro do corpo de IIF.


function iif(const condicao: Boolean; const ValorVerdadeiro, ValorFalso: T): T;

{...}

function iif(const condicao: Boolean; const ValorVerdadeiro, ValorFalso: T): T; 
begin
  if condicao then
    Result := ValorVerdadeiro
  else
    Result := ValorFalso;
end;


Espero que seja útil para todos. Pelo menos saudosista é ;)

Postagens populares

Marcadores

delphi (60) C# (31) poo (21) Lazarus (19) Site aos Pedaços (15) sql (13) Reflexões (10) .Net (9) Humor (9) javascript (9) ASp.Net (8) api (8) Básico (6) Programação (6) ms sql server (5) Web (4) banco de dados (4) HTML (3) PHP (3) Python (3) design patterns (3) jQuery (3) livros (3) metaprogramação (3) Ajax (2) Debug (2) Dicas Básicas Windows (2) Pascal (2) games (2) linguagem (2) música (2) singleton (2) tecnologia (2) Anime (1) Api do Windows (1) Assembly (1) Eventos (1) Experts (1) GNU (1) Inglês (1) JSON (1) SO (1) datas (1) developers (1) dicas (1) easter egg (1) firebird (1) interfaces (1) introspecção (1) memo (1) oracle (1) reflexão (1)