Illegal unit name Calendar

Na postagem anterior sobre esse problema, eu recomendei renomear a unit Calendar e alterar todos os fontes que a utilizava.

Fazendo alguns testes para Windows Mobile, deu o mesmo problema com uma versão mais recente do lazarus.

Desta vez, ao invés de renomear a unit, eu fiz o seguinte:

Na unit Calendar.pp, exclui as seguintes linhas:

{
@abstract(Calendar component)
@author(Shane Miller)
@created(05 Dev 2001)
}

A partir dai, resolveu o problema de illegal unit name, mas deu outro erro:
"Search CalendarPopup, but found Calendar"

A unit Calendar.pp fica na pasta lazarus\lcl\ e a unit CalendarPopup na pasta -lazarus\lcl\forms

Então, alterei o arquivo fpc.cfg, acrescentei os path abaixo, na seção searchpath for units

-FuC:\lazarus\lcl
-FuC:\lazarus\lcl\forms

A partir dai, compilou normalmente.

Até a proxima.

illegal unit name Calendar

O lazarus é uma ferramenta em constante evolução, e por isso as vezes ocorre uns erros muito estranhos, bugs que parecem impossivel de resolver ou remediar.

Ontem baixei o snapshot revisão 27259 fpc 2.4.0. A instalação ocorreu normalmente.

O problema foi quando tentava instalar o pacote sqlite3dataset e deu o erro de illegal unit name Calendar.

Nunca tinha visto esse tipo de erro, então mudei o nome para calendar minusculo, tambem não resolveu.

Depois de muito pesquisar no google, não encontrei a solução para o problema. As vezes deve ser até coisa simples, mas eu não consegui resolver de forma elegante.

A solução que eu encontrei foi renomear a unit Calendar para Calendar2 (calendar2.pp).

Claro que tive que alterar todas as ocorrencias de Calendar para calendar2, mas o mais importante é que deu certo!

Se alguem está passando por esse problema, não desista, tenha paciencia e altere o nome da unit.

Se alguem tiver a solução correta para esse problema, por favor poste aqui para nosso conhecimento.

Até a próxima.

Simulando um keybd_event

Nos meus programas em Delphi, algumas vezes, se fez necessário simular o pressionamento de uma tecla num TEdit que ainda não recebeu o foco.

Por exemplo:

procedure TFormPegaProdutos.DBGrid1KeyPress(Sender: TObject;
var Key: Char);
begin

//Testa se pressionou um tecla valida
if not (key in ['0'..'9','/',#13,#27,'A'..'z']) Then key:=#0;
if key=#27 then close;

//Testa se pressionou um letra
if (key in ['A'..'Z']) or (key in ['a'..'z']) Then
begin
//Abre um painel para digitacao do nome do item a pesquisar
. PanelPesquisa.Top:=80;
. PanelPesquisa.Left:=160;
. PanelPesquisa.visible:=True;
. Palavra1.setfocus;
. if (key in ['a'..'z']) Then Key:=chr(trunc(ord(Key))-32);
. keybd_event(trunc(Ord(Key)),0,0,0);
end;
if key in ['0'..'9'] Then
begin
. PanelVenda.Top:=80;
. PanelVenda.Left:=60;
. PanelVenda.visible:=True;
. ValorUni.Text:=FormatCurr('#0.00',ProTEMPP_VIS.AsCurrency);
. QTD.setfocus;
. keybd_event(trunc(Ord(Key)),0,0,0);
end;

...ou seja, na lista de itens (dbgrid1) o usuario pode abrir um painel de pesquisa de um novo item sem sair da lista, e ainda pode registrar uma venda do item, sem sair da lista, o que é, diga-se de passagem, muito prático.

Mas no lazarus não temos disponivel o keybd_event, então como resolver esse problema?

Criei uma simples procedure:

procedure keybd_event_on(EditControl:TEdit; var key: char);
begin
EditControl.Text:=key+' ';
EditControl.setfocus;
EditControl.SelStart:=1;
EditControl.SelLength:=1;
end;

Pronto!

Agora, posso continuar portando meus programas pro lazarus :-)
Não é por causa de um keybd_event que o projeto vai parar!

procedure TFormPegaProdutos.DBGrid1KeyPress(Sender: TObject;
var Key: Char);
begin

//Testa se pressionou um tecla valida
if not (key in ['0'..'9','/',#13,#27,'A'..'z']) Then key:=#0;
if key=#27 then close;

//Testa se pressionou um letra
if (key in ['A'..'Z']) or (key in ['a'..'z']) Then
begin
//Abre um painel para digitacao do nome do item a pesquisar
. PanelPesquisa.Top:=80;
. PanelPesquisa.Left:=160;
. PanelPesquisa.visible:=True;
. Palavra1.setfocus;
. if (key in ['a'..'z']) Then Key:=chr(trunc(ord(Key))-32);
. keybd_event(trunc(Ord(Key)),0,0,0);
. keybd_event_on(Palavra1,Key);
end;
if key in ['0'..'9'] Then
begin
. PanelVenda.Top:=80;
. PanelVenda.Left:=60;
. PanelVenda.visible:=True;
. ValorUni.Text:=FormatCurr('#0.00',ProTEMPP_VIS.AsCurrency);
. QTD.setfocus;
.//keybd_event(trunc(Ord(Key)),0,0,0);
. keybd_event_on(QTD,Key);
end;

O lazarus não é 100% compativel com o Delphi, mas ao depararmos com problemas como esse, não podemos desistir, sempre tem uma saida.

Seja livre!
Use lazarus/freepascal.

GERAOBJCODE - Simples gerador de codigo OOP

Pra quem esta começando na programação OOP, e não dispõem de nenhuma ferramenta auxiliar para geração de codigos, venho aqui disponibilizar uma ferramenta de minha autoria.

É um programa simples, mas que tem sido muito util pra mim.

GERAOBJCODE





Muito simples de usar, basta informar o nome da classe ou objeto, colocar as variaveis da classe/objeto na caixa codigo fonte do objeto e clicar em gerar propriedades e metodos.


Imagine que será necessário criar propriedades e metodos para os items abaixo:
Nome da classe: TObjetoTeste

Itens que compoem a nossa classe:




Codigo gerado pelo nosso GERAOBJCODE:








Criticas, elogios, deixem a sua mensagem.

Link para download dos fontes:
GERAOBJCODE

Até a próxima.

Build Lazarus com QT - problemas encontrados

Build Lazarus com QT no linux

A ide GTK2 está excelente, porem é muito lenta comparada com a IDE QT, por isso eu recomendo a todos aqueles que precisa de uma IDE mais agil que use o widget QT

Levando em conta que a solução a seguir foi o que resolveu pra mim. Eu uso o lazarus versão svn, e se encontra na pasta
/home/usuario/lazarus29-2svn/lazarus/

Quem instalou o lazarus a partir dos pacotes, normalmente o lazarus esta localizado em /usr/lib/lazarus.

Exclarecido esses pontos, continuemos.


Problemas encontrados

Mensagem de erro:

Unable to find file "osprinters.pas"

Solução:

Abra um terminal e localize a unit osprinters.pas:

no meu caso digitei:
find ~/lazarus29-2svn/lazarus -name "osprinters.pas"

Retornou:

/home/usuario/lazarus29-2svn/lazarus/components/printers/osprinters.pas

Agora abra o /etc/fpc.cfg

Acrescente o path de osprinters a seção searchpath for units

-Fu/home/usuario/lazarus29-2svn/lazarus/components/printers/


Mensagem de erro:

.../printers/osprinters.pas(47,8) Fatal: Can't open include file "qtprinters_h.inc"

Repita o mesmo procedimento, no terminal pesquise o arquivo com o find, e acrescente o path seção searchpath for includefiles de /etc/fpc.cfg assim:

-Fi/home/usuario/lazarus29-2svn/lazarus/components/printers/qt/


Agora é só:

Build LCL
Build IDE with packages

E pronto, problema resolvido.

Seja livre
Use lazarus!

FortesReport4Lazarus323

Comunico a todos que foi criado um novo projeto no sourceforge para o gerador de relatorios FortesReport4Lazarus

Esse projeto baseia-se na versão 3.23 do Fortes Report, mas com algumas melhorias e correções de bugs que foram feitas na versão 3.24 do Fortes4Lazarus:

.Modo draftfilter ok
.Exporta para html,pdf,excel
.Gera os relatorios mais rapidamente que na versão 3.24


A versão do Fortes4lazarus baseado na 3.24 está com um bug, que ainda não sabemos se é no Fortes4Lazarus ou na LCL, por isso recomendo a todos que voltem sua atenção para a versão 3.23.

Em breve estarei disponibilizando um projeto baseado na 3.24, que não finaliza, terminando a aplicação abruptamente, que é nosso bug, para que todos testem e deem sugestões.
O bug só ocorreu no windows, sendo que no linux o mesmo relatório funcionou normalmente.

Ainda não subi os fontes, mas em breve estarão disponiveis para todos.

O projeto Fortes4Lazarus precisa de contribuições para acelerar o desenvolvimento.

Se você é programador e tem um tempo livre, ajude a manter esses projetos, e assim fortalecer mais o nosso querido lazarus/freepascal.


Link para download da versão 3.23 no sourceforge:

FortesReport4Lazarus323

Seja livre
Use Lazarus/freepascal

Nova versão do Fortes4lazarus

Estou disponibilizando a comunidade uma nova versão do gerador de relatorios Fortes4Lazarus.

Essa ferramenta é um fork, uma adaptação, da versão 3.23 do FortesReport para delphi.

Não deixem de informar os bugs, pois tenho pouco tempo para testar toda a funcionalidade dos componentes.

Criticas ou sugestões serão bem vindas.

Link para Download do pacote:

Fortes323forlazarus

Seja livre!
Use lazarus/freepascal.

Até a próxima.

TCustomForm.ShowModal impossible

Explicação:

Você está tentando Showmodal em um form que esta visivel.

o form tem um Visible = True, e é isso que está causando o problema.

Solução:

Altere Visible = True para Visible = False

Pronto. Problema resolvido :-)

Seja livre!
Use lazarus/freepascal

TStringList - Uso da propriedade Values

Nesse post, vou apresentar um exemplo de uso da propriedade Values da classe TStringlist.

É muito comum precisarmos manter uma lista de variaveis totalizando campos numericos. O problema é que toda vez que precisamos de um novo totalizador, temos que criar uma nova variavel no programa.

Uma abordagem mais pratica dessa situação, é utilizar a classe TStringlist.
Nesse caso o TStringlist funcionará como um array, com a vantagem que seus elementos podem ser acessados pelo nome.


A propriedade Values

O TStringlist nos dá a opção de nomear elementos, associando seu respectivo valor, através do metodo Values.

Exemplo:

var
Lista1:TStringlist;
x:integer;
begin
Lista1:=TStringlist.Create;
for x:=1 to 5 do
begin
Lista1.Values['elemento'+inttostr(x)]:=inttostr(x*2);
end;

end;

Resultará em:
elemento1=2
elemento2=4
elemento3=6
elemento4=8
elemento5=10

Para acessar o valor de 'elemento3' basta executar:

Edit1.text:=Lista1.Values['elemento3'];

Que retornará a string '6'.

Pronto! Muito pratico não é mesmo?

Vamos então a um exemplo mais completo.

Para esse caso, criei duas funções:

function GetStringValue(svVar:string):Real;
procedure setStringValue(svVar:string;svValue:Real);

function GetStringValue(svVar:string):Real;
begin
Result:=StrtoFloat(CalcList.Values[svVar]);
end;

procedure setStringValue(svVar:string;svValue:Real);
begin
CalcList.Values[svVar]:=FloatToStr(svValue);
end;

A função GetStringValue retorna um valor convertido no tipo Real, de modo que podemos utilizar como totalizador, ou qualquer uso que desejar.

A função setStringValue cria/atribui um determinado valor a um elemento do Stringlist.

Exemplos:

setStringValue('total1',100); -> cria/atribui valor 100 a um elemento chamado total1

MinhaVariavelFloat:=GetStringValue('total1');-> atribui o 100 a MinhaVariavelFloat;

Agora incrementamos a variavel:

MinhaVariavelFloat:=MinhaVariavelFloat+20;

E atribuimos novamente ao elemento 'total1':
setStringValue('total1',MinhaVariavelFloat);

MinhaVariavelFloat:=GetStringValue('total1'); Resulta em 120

Espero que essas funções sirvam para você leitor, tanto quanto serviu pra mim.

Qualquer duvida, sugestão ou critica, fiquem a vontade para comentar.

Abaixo, o codigo fonte do nosso exemplo:

unit testa_strings_values0;
{$mode objfpc}{$H+}
interface

uses
   LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, Buttons, StdCtrls, ComCtrls;

type

   { TForm1 }

   TForm1 = class(TForm)
      calcular: TButton;
      box_varlist: TComboBox;
      box_operation: TComboBox;
      Criar_variavel: TButton;
      Edit_calcval: TEdit;
      Edit_valor1: TEdit;
      Edit_var1: TEdit;
      GroupBox1: TGroupBox;
      GroupBox2: TGroupBox;
      Label10: TLabel;
      Label11: TLabel;
      Label7: TLabel;
      Label8: TLabel;
      Label9: TLabel;
      ListBox1: TListBox;
      Memo1: TMemo;
      PageControl1: TPageControl;
      TabSheet1: TTabSheet;
      procedure calcularClick(Sender: TObject);
      procedure Criar_variavelClick(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      function GetStringValue(svVar:string):Real;
      procedure setStringValue(svVar:string;svValue:Real);
   private
      { Private declarations }
   public
      { Public declarations }
   end;

var
   Form1: TForm1;
   CalcList:TStringlist;

implementation

{$R *.lfm}


procedure TForm1.calcularClick(Sender: TObject);
var
V1,V2,V3:Real;
begin
Memo1.lines.add(   'Valor inicial...:'+CalcList.Values[box_varlist.Text]);
V1:=GetStringValue(box_varlist.Text);
V2:=StrToFloat(Edit_CalcVal.Text);

if box_operation.ItemIndex=0 then
begin
   Memo1.lines.add('Valor a somar...:'+Edit_CalcVal.Text);
   V3:=V1+V2;
end;

if box_operation.ItemIndex=1 then
begin
   Memo1.lines.add('Valor a subtrair:'+Edit_CalcVal.Text);
   V3:=V1-V2;
end;
setStringValue(box_varlist.Text,V3);
ListBox1.Items.Values[box_varlist.Text]:=FloatToStr(V3);
V1:=GetStringValue(box_varlist.Text);
Memo1.lines.add(' *-*-* Resultado='+FloatToStr(V1));
Memo1.lines.add(' ');

end;

function TForm1.GetStringValue(svVar:string):Real;
begin
Result:=StrtoFloat(CalcList.Values[svVar]);
end;

procedure TForm1.setStringValue(svVar:string;svValue:Real);
begin
CalcList.Values[svVar]:=FloatToStr(svValue);
end;

procedure TForm1.Criar_variavelClick(Sender: TObject);
begin
CalcList.Values[edit_var1.Text]:=edit_valor1.Text;
box_varlist.Items.Add(edit_var1.Text);
ListBox1.Items.Values[edit_var1.Text]:=edit_valor1.Text;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
CalcList:=TStringlist.Create;
Memo1.lines.Clear;
box_operation.ItemIndex:=-1;
box_varlist.ItemIndex:=-1;
end;

end.


A tela do nosso programinha, deve ficar assim:




Download dos Fontes:

Faça o download dos fontes aqui


Até a próxima.

Convertendo aplicações delphi facilmente

Fonte: Parallel Pascal Worlds

Os forms do Lazarus(FPC) estão mais compativeis do que nunca com Delphi.

A nova versão do 2.4.0/2.5.1 do FPC, lazarus e FPC permitem salvar os forms no formato LFM sem a necesidade dos arquivos LRS.

Esta mudança permite migrar facilmente um form Delphi para Lazarus.


Pré requisitos:

Versão trunk do Lazarus.
Versão trunk do FPC. A versão 2.4.0 tambem funcionou


Siga os passos abaixo:

1) Ir a Opcões de Projeto, tab miscelaneos e selecionar recursos FPC (FPC resources).




2) Copiar o arquivo dfm para um com extensão lfm.

3) Abrir o arquivo extensão pas relacionado no lazarus.

4) Procurar a referencia a arquivos dfm e substituir pelo siguinte código:

{$IFDEF LCL}
{$R *.lfm}
{$ELSE}
{$R *.dfm}
{$ENDIF}

5) Procurar a instrução que inclui o arquivo *.lrs na sessão de inicializacão da unit e remove-la.

6) Tecle F12 (para ver o arquivo lfm).

7) É possivel ignorar as advertências sobre propiedades inexistentes, ou não presentes no lazarus. Ista é correto para a maioria dos casos. Como você é un programador sério, revisara cada mensagem para verificar a importancia ou não do mesmo, correto? ;)

Salvar.

8) Compile. (CTRL-F9)

Como sempre, não esqueça de informar as units necessarias na clausula uses. Me refiro a LclType, LResources,etc.

Seja livre.
Use lazarus!



English Version

Lazarus(FPC) forms even more compatible with delphi.
Starting with FPC version 2.5.1 lazarus and FPC allow to save forms in lfm format without the need of LRS files.

This change make even easy migrate code from Delphi to Lazarus.

Prereqs:

Lazarus trunk version.
FPC trunk version (tested with version 2.5.1, don't know which is the minimal version required).
(Edited: minimal version required is FPC Version 2.4.0. Thanks Paul!)

The steps are:

1) Go to project options, tab miscellaneous and select fpc resources.




2) Copy dfm file to lfm file.

3) Open pas file on lazarus.

4) search your dfm reference and replace it for

{$IFDEF LCL}
{$R *.lfm}
{$ELSE}
{$R *.dfm}
{$ENDIF}

5) Search the include for lrs file at inicialization section and remove it.

6) HIT F12 (to see the lfm file).

7) You can safely ignore warnings about properties non presents in lazarus. That is true for the most of cases, but like you are a serious programmer will always read the warning messages to evaluate importance of the message, right? ;)
Save

8) Build. Done!

As always, don't forget to add need uses clauses in header of units ( i mind LclType, LResources,etc).

Enjoy!

Conheça o Elevatedb, banco de dados para Windows Mobile

.

Advantage TDataset Descendent for Lazarus

O Advantage TDataSet Descendant é uma ferramenta de desenvolvimento onde se pode programar usando componentes similares aos TTable, TQuery, TDatabase and TStoredProc com metodos e propriedades semelhantes. O Advantage TDataSet Descendant combinado com o Advantage Database Server, forma uma robusta solução cliente/servidor para adicionar performance, estabilidade and escalabilidade para aplicações multi-usuario.

O Advantage TDataSet Descendant prove acesso local aos dados com o driver Advantage Local Server, é royalty-free, adequado para desenvolvimento em tabelas locais e ideal para clientes que mais tarde queiram melhorar a performance e segurança de seus dados adquirindo então a versão Cliente/Servidor, o Advantage Database Server.

Caracteristicas

* Multiplataforma - Funciona em WIndows, Linux e Windows Mobile.
* Facil desenvolvimento e distribuição.
* Caso deseja mudar de acesso local para ambiente cliente/servidor não é necessaria nenhuma alteração nos fontes.
* Caracteristicas nativa dos componentes semelhantes aos conhecidos TTable, TQuery, TDatabase e TStoredProc
* Compatibilidade com outros componentes de banco de dados de terceiros
* Prove accesso para avançadas funcionalidades não encontrada em componentes de banco de dados nativos
* Facil conversão de dados de arquivos Paradox, InterBase, Access e SQL Server usando o Advantage Data Architect
* Facil migração para client/server, Internet, thin-client e aplicações moveis
* Baixa manutenção

Para saber mais acesse http://devzone.advantagedatabase.com/
Lá encontrará farta documentação sobre o banco de dados e os varios componentes de acesso, incluindo driver pra ODBC, PHP, .Net, e outros.

Atenção:
No modo local, você pode usar sem limitação, desde que os arquivos sejam acessados diretamente.
Qualquer acesso indireto no modo local, é violação da licença do AdvantageDatabase, atualmente mantido pela Sybase Anywhere.

A versão Cliente/Servidor é paga, mas pode ser testada gratuitamente durante 30 dias.


Versão for lazarus

Estou disponibilizando o TDataset Descendent for lazarus.



Codigo Fonte

Componente TAdsQuery em tempo de desing

Paleta de componentes Advantage

Estão portados os seguintes componentes:



TAdsTable
TAdsQuery
TAdsConnection
TAdsSettings
TAdsStoreProc
TAdsDictionary
TAdsBatchMove (Somente windows)

É um trabalho em andamento, portanto deve ser testado antes de usar em ambiente de produção.

Os componentes são multiplataforma, funcionam no windows e no linux.

Nos testes realizados com a versão de servidor local, funcionou perfeitamente.

Não testado em modo cliente/servidor.

Aproveite para testar agora!


Leia a licença de uso do Advantage.
Esses componentes não são LGLP, eles estão sob uma licença proprietária da Sybase Anywhere.

Para usar os componentes, é necessário instalar pelo menos o Advantage Client Engine.

Postem suas criticas e sugestões.

Espero que esse trabalho seja util pra você, desenvolvedor.

Até a proxima.


Bug

Versão: Advantage 9.10.0.9 for linux

Para quem instalou as libs do Advantage com o aceapi-9.10.0.9.tar.gz ou com o adsodbc-9.10.0.9.tar.gz, os usuarios linux terão que fazer o link simbolico a seguir:

#cd /usr/lib
#ln -s libace.so.9.10.0.9 libace.so.9.90

Se não fizer, ao tentar conectar dá erro de axServerConnection.


Observações da versão for lazarus

Não estão disponiveis os seguintes tipos de campos:

AdsStringField-> Será usado o tipo TStringField.
AIntegerField-> Será usado o tipo TLongintField.



Downloads

Versão 8.10

Componentes de acesso for lazarus

Advantage Client Engine 8.10.0.38 for Windows

Advantage Client Engine 8.10.0.38 for Linux

Versão 9.10

Componentes de acesso for lazarus

Advantage Client Engine 9.10.0.9 for Windows

Advantage Client Engine 9.10.0.9 for Linux


.

Synapse - Exemplo com sockets

Os componentes de socket mais famosos sem duvida são o IdTcpServer e IdTcpClient, da paleta Indy.
Eu não sei quanto aos outros desenvolvedores, mas acho o Indy muito complexo, pesado, e no caso do lazarus, com varios bugs, pelo menos até a versão 0.9.27 do lazarus, quando eu portei um projeto em delphi/kylix3 pro lazarus.
Resolvi estudar outros componentes de socket para portar o meu projeto pro lazarus.

Os componentes que eu analisei foram:

.Synapse (Ararat Synapse)
.LNet (Lightweight networking library)

Aqui nesse post vou apresentar um projeto de teste do synapse composto de 3 modulos:

.Modulo Cliente
.Modulo Servidor
.Modulo Configura/Dispara Clientes

Como funciona

Modulo Servidor

Primeiro, carregue o modulo servidor (server_synapse1.exe).
Antes de ativar, marque a opção "Em caso de erro parar comunicação"
Clique em Ativar Servidor
Pronto, o nosso servidor está no ativo, esperando conexões.

Tela do servidor

Modulo Cliente

Agora, vamos carregar o(s) modulo(s) clientes do nosso projeto.
Execute o clientesynapse1.exe
Veja a tela do nosso cliente abaixo:




Observe que temos algumas configurações disponiveis pro nosso cliente, pra possibilitar a nossa maratona de testes.

Estas opções são:

Numero de sends
Numero de vezes que o cliente repetira o teste escolhido

Disparo por arquivo externo
Informa ao cliente que deve procurar pelo arquivo "disparo.dat" pra iniciar o teste

Finaliza automatico
Informa ao cliente pra auto-finalizar assim que o teste for executado

Parar em caso de erro
Em caso de problemas, para e mostra a mensagem de erro



Modulo Cliente Control

Esse modulo permite configurar o comportamento dos modulos clientes que serão carregados.

Tela do modulo control




Do lado esquerdo temos as configurações que serão carregadas pelos clientes.
Marque as opções desejadas e clique em "Gerar cconfig"

Do lado esquerdo temos 4 botões:

Engatilhar
Apos o primeiro "disparo", clique nesse botao pra colocar o modulo cliente em estado de espera pelo "disparo"

Disparar clientes
Ao clicar nesse botão, sera gerado o arquivo "disparo.dat" que será lido pelos clientes, e apos se iniciará o processamento desejado

Fechar clientes
Clicando nesse botão, será gerado o arquivo "closecli.dat" que fará com que todos os modulos clientes fechem automaticamente.

Reset
Ao receber o click, apaga os arquivos de controle (dispara.dat,closecli.dat)


Outros comandos

dispara10 e dispara100

Comandos para carregar 10 ou 100 modulos clientes de uma vez. Eu carreguei 100 modulos de uma vez no meu archlinux e funcionou beleza.


Download dos fontes aqui.


Boa diversão :-)

Modulo Servidor

unit server_synapse1_unit1;

{$mode objfpc}{$H+}

interface

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

type

   TTCPEchoDaemon = class(TThread)
   private
      Daemon_Memo1:TMemo;
      SSocket:TTCPBlockSocket;
   public
      Constructor Create (hMemo:TMemo);
      Destructor Destroy; override;
      procedure Execute; override;
   end;

   TTCPEchoThrd = class(TThread)
   private
      Sock:TTCPBlockSocket;
      loClientSock:TTCPBlockSocket;
      EchoMemo:TMemo;
      CSock: TSocket;
      Memo1Text:string;
      procedure UpdateMemo1;
   public
      Constructor Create (hsock:tSocket;hMemo:TMemo);
      procedure Execute; override;
   end;

   { TForm1 }

   TForm1 = class(TForm)
      servidor_modo_thread: TButton;
      cancela_button: TButton;
      box_error: TCheckBox;
      modo_verbose: TCheckBox;
      Memo1: TMemo;
      procedure cancela_buttonClick(Sender: TObject);
      procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure servidor_modo_threadClick(Sender: TObject);
   private
      { private declarations }
   public
      { public declarations }
   end;

var
   Form1: TForm1;
   SSocket: TTCPBlockSocket;
   loClientSock: TTCPBlockSocket;
   cancelar:Boolean;

implementation

{$R *.lfm}

Constructor TTCPEchoDaemon.Create(hMemo:TMemo);
begin
   inherited create(false);
   Daemon_Memo1:=hMemo;
   Ssocket:=TTCPBlockSocket.create;
   FreeOnTerminate:=true;
end;

Destructor TTCPEchoDaemon.Destroy;
begin
   SSocket.free;
end;

procedure TTCPEchoDaemon.Execute;
var
echo1:TTCPEchoThrd;
ClientSock:TSocket;
begin
   SSocket.CreateSocket;
   SSocket.Bind('127.0.0.1','7000');
   SSocket.Listen;
   cancelar:=False;
   if SSocket.LastError = 0 then
   begin
       while true do
       begin
            if terminated then break;
            Application.ProcessMessages;
            if SSocket.CanRead(10000)
            then begin
                ClientSock := SSocket.Accept;
                if SSocket.LastError = 0
                then begin
                     echo1:=TTCPEchoThrd.create(ClientSock,Daemon_memo1);
                     echo1.Resume;
                end ;
            end ;
       end ;
   end
   else
   begin
       Daemon_memo1.Lines.add('Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx);
   end;
   Daemon_memo1.Lines.Add('Finalizou');
   SSocket.CloseSocket;
   SSocket.Purge;
end;

Constructor TTCPEchoThrd.Create(Hsock:TSocket;hMemo:TMemo);
begin
   inherited create(true);
   Csock := Hsock;
   EchoMemo:=hMemo;
   FreeOnTerminate:=true;
end;
procedure TTCPEchoThrd.UpdateMemo1;
begin
   Form1.Memo1.Lines.Add(Memo1Text);
   Application.ProcessMessages;
end;

procedure TTCPEchoThrd.Execute;
var
clienteID,s1:string;
r,r1,r2,x,x1:integer;
begin
   loClientSock:=TTCPBlockSocket.create;
   try
      loClientSock.socket:=CSock;
      s1:=loClientSock.RecvString(10000);
      if s1='**teste1' then
      begin
          s1:=loClientSock.RecvString(10000);
          clienteID:=s1;
          loClientSock.SendString('** resp server '+clienteID+CRLF);
          if loClientSock.LastError>0 then
          begin
             Memo1Text:='ID '+clienteID+' SendString Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx;
             Synchronize(@UpdateMemo1);
          end;
      end;
      if s1='**teste2' then
      begin
         s1:=loClientSock.RecvString(10000);
         clienteID:=s1;
         s1:=loClientSock.RecvString(10000);
         x1:=strtoint(s1);
         for x:=1 to x1 do
         begin
            s1:=loClientSock.RecvString(10000);
            loClientSock.SendString('** resp server clienteID='+clienteID+CRLF);
            if loClientSock.LastError>0 then
            begin
               Memo1Text:='ID '+clienteID+' SendString Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx;
               Synchronize(@UpdateMemo1);
               break;
            end;
         end;
      end;
      if s1='**teste3' then
      begin
         s1:=loClientSock.RecvString(10000);
         clienteID:=s1;
         s1:=loClientSock.RecvString(10000);
         x1:=strtoint(s1);
         for x:=1 to x1 do
         begin
            s1:=loClientSock.RecvString(10000);
            if s1<>'**soma_inicio' then
            begin
               Memo1Text:='ID '+clienteID+' nao recebi **somainicio';
               Synchronize(@UpdateMemo1);
               if loClientSock.LastError>0 then
               begin
                  Memo1Text:='ID '+clienteID+' RecvString - Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx;
                  Synchronize(@UpdateMemo1);
               end;
               break;
            end;
            s1:=loClientSock.RecvString(10000);
            r:=strtoint(s1);
            r2:=0;
            for r1:=1 to r do
            begin
               s1:=loClientSock.RecvString(10000);
               r2:=r2+strtoint(s1);
            end;
            loClientSock.SendString(inttostr(r2)+CRLF);
            if loClientSock.LastError>0 then
            begin
               Memo1Text:='ID '+clienteID+' SendString - Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx;
               Synchronize(@UpdateMemo1);
               break;
            end;
         end;
      end;
   finally
      loClientSock.CloseSocket ;
      loClientSock.Free;
   end;
end;

{ TForm1 }

procedure TForm1.cancela_buttonClick(Sender: TObject);
begin
cancelar:=True;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SSocket.CloseSocket;
SSocket.Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SSocket := TTCPBlockSocket.Create;
end;

procedure TForm1.servidor_modo_threadClick(Sender: TObject);
var
loSock : TSocket;
clienteID,s1:string;
r,r1,r2,x,x1:integer;
Daemon1:TTCPEchoDaemon;
begin
Memo1.Lines.Add('Modo Thread Ativado');
Application.ProcessMessages;
cancelar:=False;
Daemon1:=TTCPEchoDaemon.Create(memo1);
Daemon1.Resume;
end;

end.

Modulo Cliente

   
unit clientesynapse1_unit1;

{$mode objfpc}{$H+}

interface

uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
   StdCtrls, ExtCtrls, blcksock, DateUtils;

type

   { TForm1 }

   TForm1 = class(TForm)
      box_error: TCheckBox;
      envia3: TButton;
      finalizaauto: TCheckBox;
      disparo1: TCheckBox;
      Edit2: TEdit;
      envia2: TButton;
      envia: TButton;
      Edit1: TEdit;
      Label1: TLabel;
      Label2: TLabel;
      Memo1: TMemo;
      Timer1: TTimer;
      Timer2: TTimer;
      procedure envia3Click(Sender: TObject);
      procedure enviamodo1;
      procedure enviamodo2;
      procedure enviamodo3;
      procedure envia2Click(Sender: TObject);
      procedure enviaClick(Sender: TObject);
      procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure Timer1Timer(Sender: TObject);
      procedure Timer2Timer(Sender: TObject);

   private
      { private declarations }
   public
      { public declarations }
   end;

var
   Form1: TForm1;
   SClient: TTCPBlockSocket;
   formID:string;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.enviamodo1;
var
S1:string;
x,x1:integer;
begin
timer2.Enabled:=False;
while true do
begin
   if not disparo1.Checked then break;
   if SysUtils.FileExists('disparo.dat') then break;
   Application.ProcessMessages;
   sleep(500);
end;

while true do
begin
   x:=DateUtils.SecondOfTheMinute(Time());
   if x in [1,16,31,46] then break;
end;
memo1.Lines.Clear;
Application.ProcessMessages;
x1:=strtoint(edit2.Text);
for x:=1 to x1 do
begin
   SClient.Connect('127.0.0.1','7000');
   if SClient.LastError<>0 then
   begin
   memo1.Lines.Add('Conexao de teste '+inttostr(x));
   memo1.Lines.add('Connect falhou - Erro '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   showmessage('Ocorreu um problema');
   timer2.Enabled:=True;
   exit;
   end;

   if SClient.CanWrite(100) then
   begin
      SClient.SendString('**teste1'+CRLF);
      SClient.SendString(FormID+CRLF);
      SClient.SendString(Edit1.Text+' '+inttostr(x)+CRLF);
      S1:=SClient.RecvString(10000);
      memo1.Lines.Add(S1);
   end;
   SClient.CloseSocket;
end;
memo1.Lines.add('**teste1 finalizado');
if finalizaauto.Checked then close;
timer2.Enabled:=True;
end;

procedure TForm1.envia3Click(Sender: TObject);
begin
enviamodo3;
end;

procedure TForm1.enviamodo2;
var
S1:string;
x,x1:integer;
begin
timer2.Enabled:=False;
while true do
begin
   if not disparo1.Checked then break;
   if SysUtils.FileExists('disparo.dat') then break;
   Application.ProcessMessages;
   sleep(500);
end;

while true do
begin
   x:=DateUtils.SecondOfTheMinute(Time());
   if x in [1,16,31,46] then break;
end;
memo1.Lines.Clear;
Application.ProcessMessages;
SClient.Connect('127.0.0.1','7000');
if SClient.LastError<>0 then
begin
   memo1.Lines.add('Connect falhou - Erro '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   showmessage('Ocorreu um problema');
   timer2.Enabled:=True;
   exit;
end;

if SClient.CanWrite(1000) then
begin
   SClient.SendString('**teste2'+CRLF);
   SClient.SendString(FormID+CRLF);
   SClient.SendString(edit2.text+CRLF);
   x1:=strtoint(edit2.Text);
   if SClient.LastError<>0 then
   begin
      memo1.Lines.add('SendString 1 Error '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   end;

   for x:=1 to x1 do
   begin
         SClient.SendString(Edit1.Text+' '+inttostr(x)+CRLF);
         if SClient.LastError<>0 then
         begin
            memo1.Lines.add('SendString 2 Error '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
            if box_error.Checked then break;
         end;
         S1:=SClient.RecvString(10000);
         if SClient.LastError<>0 then
         begin
            memo1.Lines.add('RecvString 1 Error '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
            if box_error.Checked then break;
         end;
         memo1.Lines.Add(S1);
   end;
end;
memo1.Lines.add('**teste2 finalizado');
SClient.CloseSocket;
SClient.Purge;
if finalizaauto.Checked then close;
timer2.Enabled:=True;
end;

procedure TForm1.enviamodo3;
var
S1:string;
r,r1,r2,x,x1,x2:integer;
TS1:TStringlist;
begin
randomize;
TS1:=TStringlist.Create;
timer2.Enabled:=False;
while true do
begin
   if not disparo1.Checked then break;
   if SysUtils.FileExists('disparo.dat') then break;
   Application.ProcessMessages;
   sleep(500);
end;

while true do
begin
   x:=DateUtils.SecondOfTheMinute(Time());
   if x in [1,16,31,46] then break;
end;
memo1.Lines.Clear;
Application.ProcessMessages;
SClient.Connect('127.0.0.1','7000');
if SClient.LastError<>0 then
begin
   memo1.Lines.add('Connect falhou - Erro '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   showmessage('Ocorreu um problema');
   timer2.Enabled:=True;
   exit;
end;

if SClient.CanWrite(1000) then
begin
   SClient.SendString('**teste3'+CRLF);
   SClient.SendString(FormID+CRLF);
   SClient.SendString(edit2.text+CRLF);
   x1:=strtoint(edit2.Text);
   if SClient.LastError<>0 then
   begin
      memo1.Lines.add('SendString 1 Error '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   end;

   for x:=1 to x1 do
   begin
      r:=10+trunc(random()*50);
      TS1.Clear;
      r2:=0;
      for x2:=1 to r do
      begin
         r1:=trunc(random()*100);
         r2:=r2+r1;
         TS1.Add(inttostr(r1));
      end;
      SClient.SendString('**soma_inicio'+CRLF);
      SClient.SendString(inttostr(TS1.Count)+CRLF);
      for x2:=0 to TS1.Count-1 do
      begin
         SClient.SendString(TS1[x2]+CRLF);
      end;
      S1:=SClient.RecvString(10000);
      if strtoint(S1)<>r2 then memo1.Lines.add('Erro de soma');
   end;
   memo1.Lines.add('**teste3 finalizado');
end;
SClient.CloseSocket;
SClient.Purge;
if finalizaauto.Checked then close;
timer2.Enabled:=True;
end;

procedure TForm1.enviaClick(Sender: TObject);
begin
enviamodo1;
end;

procedure TForm1.envia2Click(Sender: TObject);
begin
enviamodo2;
end;


procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SClient.Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
s1:string;
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');
if fileexists('redisparo.dat') then DeleteFile('redisparo.dat');
SClient := TTCPBlockSocket.Create;
s1:=inttostr(DateUtils.MilliSecondOfTheHour(Time()));
formID:=s1;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
label2.Caption:=formID;
timer1.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
ts1:TStringlist;
x:integer;
begin
timer1.Enabled:=False;
if fileexists('cconfig.dat') then
begin
   ts1:=TStringlist.Create;
   ts1.LoadFromFile('cconfig.dat');
   for x:=0 to ts1.Count-1 do
   begin
      if ts1[x]='disparo' then
      begin
         disparo1.Checked:=True;
         memo1.Lines.Clear;
         memo1.Lines.Add('Aguardando disparo');
      end;
      if ts1[x]='boxerro' then box_error.Checked:=True;
      if ts1[x]='finaliza' then finalizaauto.Checked:=True;
      if copy(ts1[x],1,1)='0' then edit2.Text:=ts1[x];
   end;
   Application.ProcessMessages;
   for x:=0 to ts1.Count-1 do
   begin
      if ts1[x]='envia1' then enviamodo1;
      if ts1[x]='envia2' then enviamodo2;
      if ts1[x]='envia3' then enviamodo3;
   end;
end;
Application.ProcessMessages;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
if fileexists('closecli.dat')   then close;
if fileexists('redisparo.dat') then
begin
   memo1.Lines.Clear;
   memo1.Lines.Add('Aguardando disparo');
   Application.ProcessMessages;
   timer1.Enabled:=True;
end;
end;

end.


Modulo Controle dos Clientes

   
unit clientesynapse_control1_unit1;

{$mode objfpc}{$H+}

interface

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

type

   { TForm1 }

   TForm1 = class(TForm)
      box_error: TCheckBox;
      Engatilhar: TButton;
      n_sends: TEdit;
      Label2: TLabel;
      nenhum_evento: TRadioButton;
      reset1: TButton;
      gravar: TButton;
      disparo1: TCheckBox;
      fechar_processos: TButton;
      disparo: TButton;
      finalizaauto: TCheckBox;
      GroupBox1: TGroupBox;
      Label1: TLabel;
      modo1: TRadioButton;
      modo2: TRadioButton;
      modo3: TRadioButton;
      procedure disparoClick(Sender: TObject);
      procedure EngatilharClick(Sender: TObject);
      procedure fechar_processosClick(Sender: TObject);
      procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure gravarClick(Sender: TObject);
      procedure reset1Click(Sender: TObject);
   private
      { private declarations }
   public
      { public declarations }
   end;

var
   Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');
if fileexists('redisparo.dat') then DeleteFile('redisparo.dat');
end;

procedure TForm1.disparoClick(Sender: TObject);
var
s1:TStringlist;
begin
s1:=TStringlist.Create;
s1.add('start');
s1.SaveToFile('disparo.dat');
end;

procedure TForm1.EngatilharClick(Sender: TObject);
var
s1:TStringlist;
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');

s1:=TStringlist.Create;
s1.add('start');
s1.SaveToFile('redisparo.dat');

end;

procedure TForm1.fechar_processosClick(Sender: TObject);
var
s1:TStringlist;
x:integer;
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('redisparo.dat') then DeleteFile('redisparo.dat');
s1:=TStringlist.Create;
s1.add('close');
s1.SaveToFile('closecli.dat');

end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');
end;

procedure TForm1.gravarClick(Sender: TObject);
var
s1:TStringlist;
begin
s1:=TStringlist.Create;
if strtointdef(n_sends.Text,0)>0 then s1.Add('0'+n_sends.Text);
if disparo1.Checked then s1.Add('disparo');
if finalizaauto.Checked then s1.Add('finaliza');
if box_error.Checked then s1.Add('boxerro');

if modo1.Checked then s1.Add('envia1');
if modo2.Checked then s1.Add('envia2');
if modo3.Checked then s1.Add('envia3');

s1.SaveToFile('cconfig.dat');

end;

procedure TForm1.reset1Click(Sender: TObject);
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('redisparo.dat') then DeleteFile('redisparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');

end;

end.

Indy Socket Error 98

Se ao tentar ativar o IdTcpServer componente indy der o segunite erro:

socket error # 98
address already in use

Basta fazer a seguinte configuração:

IdTCPServer1.Active := False;
IdTCPServer1.Bindings.Add.IPVersion := Id_IPv4;
IdTCPServer1.Active := True;

O Id_IPv4 força o IdTCPServer a trabalhar no padrão Id_IPV4.

O problema está resolvido.

Problemas com SVN

A alguns dias tentei baixar a ultima versão do fortes4lazarus com o svn e não consegui, pois deu erro.

Executei o comando abaixo:

$svn co https://fortes4lazarus.svn.sourceforge.net/svnroot/fortes4lazarus/trunk fortes4lazarus

Deu o seguinte erro:

SSL negotiation failed: SSL disabled due to library version mismatch

Como eu ainda sou inexperiente com svn, achei que estava fazendo alguma coisa errada.

Mas não era. Na verdade era o pacote neon que estava desatualizado.

No meu caso,uso archlinux, executei:


#pacman -S openssl, neon

Pra usuarios do Ubuntu, digite:

#apt-get install openssl, neon

E pronto. Feito isso, o svn funcionou normalmente.

Espero ter colaborado.

Lazarus 0.9.29 no wine

Estava fazendo uns testes no lazarus linux (gtk2) e resolvi abrir uns projetos mais antigos que eu havia feito na versão 0.9.27 e qual minha surpresa: Alguns forms não ficam visiveis quando pressiona o F12 (togle form/unit).

Resolvi instalar o lazarus no wine e qual a minha surpresa: os forms visualizaram normalmente. Então pesquisando, descobri que é um problema de lazarus/Gtk2, não acontece sempre, mas acontece.

Aqui esta o lazarus no wine, no meu archlinux com kde4:



Vantagens:
1-Não precisa carregar uma maquina virtual com windows
2-É muito mais rapido do que uma maquina virtual
3-É possivel criar um snapshot da instalação inicial, de modo que se ao instalar algum componente aparecer algum bug na IDE, simplesmente se apaga a instalação e volta o snapshot.
4-Pra instalar em outra maquina linux, basta criar um novo snapshot e copiar pra outra maquina e pronto!

Desvantagens:

1-Alguns componentes podem não instalar, principalmente se depender de DLLs de terceiros.
2-Não tem nenhuma garantia que na proxima versão do wine o lazarus vai funcionar, sem ter que reinstalar.

Mas enquanto não dá problema, sou feliz com linux+wine !
Seja livre, use linux.

Em breve darei mais detalhes de como criar o snapshot.

Até a proxima.

Fortes Report for lazarus vs 0.3.5.8

Ja esta disponivel a versão 0.3.5.8 do gerador de relatorios FortesReport4Lazarus.

Obrigado a todos que de uma forma ou de outra, colaboram com o desenvolvimento desse projeto.

Entre as correções realizadas destacam-se:

.preview em tempo de design, o que acelera bastante o desenvolvimento dos relatorios.

.A exportação para pdf tambem foi melhorada, com suporte a UTF8


Link para download.

Postem aqui suas duvidas, sugestões, reclamações.