Algoritmo de Seam Carving con Delphi

Seam Carving también llamado Retarget es un algoritmo que permite modificar las imágenes sin pérdida de información del contenido y se basa en preservar mediante métodos automáticos diferentes zonas de la imagen antes de escalarla.
El propósito de este algoritmo es mostrar las imágenes sin distorsión en distintos dispositivos  (móviles, PDA) 
Inicialmente lo desarrollaron  Shai Avidan, del  Mitsubishi Electric Research Laboratories (MERL), y  Ariel Shamir, del Interdisciplinary Centerand MERL.
También se ha codificado en Action Script por Joe Ebert  ( http://je2050.de/files/source/as3/ImageResizing.as ) y posteriormente Mario Klingemann lo optimizó ( http://www.quasimondo.com/scrapyard/ImageResizing_opt1.as )



Imagen original



Compresión de la imagen (en este caso no nos vale porque el castillo aparece deformado)


Un recorte tampoco vale (el castillo no se muestra completo)


Pero utilizando seam carving si que obtenemos el resultado deseado, la imagen del castillo y de la persona aparecen como son en la imagen inicial






Enlace | Página web (programa en Delphi)



Utilizar redes neuronales para resolver un captcha

Aquí tienen una unit llamada CaptchaTrainer que se utiliza para resolver un captcha . Para ello utilizamos la biblioteca open source FANN http://leenissen.dk/fann/wp/ que sirve para implementar redes neuronales artificiales multicapa.

FANN ha sido traducido a 15 lenguajes de programación diferentes, entre ellos no podía faltar Delphi (http://leenissen.dk/fann/wp/language-bindings/ )

Una red neuronal se compone de unidades llamadas neuronas y esta formada por tres capas:
1) Capa de entrada (input layer) que recibe las señales del entorno
2) Capa oculta (hidden layer)
3) Capa de salida (ouput layer)
Cada neurona recibe una o varias entradas y tiene una o varias salidas que viene dada por una serie de funciones:
- Función de propagación: (también conocida como función de excitación), que por lo general consiste en la entrada (suma de todas las señales de entrada) multiplicada por el peso de su interconexión.
- Función de activación, que modifica a la anterior. Puede no existir, siendo en este caso 
Función de transferencia, que se aplica al valor devuelto por la función de activación. 
Se utiliza para acotar la salida de la neurona. Algunas de las más utilizadas son la función sigmoide (genera outputs de valores en el intervalo [0,1]) y la tangente hiperbólica (genera outputs de valores en el intervalo [-1,1])

El número de neuronas de entrada se selecciona en función de las variables de entrada del problema que queramos predecir.
Número de capas ocultas: Las capas ocultas proporcionarán a la red la capacidad de generalizar. En la práctica, se suelen usar redes neuronales con una o dos capas ocultas. Sin embargo, no hay un criterio natural acerca de la fórmula de selección óptima del número de neuronas ocultas. Baily y Thompson (1990) sugieren que el número de neuronas ocultas en una red neuronal de tres capas debe ser de 75% del número de neuronas de entrada mientras que Ersoy (1990) propone duplicar el número de neuronas ocultas hasta que el rendimiento de la red comience a deteriorarse.

Bien, después de esta introducción a las redes neuronales pasamos a comentar lo que hace esta unit:
Inicialmente se crea la red neuronal definiendo el número de entradas en las  3 capas:  entrada, salida y oculta. 
Como la entrada de la red es el bitmap del captcha, el número de neuronas de la entrada sería el tamaño del bitmap bitmapWidth * bitmapHeight.
Hay que tener en cuenta que los valores de cada una de las entradas / salidas siempre serán 1 o 0 (  fInputs[i]:= [1/0]     fOutputs[i]:= [1/0]   )  

Después necesitamos entrenar la red y para ello utilizamos la función Learn que tiene 2 parámetros de entrada: el captcha en formato bitmap y el número que representa y cuando terminemos el entrenamiento utilizaremos la función Guess  para probar la precisión de ese reconocimiento.

Otro aspecto a comentar es la línea 
 result := FANN.Train(fInputs, fOutputs);
del procedimiento Learn, y es que la variable result representa el error cuadrático medio del valor obtenido por la red respecto del valor esperado, por lo que debemos intentar que este error sea lo más pequeño posible para hacer que la red sea lo más precisa posible.


unit CaptchaTrainer;

interface

uses
  SysUtils, Graphics, FannNetwork;

type
  TCaptchaTrainer = class
  private
    fInputs, fOutputs: array of single;
  public
    FANN: TFannNetwork;
    constructor Create;
    procedure CreateNN(numInputs, numOutputs: integer); overload;
    procedure CreateNN(bitmapWidth, bitmapHeight, numOutputs: integer); overload;
    procedure LoadNN(fileName: string);
    procedure SaveNN(fileName: string);
    function Learn(bitmap: TBitmap; value: integer): single;
    function Guess(bitmap: TBitmap): integer;
    destructor Destroy; override;
  end;

implementation

{ TCaptchaTrainer }

function MaxValueIndex(const Data: array of Single): integer;
var I: Integer;
    maxvalue: single;
begin
  maxvalue := Data[Low(Data)];
  result := Low(Data);
  for I := Low(Data) + 1 to High(Data) do
    if maxvalue < Data[I] then
    begin
      maxvalue := Data[I];
      result := I;
    end;
end;

constructor TCaptchaTrainer.Create;
begin
  FANN := TFannNetwork.Create(nil);
  with FANN do
  begin
    ActivationFunctionHidden := afFANN_SIGMOID;
    ActivationFunctionOutput := afFANN_SIGMOID;
    TrainingAlgorithm := taFANN_TRAIN_RPROP;
    ConnectionRate := 1;
    LearningRate := 0.1;
  end;
end;

procedure TCaptchaTrainer.CreateNN(numInputs, numOutputs: integer);
begin
  SetLength(fInputs, numInputs);
  SetLength(fOutputs, numOutputs);
  with FANN.Layers do
  begin
    Add(IntToStr(numInputs));
    Add(IntToStr(50));
    Add(IntToStr(numOutputs));
  end;
  FANN.Build;
end;

procedure TCaptchaTrainer.CreateNN(bitmapWidth, bitmapHeight,
  numOutputs: integer);
begin
  SetLength(fInputs, bitmapWidth * bitmapHeight);
  SetLength(fOutputs, numOutputs);
  with FANN.Layers do
  begin
    Add(IntToStr(bitmapWidth * bitmapHeight));
    Add(IntToStr(50));
    Add(IntToStr(numOutputs));
  end;
  FANN.Build;
end;

destructor TCaptchaTrainer.Destroy;
begin
  FANN.UnBuild;
  FANN.Free;
  inherited;
end;

function TCaptchaTrainer.Guess(bitmap: TBitmap): integer;
var x,y,i: integer;
begin
  i:=0;
  for x:=0 to bitmap.Width-1 do
    for y:=0 to bitmap.Height-1 do
    begin
      if bitmap.Canvas.Pixels[x,y]=$00000000 then fInputs[i]:=1 else fInputs[i]:=0;
      inc(i);
    end;
  FANN.Run(fInputs, fOutputs);
  result := MaxValueIndex(fOutputs);
end;

function TCaptchaTrainer.Learn(bitmap: TBitmap; value: integer): single;
var x,y,i: integer;
begin
  i:=0;
  for x:=0 to bitmap.Width-1 do
    for y:=0 to bitmap.Height-1 do
    begin
      if bitmap.Canvas.Pixels[x,y]=$00000000 then fInputs[i]:=1 else fInputs[i]:=0;
      inc(i);
    end;
  for i:=0 to high(fOutputs) do if i=value then fOutputs[i]:=1 else fOutputs[i]:=0;
  result := FANN.Train(fInputs, fOutputs);
end;

procedure TCaptchaTrainer.LoadNN(fileName: string);
begin
  FANN.LoadFromFile(fileName);
end;

procedure TCaptchaTrainer.SaveNN(fileName: string);
begin
  FANN.SaveToFile(fileName);
end;

end.


Te puede interesar:
Red neuronal backpropagation 
Redes neuronales con delphi
Crear un captcha con delphi

Pulsa aquí si quieres un buen libro sobre redes neuronales. 



Ver el patrón de interferencia de dos fuentes de radiación coherentes.


En física, una interferencia es un fenómeno en el que dos ondas se superponen para formar otra nueva, que será de mayor o menor amplitud. Si ambas ondas tienen la misma frecuencia  entonces la onda resultante variará en función de la fase.

Young.gif
El siguiente programa muestra el patrón de interferencia de dos fuentes de radiación coherentes.
Para hacerlo visible tenéis que hacer un clic mantenido  sobre la imagen y a continuación mover el ratón en cualquier dirección. 
La fuente 1 será la posición inicial del clic y la fuente 2 será la posición del ratón en la que dejéis de hacer clic.

Ejemplos:

La fuente 1 y la fuente 2 están en la misma posición, en el centro de la imagen:



Ambas fuentes están ligeramente desplazadas.


La separación es aún mayor.



Enlace | Codigo fuente



Autor:
 Podsekin Igor aka WondeRu 
  wonderu@mail.ru
  www.wonderu.h12.ru

Escuchar la radio por streaming


Con este programa podrán escuchar emisoras de radio que difundan su programación en streaming por internet. Viene con varias emisoras pre-programadas, aunque como se tiene acceso al código fuente se puede cambiar por la que queramos.
Aquí tienen algunas: 


http://www.sky.fm/mp3/the80s.pls
http://www.sky.fm/mp3/bebop.pls
http://www.sky.fm/mp3/christmas.pls
http://www.sky.fm/mp3/christian.pls
http://www.sky.fm/mp3/jazzclassics.pls
http://www.sky.fm/mp3/lovemusic.pls
http://www.sky.fm/mp3/pianojazz.pls
http://www.sky.fm/mp3/smoothjazz.pls

Utiliza la librería bass.dll que se descarga desde aquí http://www.un4seen.com/ , de todas formas ya la incluyo en el código fuente en el link de abajo.


Codigo fuente

Relacionados

Vumetro con delphi
Visualizar el espectro de frecuencias de sonido
Reproducir archivo MIDI en piano virtual 
Tutorial - utilizar el componente Media Player
Simular teclado de un piano 


Si quieres profundizar más en la tecnología streaming de vídeo y audio pulsa aquí







Seguimiento de personas, animales y objetos con OpenCV en Delphi

OpenCV para los que no la conozcan, es una biblioteca libre enfocada hacia la visión artificial, inicialmente desarrollada por Intel bajo licencia BSD lo que permite que sea usada libremente para un propósito comercial o de investigación.


OpenCV es multiplataforma con versiones para Windows, Linux y Mac y contiene funciones que tratan los temas de proceso de visión, reconocimiento facial, calibrado de cámaras o robótica.
Esta biblioteca es la base de la herramienta Swistrack que sirve para hacer un seguimiento de personas, animales y objetos.

El siguiente código se puede ejecutar en Delphi XE2 o superior y lo que hace es, como veis en la imagen, un seguimiento de las personas que circulan por la calle rodeándolas con un rectángulo de color rojo a medida que se van desplazando.

(* /*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Mikhail Grigorev
// email: sleuthhound@gmail.com
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, 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/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
******************************************************************* *)

// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
program MotionDetect;

{$APPTYPE CONSOLE}
{$POINTERMATH ON}
{$R *.res}

uses
System.SysUtils,
Math,
uLibName in '..\..\..\include\uLibName.pas',
highgui_c in '..\..\..\include\highgui\highgui_c.pas',
imgproc.types_c in '..\..\..\include\imgproc\imgproc.types_c.pas',
imgproc_c in '..\..\..\include\imgproc\imgproc_c.pas',
imgproc in '..\..\..\include\imgproc\imgproc.pas',
core in '..\..\..\include\core\core.pas',
core.types_c in '..\..\..\include\core\Core.types_c.pas',
core_c in '..\..\..\include\core\core_c.pas';

var
storage: pCvMemStorage = nil;
capture: pCvCapture = nil;
frame: pIplImage = nil;
frame_grey: pIplImage = nil;
difference_img: pIplImage = nil;
oldframe_grey: pIplImage = nil;
contours: pCvSeq = nil;
c: pCvSeq = nil;
// rect: TCvRect;
rect2d: TCvBox2D;
key: integer;
first: boolean = true;

begin
try
capture := cvCreateCameraCapture(0);
storage := cvCreateMemStorage(0);
frame := cvQueryFrame(capture);
frame_grey := cvCreateImage(cvSize(frame^.width, frame^.height), IPL_DEPTH_8U, 1);

while true do
begin
frame := cvQueryFrame(capture);
if frame = nil then
break;
cvCvtColor(frame, frame_grey, CV_RGB2GRAY);
if first then
begin
difference_img := cvCloneImage(frame_grey);
oldframe_grey := cvCloneImage(frame_grey);
cvConvertScale(frame_grey, oldframe_grey, 1.0, 0.0);
first := false;
end;
cvAbsDiff(oldframe_grey, frame_grey, difference_img);
cvSmooth(difference_img, difference_img, CV_BLUR);
cvThreshold(difference_img, difference_img, 25, 255, CV_THRESH_BINARY);
contours := AllocMem(SizeOf(TCvSeq));
cvFindContours(difference_img, storage, @contours, SizeOf(TCvContour), CV_RETR_LIST, CV_CHAIN_APPROX_NONE,
cvPoint(0, 0));
c := contours;
while (c <> nil) do
begin
rect2d := cvMinAreaRect2(c);
cvRectangle(frame, cvPoint(Round(rect2d.center.x - rect2d.size.width / 2),
Round(rect2d.center.y - rect2d.size.height / 2)), cvPoint(Round(rect2d.center.x + rect2d.size.width / 2),
Round(rect2d.center.y + rect2d.size.height / 2)), cvScalar(0, 0, 255, 0), 2, 8, 0);
c := c.h_next;
end;
cvShowImage('Output Image', frame);
cvShowImage('Difference Image', difference_img);
cvConvertScale(frame_grey, oldframe_grey, 1.0, 0.0);
cvClearMemStorage(storage);
c := nil;
FreeMem(contours, SizeOf(TCvSeq));
key := cvWaitKey(33);
if (key = 27) then
break;
end;
cvReleaseMemStorage(storage);
cvReleaseCapture(capture);
cvReleaseImage(oldframe_grey);
cvReleaseImage(difference_img);
cvReleaseImage(frame_grey);
cvDestroyAllWindows();
except
on E: Exception do
WriteLn(E.ClassName, ': ', E.Message);
end;

end.


Relacionado:

Conversor de Cabeceras API de C o C++ a Delphi

Conversion pack menu items

Por si alguna vez han tenido la necesidad de convertir units en C, C++ a Delphi aquí les dejo una utilidad freeware que les hará gran parte del trabajo. Según dice su autor no cubre todos los aspectos de la gramática en C, pero sí la mayoría por lo que después de hacer la conversión nos quedaría hacer un pequeño trabajo de detalle convirtiendo manualmente las líneas que el software no habría podido hacer.
Actualmente el soft implementa las siguientes funciones:

Conectar Delphi con Active Directory

Active Directory es un servicio de Microsoft que utiliza LDAP para almacenar información de los usuarios y equipos de la red, como el nombre, usuario, contraseña así como la gestión de políticas.
La interfaz de servicio de Active Directory (ADSI) proporciona una interfaz COM que utilizaremos en nuestro programa y para ello preparamos una interfaz en la que le pedimos al usuario su usuario / contraseña y la comparamos con las obtenidas utilizando las units ActiveDs_Tlb y Adshlp, no olvidar añadir también la unit ComObj.
Para hacer la llamada necesitamos además el nombre de dominio de la red y el tipo de autenticación.
Si al comparar ambos datos se produce un error es que no se encuentra el objeto buscado o hay un problema de conectividad de la red.
El ejemplo que está a continuación ha sido desarrollado en Delphi 2009 y probado en servidores Windows 2003 y 2008.
Aquí tienen la unit principal:


unit uAD;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, ActiveX, adshlp, ActiveDs_Tlb, ComObj;
type
TfrmLogin = class(TForm)btnLogin: TButton;edtUsuario: TEdit;edtSenha: TEdit;lblUsuario: TLabel;lblSenha: TLabel;lblLogin: TLabel;

procedure btnLoginClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmLogin: TfrmLogin;

implementation

{$R *.dfm}

procedure TfrmLogin.btnLoginClick(Sender: TObject);
var
adObject: IADs;
begin
///Inicialização do COM
CoInitialize(nil);
try
ADsOpenObject('LDAP://', LowerCase(edtUsuario.Text), edtSenha.Text, ADS_SECURE_AUTHENTICATION, IADs, adObject);
ShowMessage('Login válido!');
except
on e: EOleException do
begin
if Pos('Falha de logon', e.Message) > 0 then
ShowMessage('Login inválido!')
else
ShowMessage(e.Message);
end;
end;
CoUninitialize;
end;

end.


begin
if Pos('Falha de logon', e.Message) > 0 then
ShowMessage('Login inválido!')
else
ShowMessage(e.Message);
end;
end;
CoUninitialize;
end;

enlace | Codigo
Por: Rodrigo Alves dos Santos 
Contacto: rod.alves88 @ gmail.com


Aqui tienen otro codigo que devuelve el nombre de usuario desde un objeto AD (Hay que utilizar la unit 
ADSISearch.pas)

try
ADSISearch1.Filter := WideString('samaccountname=' + GetUserFromWindows());

try
ADSISearch1.Search;
slTemp := ADSISearch1.GetFirstRow();
except
//uh-oh, this is a problem, get out of here
//must not have been able to talk to AD
//could be the user recently changed pwd and is logged in with
//their cached credentials
//just suppress this exception
bHomeDriveMappingFailed := True;
Result := bSuccess;
Exit;
end;

while (slTemp <> nil) do
begin
for ix := 0 to slTemp.Count - 1 do
begin
curLine := AnsiUpperCase(slTemp[ix]);
if AnsiStartsStr('HOMEDIRECTORY', curLine) then
begin
sADHomeDriveUncPath := AnsiReplaceStr(curLine, 'HOMEDIRECTORY=', '');
//sADHomeDriveUncPath := slTemp[ix];
end
else if AnsiStartsStr('HOMEDRIVE', curLine) then
begin
sADHomeDriveLetter := AnsiReplaceStr(curLine, 'HOMEDRIVE=', '');
//sADHomeDriveLetter := slTemp[ix];
end;
end;

FreeAndNil(slTemp);
slTemp := ADSISearch1.GetNextRow();
end;
except
//suppress this exception
bHomeDriveMappingFailed := True;
Exit;
end;




Relacionados

Utilizar el componente TWindowsMediaPlayer
Leer los datos del visor de sucesos
Modificar el brillo de la pantalla

Librería Exif
AntiKeylogger con Delphi
OCR con Tesseract
Delphi  Twain
Informacion de procesos de Windows

Reconocimiento de imagenes



Image Recognition Library es un componente (dll) que hace fácil el añadir la funcionalidad de reconocimiento de imágenes en sus aplicaciones, es decir lo que hace es comparar dos imágenes identificando si son iguales o no o encontrando una imagen más pequeña en otra más grande según una tolerancia variable.

Características:
-Exacto o relativo ARGB y AHSL y diferentes modos de compresión utilizando el canal alpha.
-Pre-proceso de imagen con 6 diferentes resamplers.
-Utiliza Multi-thread
-Soporte para multi-coincidencias
-Utiliza unicode
-Plataforma x86 y x64

Web: http://www.3delite.hu/Object%20Pascal%20Developer%20Resources/ImageRecognitionLibrary.html

Enlace | Codigo fuente

Relacionados:

Reconocimiento de caras con Delphi

OCR simplificado

Librería Exif


Modos blend

Programa para generar efectos graficos

Componente para manipulacion de imagenes

Chipmunk 2D physics engine


Libros para saber más:

Tratamiento digital de la imagen con Adobe Photoshop

Tratamiento digital de la imagen  (Anaya)

Tratamiento digital de imágenes fotográficas

Astrofotografía con cámaras digitales

Edición de medios digitales con software libre (Anaya)





Chipmunk 2D motor de física bidimensional


Chipmunk 2D es un motor de física bidimensional codificado en C++, que podemos utilizarlo en Delphi utilizando la unit chipmunk.pas que viene incluida en el zip.
Para cada partícula incorpora dos tipos de estructuras: una de ellas guarda su forma (esfera, segmento o polígono) y posición  y la otra almacena la forma en la que interactúa con su entorno (velocidad, elasticidad y fricción), lo que hace que genere simulaciones altamente realistas, como podrán comprobar  en el exe que adjunto.
Mi recomendación es que reduzcan el radio de las esferas dentro del procedure ImgMouseMove hasta hacerlo = 1 y que jueguen con el ratón haciendo clic y moviéndolo para generar miles de esferas.



Enlace | Codigo fuente


Relacionado:
         
author:            Scott Lembcke  
 mail:              slembcke@gmail.com     
                                           
 chipmunk version:  5.3.2                  
 license:           MIT                    
 chipmunk homepage:                        
 http://code.google.com/p/chipmunk-physics/
                                           
 header version:    0.99 beta 2            
 date:              2010.12.09             
 header homepage:                           
 http://code.google.com/p/chipmunk-pascal/ 
                                           
----------- cabeceras escritas por -------------
                                           
           Kemka Andrey aka Andru           
                                           
 mail: dr.andru@gmail.com                  
 JID:  dr.andru@googlemail.com             
 ICQ:  496929849                           
 www:  http://andru-kun.inf.ua      






Automatizando Outlook

Funciones que tenemos que utilizar cuando queremos automatizar el programa Outlook desde Delphi.


Crear un objeto Outlook

var 
  Outlook, NmSpace, Folder: OleVariant; 
begin 
  Outlook := CreateOleObject('Outlook.Application');    
  NmSpace := Outlook.GetNamespace('MAPI');
  NmSpace.Logon(EmptyParam, EmptyParam, False, True);
  Folder := NmSpace.GetDefaultFolder(olFolderInbox);
  Folder.Display;


Cerrar Outlook


  NmSpace.Logoff;
  Outlook.Quit;
  Outlook.Disconnect;   
  { or }
  Outlook := nil;      
  { or }
  Outlook := Unassigned; //hacerlo así se usamos variants




Leer un mensaje

var
s: string;
objCDO: OLEVariant;
begin
objCDO := CreateOLEObject('MAPI.Session');
objCDO.Logon('', '', False, False);
objMsg := objCDO.GetMessage(itemOL.EntryID, itemOL.Parent.StoreID);

s := objMsg.Sender.Address;
ShowMessage(s);
objMsg := Unassigned;
objCDO := Unassigned;
end

//donde itemOL es un  MailItem que contiene  SenderName pero no contiene   SenderAddress


Componer un email
const
  olMailItem = 0;
var
  Email: Variant;
begin
 Email := Outlook.CreateItem(olMailItem);
  Email.Recipients.Add('Debs@djpate.freeserve.co.uk');
  Email.Subject := 'Greetings, O gorgeous one';
  Email.Body := 'Your web pages fill me with delight';
  Email.Attachments.Add('C:\CreditCardNo.txt', EmptyParam, EmptyParam, EmptyParam);
  Email.Send;

Enviar / recibir email
uses Office_TLB; 
var
ToolsMenu: CommandBar;
SendRecMenuItem, AllAccs: CommandBarControl;
begin
ToolsMenu := (Outlook.ActiveExplorer.CommandBars as CommandBars).Item['Tools'];
SendRecMenuItem := ToolsMenu.Controls_['Send and Receive'];
AllAccs := (SendRecMenuItem.Control as CommandBarPopup).Controls_['All Accounts'];
AllAccs.Execute;


Chequear el email no leído
var
   Inbox: MAPIFolder;
   NewMail: boolean;
...
   Inbox := NmSpace.GetDefaultFolder(olFolderInbox);
   NewMail := (Inbox.UnreadItemCount > 0);
   if NewMail then
     ShowMessage(Format('Unread items in Inbox: %d', [Inbox.UnreadItemCount]));

The constant olFolderInbox is defined in Outlook_TLB as $00000006.


Chequear el email no enviado
var
   Outbox: MAPIFolder;
   UnsentMail: integer;
...
   Outbox := NmSpace.GetDefaultFolder(olFolderOutbox);
   UnsentMail := Outbox.Items.Count;
   if (UnsentMail > 0) then
     ShowMessage(Format('Unsent items in Outbox: %d', [UnsentMail]));




The constant olFolderOutbox is defined in Outlook_TLB as $00000004




Añadir un contacto a la libreta de direcciones de Outlook
uses
ComObj, Variants, SysUtils;

type
TContact = record
   LastName: string;
   FirstName : string;
   Company : string;
   // ###  Further properties. See MSDN
end;


//------------------------------------------------------------------------------
{:Add outlook contact

@param ContactFolderPath The contact path. E.g.: '' for default contact folder,
'SubFolder\Sub2\Test' for subfolders
@param Contact The contact informations.
@author 19.09.2003 Michael Klemm}
//------------------------------------------------------------------------------
procedure OutlookAddContact(ContactFolderPath : string; Contact : TContact);
const
olFolderContacts = $0000000A;
var
Outlook : OleVariant;
NameSpace : OleVariant;
ContactsRoot : OleVariant;
ContactsFolder : OleVariant;
OutlookContact : OleVariant;
SubFolderName : string;
Position : integer;
Found : boolean;
Counter : integer;
TestContactFolder : OleVariant;
begin
// Connect to outlook
Outlook := CreateOleObject('Outlook.Application');
// Get name space
NameSpace := Outlook.GetNameSpace('MAPI');
// Get root contacts folder
ContactsRoot := NameSpace.GetDefaultFolder(olFolderContacts);
// Iterate to subfolder
ContactsFolder := ContactsRoot;
while ContactFolderPath <> '' do
begin
   // Extract next subfolder
   Position := Pos('\', ContactFolderPath);
   if Position > 0 then
   begin
     SubFolderName := Copy(ContactFolderPath, 1, Position - 1);
     ContactFolderPath := Copy(ContactFolderPath, Position + 1, Length(ContactFolderPath));
   end
   else
   begin
     SubFolderName := ContactFolderPath;
     ContactFolderPath := '';
   end;
   if SubFolderName = '' then
     Break;
   // Search subfolder
   Found := False;
   for Counter := 1 to ContactsFolder.Folders.Count do
   begin
     TestContactFolder := ContactsRoot.Folders.Item(Counter);
     if LowerCase(TestContactFolder.Name) = LowerCase(SubFolderName) then
     begin
       ContactsFolder := TestContactFolder;
       Found := True;
       Break;
     end;
   end;
   // If not found create
   if not Found then
     ContactsFolder := ContactsFolder.Folders.Add(SubFolderName);
end;
// Create contact item
OutlookContact := ContactsFolder.Items.Add;
// Fill contact information
OutlookContact.FirstName := Contact.FirstName;
OutlookContact.LastName := Contact.LastName;
OutlookContact.CompanyName := Contact.Company;

// ### Further properties

// Save contact
OutlookContact.Save;
// Disconnect from outlook
Outlook := Unassigned;
end;



Eliminar todos los archivos adjuntos que hayan sido enviados por un determinado email
uses
comobj;

{...}

function manageattachments(sendersname, attachmentpath: string;
maildelete: boolean): boolean;
var
oapp: variant;
ons: variant;
ofolder: variant;
omsg: variant;
atc: variant;
attfilename: variant;
filename: string;
checksender: string;
counter: integer;
mailcounter: integer;
begin
try
oapp := createoleobject('outlook.application');
try
ons := oapp.getnamespace('mapi');
ofolder := ons.getdefaultfolder(6); // foldertypeenum (olfolderinbox)
mailcounter := 1;
// if there is any email in the inbox
if ofolder.items.count > 0 then
begin
repeat
// get the first email
omsg := ofolder.items(mailcounter);
// check the name or email
// use checksender := omsg.subject to search on subject;
checksender := omsg.sendername;
if checksender = sendersname then
// remove this line to backup all your attachments.
begin
// check how many attachments
atc := omsg.attachments.count;
if atc > 0 then
begin
// get all the attachments and save them
for counter := 1 to atc do
begin
attfilename := omsg.attachments.item(counter).filename;
//filename := includetrailingbackslash(attachmentpath)+attfilename; {use this line for d5)}
filename := attachmentpath + '' + attfilename;
omsg.attachments.item(counter).saveasfile(filename);
end;
end;
if maildelete then
begin
omsg.delete;
// there's 1 email less, so mailcounter - 1
dec(mailcounter);
end;
end;
// get the next email
inc(mailcounter);
// do until there is no more email to check
until mailcounter > ofolder.items.count;
end;
finally
oapp.quit;
end;
except
result := false;
exit;
end;
result := true;
end;


procedure tform1.button1click(sender: tobject);
begin
// manageattachments(email or name, backup directory, maildelete yes or no)
manageattachments('info@cleys.com', 'f:test', false);
end;


{
warning!
all your selected email will be deleted if maildelete = true
autor: patrick cleys 
homepage: http://www.dcmedical.org 
}