fmailview.pas

siMail, siMail, siMail, siMail

  htmlIdx := -1;
  if tbParts.Items.Count > 1 then begin
    for i := 0 to tbParts.Items.Count - 1 do begin
      if BoyerMoore('plain', PChar(tbParts.Items[i].Caption)) > 0 then begin
        if plainIdx < 0 then
          plainIdx := i;
      end
      else if BoyerMoore('html', PChar(tbParts.Items[i].Caption)) > 0 then begin
        if htmlIdx < 0 then
          htmlIdx := i;
      end;
    end;
    tbParts.Visible := True;
  end
  else if msgAttachments.RootNodeCount > 0 then
    tbParts.Visible := True
  else tbParts.Visible := False;

  //set raw view if raw over html is set

  if (htmlIdx > 0) and (frmMailbox.Profile.Config.ReadBool('frmMailView', 'rawOverHtml', True)) then
    htmlIdx := 0;

  case frmMailbox.Profile.Config.ReadInteger('frmMailView', 'showMessagePart', 0) of
  0: begin //last remembered
    //display message in style previous message was selected
    messageMode := frmMailbox.Profile.Config.ReadString('frmMailView',
      'lastMessageStyleView', 'plain');
    if  messageMode = 'plain' then begin
      if plainIdx > 0 then
        tbParts.Items[plainIdx].Click
      else if (htmlIdx > 0) then
        tbParts.Items[htmlIdx].Click
      else
        tbParts.Items[0].Click;
    end
    else if messageMode = 'html' then begin
      if htmlIdx > 0 then
        tbParts.Items[htmlIdx].Click
      else if plainIdx > 0 then
        tbParts.Items[plainIdx].Click
      else
        tbParts.Items[0].Click;
    end
    else
      tbParts.Items[0].Click;
  end;
  1: begin //raw mode
    tbParts.Items[0].Click;
  end;
  2: begin // text/plain
    if plainIdx > 0 then
      tbParts.Items[plainIdx].Click
    else if (htmlIdx > 0) then
      tbParts.Items[htmlIdx].Click
    else
      tbParts.Items[0].Click;
  end;
  3: begin // text/html
    if htmlIdx > 0 then
      tbParts.Items[htmlIdx].Click
    else if plainIdx > 0 then
      tbParts.Items[plainIdx].Click
    else
      tbParts.Items[0].Click;
  end;
  else //show raw mode
    tbParts.Items[0].Click;
  end;
  if msgAttachments.RootNodeCount > 0 then
    insertMenu(1, _('attachments'), nil);
  Screen.Cursor := crDefault;
end;

procedure TfrmMailView.SetSubject(const Value: String);
begin
  lblSubject.Caption := Value;
  //resize subject
  lblSubject.AutoSize := True;
  lblSubject.AutoSize := False;
end;

function TfrmMailView.GetSubject: String;
begin
  Result := lblSubject.Caption;
end;

function TfrmMailView.GetDate: String;
begin
  Result := lblDate.Caption;
end;

procedure TfrmMailView.SetDate(const Value: String);
begin
  lblDate.Caption := Value;
end;

function TfrmMailView.GetFrom: String;
begin
  Result := lblFrom.Caption;
end;

procedure TfrmMailView.SetFrom(const Value: String);
begin
  lblFrom.Caption := Value;
end;

procedure TfrmMailView.SetFromPicture(const Value: String);
begin
  imgAuthor.Bitmap.LoadFromFile(Value);
end;

procedure TfrmMailView.SetPriority(const Value: Integer);
begin
  FPriority := Value;
  case Value of
    5: begin
      //message priority
      FPriorityString := _('Highest');
      lblPriority.Caption := _('Priority: ') + FPriorityString;
    end;
    4: begin
      //message priority
      FPriorityString := _('High');
      lblPriority.Caption := _('Priority: ') + FPriorityString;
    end;
    3: begin
      //message priority
      FPriorityString := _('Normal');
      lblPriority.Caption := _('Priority: ') + FPriorityString;
    end;
    2: begin
      //message priority
      FPriorityString := _('Low');
      lblPriority.Caption := _('Priority: ') + FPriorityString;
    end;
    1: begin
      //message priority
      FPriorityString := _('Lowest');
      lblPriority.Caption := _('Priority: ') + FPriorityString;
    end;
  end;
end;

procedure TfrmMailView.pnlDetailsResize(Sender: TObject);
begin
  lblSubject.AutoSize := True;
  lblSubject.AutoSize := False;
  if Self.Width - (lblDate.Width + lblSubject.Left + lblSubject.Width + 16) > 0 then
    lblDate.Left := lblSubject.Left + lblSubject.Width + 8
  else begin
    lblDate.Left := Self.Width - (lblDate.Width + 16);
    lblSubject.Width := Self.Width - ((Self.Width - lblDate.Left) +
      lblSubject.Left + 8);
  end;
end;

procedure TfrmMailView.FormDestroy(Sender: TObject);
var i: Integer;
begin
  FreeAndNil(Fmime);
  FreeAndNil(FHeaders);
  //try to delete file(s)
  DeleteFile(df.Temp + FdocFileName);
  for i := 0 to Fcid2fn.Count - 1 do begin
    DeleteFile(Fcid2fn.FileName(i));
  end;
  FreeAndNil(Fcid2fn);
  FreeAndNil(FMimeParts);

  regMail := nil;
  regUrl1 := nil;
  regUrl2 := nil;
end;

procedure TfrmMailView.UnloadDoc;
var i: Integer;
begin
  lblFrom.Caption := '';
  lblSubject.Caption := '';
  lblDate.Caption := '';
  lblPriority.Caption := '';
  imgAuthor.Visible := False;
  msgView.Navigate('about:blank');
  msgView.Visible := True;
  msgView.Align := alClient;
  msgImage.Bitmap.Clear;
  msgImage.Visible := False;
  msgAttachments.Clear;
  msgAttachments.Visible := False;
  tbParts.Visible := False;
  for i := 0 to Fcid2fn.Count - 1 do begin
    DeleteFile(Fcid2fn.FileName(i));
  end;
  FSelectedMessageMime := '';
  Fcid2fn.Clear;
  FMime.Clear;
end;

procedure TfrmMailView.msgViewBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  if not ((URL = 'about:blank') or (ExtractFileDrive(URL) <> '')) then begin
    Cancel := True;
    ShellExecute(Self.Handle, 'open', PChar(String(URL)), nil, nil, SW_SHOWNORMAL);
  end;
end;

procedure TfrmMailView.tbPartsClick(Sender: TObject);
var mime: TMimePart;
var guid: TGUID;
var fs, fs2: TFileStream;
var i: Integer;
begin

  Screen.Cursor := crHourGlass;
  msgView.Navigate('about:blank');
  frmMain.StatusBar1.Panels[infoPanel].Caption :=
    Format(_('Loading message part: %s'), [(Sender as TTBXItem).Caption]);
    FSelectedMessageMime := (Sender as TTBXItem).Caption;
  Application.ProcessMessages;
  mime := nil;
  hideIE;
  msgImage.Visible := False;
  msgAttachments.Visible := False;
  //delete old file(s)
  DeleteFile(df.Temp + FdocFileName);
  for i := 0 to Fcid2fn.Count - 1 do begin
    DeleteFile(Fcid2fn.FileName(i));
  end;
  CreateGUID(guid);

  //load doc or attachment
  mime := TMimePart(FMimeParts.Items[(Sender as TTBXItem).Tag]);
  selectedPartButton := (Sender as TTBXItem);
  if (mime = nil) and ((Sender as TTBXItem).Caption = _('attachments')) then
  begin //probably attachments tab
    msgAttachments.Visible := True;
    msgAttachments.SetFocus;
    Screen.Cursor := crDefault;
    Exit;
  end
  else if mime = nil then begin
    Screen.Cursor := crDefault;
    Exit;
  end;

  if (Sender as TTBXItem).Tag <> 0 then begin
    mime.DecodePart;
    if mime.FileName = '' then begin //message
      msgView.Visible := True;
      msgView.Align := alClient;
      FdocFileName := tmpFilePrefix + GUIDToString(guid) + '.html';
      fs := TFileStream.Create(df.Temp + FdocFileName, fmCreate);
      try
        if (LowerCase(mime.Secondary) <> 'html') or (mime.Secondary = '') then
        begin
          WritePlain(fs, readStringFromStream(
            mime.DecodedLines, mime.DecodedLines.Size));
          frmMailbox.Profile.Config.WriteString(
            'frmMailView', 'lastMessageStyleView', 'plain');
        end
        else if (LowerCase(mime.Secondary) = 'html') then begin
          frmMailbox.Profile.Config.WriteString(
            'frmMailView', 'lastMessageStyleView', 'html');
          //create new file names
          for i := 0 to Fcid2fn.Count - 1 do begin
            CreateGUID(guid);
            Fcid2fn.Replace(i, Fcid2fn.Cid(i), df.Temp + tmpFilePrefix +
              GUIDToString(guid) + ExtractFileExt(Fcid2fn.FileName(i)));
            fs2 := TFileStream.Create(Fcid2fn.FileName(i), fmCreate);
            try
              Fcid2fn.Mime(i).DecodePart;
              Fcid2fn.Mime(i).DecodedLines.SaveToStream(fs2);
            finally
              FreeAndNil(fs2);
            end;
          end;
          WriteHtml(fs, readStringFromStream(
            mime.DecodedLines, mime.DecodedLines.Size));
        end
        else mime.DecodedLines.SaveToStream(fs);
      finally
        FreeAndNil(fs);
      end;
      msgView.Navigate('file:///' + EncodeURL(df.Temp + FdocFileName));
      msgView.Visible := True;
    end
    else begin
      FdocFileName := tmpFilePrefix + IntToHex(GetTickCount, 8) + '-' + mime.FileName;
      fs := TFileStream.Create(df.Temp + FdocFileName, fmCreate);
      try
        mime.DecodedLines.SaveToStream(fs);
      finally
        FreeAndNil(fs);
      end;
      //Let the Internet explorer handles gif images
      //because some stupid company still has patent on LZW compression
      if LowerCase(ExtractFileExt(mime.FileName)) = '.gif' then begin
        msgView.Navigate('file:///' + EncodeURL(df.Temp + FdocFileName));
        msgView.Visible := True;
        msgView.Align := alClient;
      end
      else begin
        msgImage.Scale := 1.0;
        msgImage.Bitmap.LoadFromFile(df.Temp + FdocFileName);
        msgImage.Visible := True;
        msgImage.SetFocus;
      end;
    end;
  end
  else begin
    FdocFileName := tmpFilePrefix + GUIDToString(guid) + '.txt';
    fs := TFileStream.Create(df.Temp + FdocFileName, fmCreate);
    try
      mime.Lines.SaveToStream(fs);
    finally
      FreeAndNil(fs);
    end;
    msgView.Navigate('file:///' + EncodeURL(df.Temp + FdocFileName));
    msgView.Visible := True;
    msgView.Align := alClient;
    frmMailbox.Profile.Config.WriteString('frmMailView', 'lastMessageStyleView', 'raw');
  end;
  warningUpdate;
  Screen.Cursor := crDefault;
  frmMain.StatusBar1.Panels[infoPanel].Caption := '';
end;

procedure TfrmMailView.writePlain(strm: TFileStream; txt: String);
var s: string;
var i, j, c: Integer;
var notClosedTags: Integer;
var prevQuotes: Integer;
var l: TStringList;
var quoteChar: Char;
const cHtmlHeader = '<html><head><meta http-equiv="Content-Type" content="text/html; charset=utf-8" />' +
    '<title>si.Mail message</title><style>body {font: %dpx %s;}</style>%s</head><table><tr><td>';
const cHtmlFooter = '</td></tr></table></html>';
const cDivStart = #05'div class='#07'quoteStyle%d'#07#06;
const cDivEnd = #05'/div'#06;
begin
  buildQuotingStyles;
  s := Format(cHtmlHeader, [frmMailbox.Profile.Config.ReadInteger(
    'frmMailView', 'fontSize', 8), frmMailbox.Profile.Config.ReadString(
    'frmMailView', 'fontName', 'Arial'), quotingStyles]);
  strm.WriteBuffer(s[1], Length(s));

  s := txt;
  //replace all characters that are not allowed in html to their
  //equvalent html encoding. change #10 or #13#10 or #13 to <br />
  if txt <> '' then begin
    //find quotes
    if frmMailbox.Profile.Config.ReadBool('quoting', 'colorizeQuotes', True) then begin
      l := TStringList.Create;
      l.Text := txt;
      notClosedTags := 0;
      prevQuotes := 0;
      quoteChar := frmMailbox.Profile.Config.ReadString('quoting', 'quoteChar', '>')[1];
      for i := 0 to l.Count - 1 do begin
        c := 0;
        txt := l.Strings[i];
        for j := 1 to Length(txt) do begin
          if txt[j] = quoteChar then
            Inc(c)
          else
            break;
        end;
        c := Min(c, 8); //maximum number of quotes is 8
        //first close tags if we have less tags now
        s := '';
        //close if previous quotes if thre is less now
        if (prevQuotes > c) then begin
          Dec(prevQuotes); //HACK: we don't need to quote again if we have as may quotes as before