Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Закрытая тема
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 21.01.2015, 08:46
Максим_mk Максим_mk вне форума
Прохожий
 
Регистрация: 21.01.2015
Сообщения: 4
Версия Delphi: Lazarus
Репутация: 10
По умолчанию Помогите изменить код

Есть такой код - я его уже немного поправил, но вот как приделать к нему такую возможность: открытие поочередно 10 файлов формата eml, и скопировать все что находиться в теле письма. Сижу уже не первый день

Код:
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, mimemess, mimepart, ExtCtrls, ComCtrls, ActiveX;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure GetParts(const part: TMimepart);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
    IdMes:TMimeMess;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
 
procedure TForm1.GetParts(const part: TMimepart);
var
  s: string;
  i: integer;
begin
  if (LowerCase(part.Primary)='text') and (LowerCase(part.FileName)='')  then  //Проверим  что данный блок - текст сообщения
  begin
  part.DecodePart;
    if LowerCase(part.Secondary)='plain'   then    // Определяем что это простой текст
         Memo1.Lines.LoadFromStream(part.DecodedLines); // Загружаем раскодированные данные
    end;
 
  for i := 0 to part.GetSubPartCount - 1 do
    GetParts( part.getsubpart(i));     // проверяем наличие следующего блока
end;
 
 
 
 
 
procedure TForm1.Button1Click(Sender: TObject);
  var
i:integer;
begin
  if OpenDialog1.Execute then
  begin
    IdMes:=TMimeMess.Create;
    IdMes.Lines.LoadFromFile(OpenDialog1.FileName);
  end;
    IdMes.DecodeMessage;     // Раскодируем сообщение, обязательно
    Memo2.Lines.Assign(IdMes.Header.CustomHeaders); // Заголовки, не спицифичные для формата MIME
    GetParts(IdMes.MessagePart);    // рекурсивная процедура обхода блоков сообщения
 
 
end;
 
 
end.
  #2  
Старый 21.01.2015, 15:40
Аватар для Kailon
Kailon Kailon вне форума
Активный
 
Регистрация: 06.06.2010
Сообщения: 339
Версия Delphi: 10.4
Репутация: 429
Сообщение

Код:
var
  SearchResult: TSearchRec;
begin
  if FindFirst('*.eml', faAnyFile, SearchResult) = 0 then
    repeat
      //что-то делаешь
    until FindNext(SearchResult) <> 0;
  FindClose(SearchResult);
end;
__________________
Всегда пишите код так, будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете.
  #3  
Старый 21.01.2015, 22:21
Максим_mk Максим_mk вне форума
Прохожий
 
Регистрация: 21.01.2015
Сообщения: 4
Версия Delphi: Lazarus
Репутация: 10
По умолчанию

Спасибо за ответ, попробую.
  #4  
Старый 21.01.2015, 23:09
Максим_mk Максим_mk вне форума
Прохожий
 
Регистрация: 21.01.2015
Сообщения: 4
Версия Delphi: Lazarus
Репутация: 10
По умолчанию

Готовый код, все можно закрывать тему. Осталась только работа с Memo, ну это уже в другой теме)))
Код:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, mimemess, mimepart, ExtCtrls, ComCtrls, ActiveX;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure GetParts(const part: TMimepart);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
    IdMes:TMimeMess;

implementation

{$R *.lfm}

{ TForm1 }


procedure TForm1.GetParts(const part: TMimepart);
var
  s: string;
  i: integer;
begin
  if (LowerCase(part.Primary)='text') and (LowerCase(part.FileName)='')  then  //Проверим  что данный блок - текст сообщения
  begin
  part.DecodePart;
    if LowerCase(part.Secondary)='plain'   then    // Определяем что это простой текст
         Memo1.Lines.LoadFromStream(part.DecodedLines); // Загружаем раскодированные данные
    end;

  for i := 0 to part.GetSubPartCount - 1 do
    GetParts( part.getsubpart(i));     // проверяем наличие следующего блока
end;





procedure TForm1.Button1Click(Sender: TObject);
  var
     i:integer;
     SearchResult: TSearchRec;
begin
    if FindFirst('*.eml', faAnyFile, SearchResult) = 0 then
    repeat
      IdMes:=TMimeMess.Create;
      IdMes.Lines.LoadFromFile(SearchResult.Name);
      IdMes.DecodeMessage;
      Memo2.Lines.Assign(IdMes.Header.CustomHeaders);
      GetParts(IdMes.MessagePart);
      Memo3.Lines.Add(Memo1.Text);

    until FindNext(SearchResult) <> 0;
  FindClose(SearchResult);



 { if OpenDialog1.Execute then
  begin
    IdMes:=TMimeMess.Create;
    IdMes.Lines.LoadFromFile(OpenDialog1.FileName);
  end;
    IdMes.DecodeMessage;     // Раскодируем сообщение, обязательно
    Memo2.Lines.Assign(IdMes.Header.CustomHeaders); // Заголовки, не спицифичные для формата MIME
    GetParts(IdMes.MessagePart);    // рекурсивная процедура обхода блоков сообщения

            }
end;


end.

Закрытая тема


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 01:18.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter