segunda-feira, 30 de agosto de 2010

Enviando combinação de teclas para o buffer do teclado

Exemplo : PostKeyEx32(Ord('A'), [ssCtrl], false); Envia Ctrl+A para o controle que tiver o foco. Key : virtual keycode da tecla a enviar. Para caracteres imprimíveis informe o código ANSI (Ord(CHARACTER)). Shift : estado das teclas modificadoras. Shift, Control, Alt, Mouse Buttons.  SpecialKey: normalmente deve ser False. Informe True se a tecla desejada for, por exemplo, do teclado numérico.  

procedure PostKeyEx32(Key: Word; const Shift: TShiftState; SpecialKey: boolean);
type
    TShiftKeyInfo = Record
    shift: Byte;
    vkey : Byte;
End;
    byteset = Set of 0..7;
    const
    ShiftKeys: array [1..3] of TShiftKeyInfo =
    ((shift: Ord(ssCtrl); vkey: VK_CONTROL ),
    (shift: Ord(ssShift); vkey: VK_SHIFT ),
    (shift: Ord(ssAlt); vkey: VK_MENU ));
    var
    Flag: DWORD;
    bShift: ByteSet absolute shift;
    i: Integer;
begin
    for i := 1 to 3 do begin
        if shiftkeys[i].shift in bShift then
            Keybd_Event(ShiftKeys[i].vkey,
        MapVirtualKey(ShiftKeys[i].vkey, 0), 0, 0);
    end; // for
    if SpecialKey Then
        Flag := KEYEVENTF_EXTENDEDKEY
    else
        Flag := 0;
    Keybd_Event(Key, MapvirtualKey(Key, 0), Flag, 0);
    Flag := Flag or KEYEVENTF_KEYUP;
    Keybd_Event(Key, MapvirtualKey(Key, 0), Flag, 0);
    for i := 3 DownTo 1 do begin
        if ShiftKeys[i].shift in bShift then
            Keybd_Event(shiftkeys[i].vkey,
        MapVirtualKey(ShiftKeys[i].vkey, 0),
        KEYEVENTF_KEYUP, 0);
    end; // for
end; // PostKeyEx32 

Virtual keys

vk_LButton = $01;
vk_RButton = $02;
vk_Cancel = $03;
vk_MButton = $04; { NOT contiguous with L & RBUTTON }
vk_Back = $08;
vk_Tab = $09;
vk_Clear = $0C;
vk_Return = $0D;
vk_Shift = $10;
vk_Control = $11;
vk_Menu = $12;
vk_Pause = $13;
vk_Capital = $14;
vk_Escape = $1B;
vk_Space = $20;
vk_Prior = $21;
vk_Next = $22;
vk_End = $23;
vk_Home = $24;
vk_Left = $25;
vk_Up = $26;
vk_Right = $27;
vk_Down = $28;
vk_Select = $29;
vk_Print = $2A;
vk_Execute = $2B;
vk_SnapShot = $2C;
vk_Copy = $2C {not used by keyboards }
vk_Insert = $2D;
vk_Delete = $2E;
vk_Help = $2F;
{vk_A thru vk_Z are the same as their ASCII equivalents: 'A' thru 'Z' }
{ vk_0 thru vk_9 are the same as their ASCII equivalents: '0' thru '9' }
vk_NumPad0 = $60;
vk_NumPad1 = $61;
vk_NumPad2 = $62;
vk_NumPad3 = $63;
vk_NumPad4 = $64;
vk_NumPad5 = $65;
vk_NumPad6 = $66;
vk_NumPad7 = $67;
vk_NumPad8 = $68;
vk_NumPad9 = $69;
vk_Multiply = $6A;
vk_Add = $6B;
vk_Separator = $6C;
vk_Subtract = $6D;
vk_Decimal = $6E;
vk_Divide = $6F;
vk_F1 = $70;
vk_F2 = $71;
vk_F3 = $72;
vk_F4 = $73;
vk_F5 = $74;
vk_F6 = $75;
vk_F7 = $76;
vk_F8 = $77;
vk_F9 = $78;
vk_F10 = $79;
vk_F11 = $7A;
vk_F12 = $7B;
vk_F13 = $7C;
vk_F14 = $7D;
vk_F15 = $7E;
vk_F16 = $7F;
vk_F17 = $80;
vk_F18 = $81;
vk_F19 = $82;
vk_F20 = $83;
vk_F21 = $84;
vk_F22 = $85;
vk_F23 = $86;
vk_F24 = $87;
vk_NumLock = $90;
vk_Scroll = $91;

Colocando funções em uma DLL

Edite diretamente no DPR, e depois salve como Funcoes.dpr:

Library Funcoes;

Uses SysUtils,WinTypes,WinProcs;
{ Uma função que tira os espaços no início e no final de uma string }

Function Trim(J:String):String; Export;
Begin
While J[Length(J)]=#32 do Dec(J[0]);
If Length(J)>1 then
While (J[1]=' ') do
Begin
Delete(J,1,1);
If Length(J)<=1 then J:='';
end;
Result:=J;
end;
Exports { Torna visivel para os programas }
Trim;
Begin
End.
Para usar num programa:

Unit Unit1;
Interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Var
Form1: TForm1;
Implementation
{ Declara a funcao }
Function Trim(J:String):String; External 'funcoes.dll';
{$R *.DFM}
Procedure TForm1.FormClick(Sender: TObject);
begin
Caption:=Trim(' Visite sempre o Delphi Club '); { Note os espacos }
end;
 
As vantagens de colocar as funções em DLL são:

1. O programa exigirá menos memória

2. Você poderá reaproveitar as funções

3. Em alguns casos pode-se atualizar apenas as dll para um upgrade

Como atribuir um valor inicial para uma variável global

No Delphi, pode-se atribuir um valor inicial para uma variável global enquanto a declara. É possível escrever, por exemplo:

var
  Value: Integer = 10;
  Correct: Boolean = True;

Esta técnica de inicialização funciona apenas para variáveis globais, não para variáveis declaradas no escopo de um procedimento ou método.

quarta-feira, 18 de agosto de 2010

Traduzindo a mensagem "Delete Record ?"

Quando clicamos sobre o botão de deleção no DBNavigator (o do sinal de menos) surge uma box com a mensagem "Delete Record?" com botões Ok e Cancel.

Para fazer aparecer a mensagem em português deverá selecionar o componente Table e mudar a propriedade ConfirmDelete para False e no evento da tabela BeforeDelete colocar o seguinte:

procedure TForm1.Table1BeforeDelete(DataSet:TDataSet);
begin
if MessageDlg('Eliminar o Registro?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Abort;
end;

terça-feira, 17 de agosto de 2010

Enviar um email

 smtp.postmessage.toAddress := 'StringList (por ex uma listbox';
smtp.postmessage.FromAdreess := 'ex: meu_email@123.pt';
smtp.userid := 'ex: user@123.pt'
smtp.host := 'ex: smtp@123.pt'
smtp.postmessage.subject := 'Assunto'
smtp.postmessage.body := 'Texto da mensagem (stringlist)'

smtp.connect;
smtp.sendmail;
smtp.disconnect;
Contribuição:
O Anonymous.nick enviou um complemento explicando melhor o procedimento para enviar um e-mail usando o Delphi.

Fazer um aplicativo completo para manipulação de e-mails é um tanto trabalhoso e não é o assunto desta dica. Muitas vezes, porém, queremos apenas dar ao nosso software a capacidade de enviar simples e-mails. Isto é fácil, especialmente porque o Delphi5 nos oferece o componente TNMSMTP (paleta FastNet) que faz praticamente todo o trabalho para nós. Precisamos apenas alterar algumas propriedades e chamar alguns métodos para que a mensagem seja enviada. Vamos para a prática:

1. Coloque um componente TNMSMTP no form.

2. Coloque um botão e no evento OnClick deste botão escreva:

procedure TForm1.Button1Click(Sender: TObject);
begin

  { Seu servidor SMTP }
  NMSMTP1.Host := 'smtp.servidor.com.br';

  { Porta SMTP, **NÃO MUDE ISTO** }
  NMSMTP1.Port := 25;

  { Nome de login do usuário }
  NMSMTP1.UserID := 'MeuLogin';

  { Conecta ao servidor }
  NMSMTP1.Connect;

  { Se ocorrer algum erro durante a conexão com o servidor, avise! }
  if not NMSMTP1.Connected then
  raise Exception.Create('Erro de conexão');

  with NMSMTP1.PostMessage do begin
  { Seu e-mail }
  FromAddress := 'meuemail@meuserver.com.br';

  { Seu nome }
  FromName := 'Meu Nome';

  { E-mail do destinatário }
  ToAddress.Clear;
  ToAddress.Add('destinatario@servidor.com.br');

  { Assunto da mensagem }
  Subject := 'Assunto da mensagem';

  { Corpo da mensagem }
  Body.Clear;
  Body.Add('Primeira linha da mensagem');
  Body.Add('Segunda linha da mensagem');
  Body.Add(''); { Linha em branco }
  Body.Add('Última linha da mensagem');

  { Anexar arquivos(Se não quiser anexar arquivos, apague as 3 linhas seguintes) }

  Attachments.Clear;

  { Endereço do anexo }
  Attachments.Add('c:\diretorio\arquivo.ext');

  end;

 { Manda o e-mail }
  NMSMTP1.SendMail;
 { Disconecta do servidor }
  NMSMTP1.Disconnect;
end;


Pronto! É só fazer as adaptações necessárias e você terá envio de e-mails em sua aplicação.

Observações:
Para enviar o mesmo e-mail para vários destinatário de uma só vez basta adicionar os endereços de e-mails de todos os destinatários em NMSMTP1.PostMessage.ToAddress

Como saber se estou conectado à internet

interface
uses
Windows, SysUtils, Registry, WinSock, WinInet;

type
TConnectionType = (ctNone, ctProxy, ctDialup);

function ConnectedToInternet : TConnectionType;
function RasConnectionCount : Integer;


implementation

const
cERROR_BUFFER_TOO_SMALL = 603;
cRAS_MaxEntryName = 256;
cRAS_MaxDeviceName = 128;
cRAS_MaxDeviceType = 16;
type
ERasError = class(Exception);

HRASConn = DWord;
PRASConn = ^TRASConn;
TRASConn = record
dwSize: DWORD;
rasConn: HRASConn;
szEntryName: Array[0..cRAS_MaxEntryName] Of Char;
szDeviceType : Array[0..cRAS_MaxDeviceType] Of Char;
szDeviceName : Array [0..cRAS_MaxDeviceName] of char;
end;

TRasEnumConnections =
function (RASConn: PrasConn; { buffer para receber dados da conexao}
var BufSize: DWord; { tamanho em bytes do buffer }
var Connections: DWord { numero de conexoes escritas no buffer }
): LongInt; stdcall;


function ConnectedToInternet: TConnectionType;
var
    Reg : TRegistry;
    bUseProxy : Boolean;
    UseProxy : LongWord;
begin
    Result := ctNone;
    Reg := TRegistry.Create;
    with REG do
    try
    try
        RootKey := HKEY_CURRENT_USER;
        if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet settings',False) then begin
            //I just try to read it, and trap an exception
            if GetDataType('ProxyEnable') = rdBinary then
                ReadBinaryData('ProxyEnable', UseProxy, SizeOf(LongWord) )
        else begin
            bUseProxy := ReadBool('ProxyEnable');
            if bUseProxy then
                UseProxy := 1
            else
                UseProxy := 0;
        end;
        if (UseProxy <> 0) and ( ReadString('ProxyServer') <> '' ) then Result := ctProxy;
    end;
    except
        //Nao conectado com proxy
    end;
    finally
    Free;
end;

    if Result = ctNone then begin
    if RasConnectionCount > 0 then Result := ctDialup;
    end;
    end;

function RasConnectionCount : Integer;
var
    RasDLL : HInst;
    Conns : Array[1..4] of TRasConn;
    RasEnums : TRasEnumConnections;
    BufSize : DWord;
    NumConns : DWord;
    RasResult : Longint;
begin
    Result := 0;

    //Load the RAS DLL
    RasDLL := LoadLibrary('rasapi32.dll');
    if RasDLL = 0 then exit;

    try
        RasEnums := GetProcAddress(RasDLL,'RasEnumConnectionsA');
        if @RasEnums = nil then
        raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');

        Conns[1].dwSize := Sizeof (Conns[1]);
        BufSize := SizeOf(Conns);

        RasResult := RasEnums(@Conns, BufSize, NumConns);

        If (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then Result := NumConns;
    finally
    FreeLibrary(RasDLL);
end;
end;

Curso de Delphi: 7.Consultas SQL