Asunto: Realizar aplicación Delphi que obtenga emails de dbx Outlook
He comprobado, abriendo los ficheros .dbx de Microsoft Outlook Express, que aparecen las direcciones de correo electrónico (emails) entre caracteres extraños.
Lo que quisiera es hacer una aplicación Delphi que obtenga esas direcciones de email de los ficheros .dbx de Outlook Express ¿por dónde empiezo? ¿cómo lo hago?
Publicado:
Vie Ago 07, 2009 9:02 am
alonsojpd Administrador/Moderador
Registrado: Sep 16, 2003 Mensajes: 2687
Asunto: Re: Realizar aplicación Delphi que obtenga emails de dbx Out
Anuncios
varios escribió:
He comprobado, abriendo los ficheros .dbx de Microsoft Outlook Express, que aparecen las direcciones de correo electrónico (emails) entre caracteres extraños.
Lo que quisiera es hacer una aplicación Delphi que obtenga esas direcciones de email de los ficheros .dbx de Outlook Express ¿por dónde empiezo? ¿cómo lo hago?
var
formMenuPrincipal: TformMenuPrincipal;
tamanoBuffer : Integer;
implementation
{$R *.dfm}
function verficarFichero (strFileName: string): Integer;
var
intErro: Integer;
tsrFile: TSearchRec;
begin
intErro := FindFirst(strFileName, FaAnyFile, tsrFile);
if intErro = 0 then Result := tsrFile.Size
else
Result := -1;
FindClose(tsrFile);
end;
procedure obtenerEmails (FilePath : string; var listaEmail : TStringList);
var
I: Integer;
hFile: Integer;
Buffer: PChar;
StrEmail: string;
begin
listaEmail := TStringList.Create;
hFile := FileOpen(FilePath, fmOpenRead);
try
if hFile = 0 then Exit;
GetMem(Buffer, tamanoBuffer + 1);
ZeroMemory(Buffer, tamanoBuffer + 1);
try
FileRead(hFile, Buffer^, tamanoBuffer);
I := 0;
while I <= tamanoBuffer - 1 do
begin
StrEmail := '';
if Buffer[I] = '<' then
begin
Inc(I);
while (Buffer[I] <> '@') and (I <= tamanoBuffer) do
begin
if (Buffer[I] = CHR(45)) or (Buffer[I] = CHR(46)) or
(Buffer[I] = CHR(90)) or ((Buffer[I] > CHR(49)) and (Buffer[I] <= CHR(57)))
or ((Buffer[I] >= CHR(65)) and (Buffer[I] <= CHR(90))) or
((Buffer[I] >= CHR(97)) and (Buffer[I] <= CHR(122))) then
begin
StrEmail := StrEmail + Buffer[I];
end
else
begin
StrEmail := '';
Break;
end;
Inc(I);
end;
if StrEmail <> '' then
begin
StrEmail := StrEmail + '@';
Inc(I);
while (Buffer[I] <> '.') and (I <= tamanoBuffer) do
begin
if (Buffer[I] = CHR(45)) or (Buffer[I] = CHR(46)) or
(Buffer[I] = CHR(90)) or ((Buffer[I] >= CHR(49)) and (Buffer[I] <= CHR(57)))
or ((Buffer[I] >= CHR(65)) and (Buffer[I] <= CHR(90))) or
((Buffer[I] >= CHR(97)) and (Buffer[I] <= CHR(122))) then
begin
StrEmail := StrEmail + Buffer[I];
end
else
begin
StrEmail := '';
Break;
end;
Inc(I);
end;
if StrEmail <> '' then
begin
StrEmail := StrEmail + '.';
Inc(i);
while (Buffer[I] <> '>') and (I <= tamanoBuffer) do
begin
if (Buffer[I] = CHR(45)) or (Buffer[I] = CHR(46)) or
(Buffer[I] = CHR(90)) or ((Buffer[I] >= CHR(49)) and (Buffer[I] <= CHR(57)))
or ((Buffer[I] >= CHR(65)) and (Buffer[I] <= CHR(90))) or
((Buffer[I] >= CHR(97)) and (Buffer[I] <= CHR(122))) then
begin
StrEmail := StrEmail + Buffer[I];
end
else
begin
StrEmail := '';
Break;
end;
Inc(I);
end;
if StrEmail <> '' then
begin
listaEmail.Add (StrEmail);
Inc(I);
end;
end;
end;
end
else
Inc(I);
end;
finally
FreeMem(Buffer);
end;
finally
FileClose(hFile);
end;
end;
procedure TformMenuPrincipal.bObtenerEmailClick(Sender: TObject);
var
listaEmail : TStringList;
begin
mListaEmail.Clear;
tamanoBuffer := verficarFichero (txtFichero.text);
if tamanoBuffer <= 0 then
MessageDlg('El fichero seleccionado no parece tener información.',
mtInformation, [mbok], 0)
else
begin
listaEmail := TStringList.Create;
obtenerEmails (txtFichero.text, listaEmail);
mListaEmail.Lines := listaEmail;
end;
end;
procedure TformMenuPrincipal.bSelClick(Sender: TObject);
begin
dlAbrir.Filter := 'Outlook Express (*.dbx)|*.dbx|Todos los archivos (*.*)|*.*';
if dlAbrir.Execute then
txtFichero.Text := dlAbrir.FileName;
end;
end.
Necesitarás los siguientes componentes en el formulario:
Puede publicar nuevos temas en este foro No puede responder a temas en este foro No puede editar sus mensajes en este foro No puede borrar sus mensajes en este foro No puede votar en encuestas en este foro
Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A