fmailview.pas

siMail, siMail, siMail, siMail

          for j := prevQuotes downto c do begin
            s := s + cDivEnd;
            Dec(notClosedTags);
          end;
        end;

        if c > 0 then begin
          if prevQuotes <> c then begin
            Inc(prevQuotes); //HACK: we don't need to quote again if we have as may quotes as before
            for j := prevQuotes to c do begin
              Inc(notClosedTags);
              s := s + Format(cDivStart, [j]);
            end;
          end;
        end;

        //add current string but without quotes
        s := s + RightStr(txt, Length(txt) - c);

        prevQuotes := c;
        l.Strings[i] := s;
      end;
      //close finnal tags
      s := '';
      if notClosedTags <> 0 then begin
        for j := notClosedTags downto 0 do
          s := s + cDivEnd;
      end;
      l.Add(s);
      s := l.Text;
      FreeAndNil(l);
    end
    else //else if find quotese is disabled
      s := txt;

    txt := '';
    c := Length(s);

    i := 1;
    while i < c do begin
      (*if s[i] = '&' then
          txt:=txt + #08'amp;'
      else*) if s[i] = '<' then
        txt := txt + #08'lt;'
      else if s[i] = '>' then
        txt := txt + #08'gt;'
      else if s[i] = '"' then
        txt := txt + '&quot;'
      else if (s[i] = #09) then
        txt := txt + #08'nbsp;' + #08'nbsp;' + #08'nbsp;' + #08'nbsp;'
      else if (s[i] = #13) then
        txt := txt + '<br />'
      else if (s[i] = #10) then begin
        if (i + 1 <= c) and (s[i + 1] = #13) and (s[i] = #10) then begin
          Inc(i);
          txt := txt + '<br />';
        end;
      end
      else
        txt := txt + s[i];
      Inc(i);
    end;
    txt := doAnchors(txt);
    txt := StringReplace(txt, #08, '&', [rfReplaceAll]);
    txt := StringReplace(txt, #05, '<', [rfReplaceAll]);
    txt := StringReplace(txt, #06, '>', [rfReplaceAll]);
    txt := StringReplace(txt, #07, '"', [rfReplaceAll]);
  end;
  txt := UTF8Encode(txt);
  strm.Write(txt[1], Length(txt));
  strm.WriteBuffer(cHtmlFooter, Length(cHtmlFooter));

end;

(*procedure TfrmMailView.writeHtml(strm: TFileStream; txt: String);
var theRegex:IRegex;
var theRegexRepl:IRegex;
var theMatch:IMatch;
var theMatchRepl:IMatch;
var offset,offsetPrev:Integer;
var tmpStr:String;
const regExpr = '(?imxs) (<img.*?src\s*=\s*"cid:.*?>)';
const regExprRepl = '(?imxs) (\s*src\s*=\s*"cid:.*?")';
var Result:String;
begin

    theRegex:=RegexCreate(regExpr, [], 'C');
    theRegexRepl:=RegexCreate(regExprRepl, [], 'C');
    //replace all cids with fileNames
    offset:=1;
    offsetPrev:=1;
    theMatch:=theRegex.Match(txt, offset-1, [rmoNotEmpty]);
    tmpstr:='';
    while theMatch.Matched do begin
        offset:=Max(theMatch.Index + theMatch.Length + 1, offset + 1);
        if offsetPrev < theMatch.Index then begin
            tmpStr:=Copy(txt,offsetPrev,1 + theMatch.Index - offsetPrev);
        end
        else tmpStr:='';

        if not(tmpStr = '') then begin //replace
            theMatchRepl:=theRegexRepl.Match(theMatch.Value, 0, [rmoNotEmpty]);
                Result:=Result + tmpStr + GetFileNameForCid(theMatch.Value,theMatchRepl.Value);
        end;
        offsetPrev:=offset;
        theMatch:=theRegex.Match(txt, offset-1, [rmoNotEmpty]);
    end;

    Result:=Result + Copy(txt,offsetPrev,Length(txt) - offsetPrev + 1);

    strm.Write(Result[1],Length(Result));

end;*)

procedure TfrmMailView.writeHtml(strm: TFileStream; txt: String);
var theRegex: IRegex;
var theRegexRepl: IRegex;
var theMatch: IMatch;
var theMatchRepl: IMatch;
var offset, offsetPrev: Integer;
var tmpStr, tmpStr2: String;
const regExpr = '(?imxs) (cid:.*?((\s|"|''|>)+?))';
//const regExprRepl = '(?imxs) (\s*src\s*=\s*"cid:.*?")';
var Result: String;
var htmlDoc: TDocument;
var htmlParser: THtmlParser;
var formatter: TBaseFormatter;
const regMeta = '(?imxs) <meta\s.*"text\/html;\s*?charset\s*?=\s*?([a-zA-Z0-9_-]*)';
var FCharsetCode, FTargetCharset: TMimeChar;
begin
  if chkHtmlAsText.Checked then begin
    //find html charset
    theRegex := RegexCreate(regMeta, [], 'C');
    theMatch := theRegex.Match(txt, 0, [rmoNotEmpty]);
    Result := theMatch.Groups.Items[1].Value;
    FTargetCharset := GetCurCP;
    if Result = '' then
      FCharsetCode := FTargetCharset
    else
      FCharsetCode := GetCPFromID(Result);
    theMatch := nil;
    theRegex := nil;

    htmlParser := THtmlParser.Create;
    htmlDoc := htmlParser.parseString(txt);
    FreeAndNil(htmlParser);

    formatter := TTextFormatter.Create;
    txt := formatter.getText(htmlDoc);
    txt := CharsetConversion(txt, FCharsetCode, FTargetCharset);
    writePlain(strm, txt);
    Exit;
  end;

  theRegex := RegexCreate(regExpr, [], 'C');
//    theRegexRepl:=RegexCreate(regExprRepl, [], 'C');
    //replace all cids with fileNames
  offset := 1;
  offsetPrev := 1;
  theMatch := theRegex.Match(txt, offset - 1, [rmoNotEmpty]);
  tmpstr := '';
  while theMatch.Matched do begin
    offset := Max(theMatch.Index + theMatch.Length + 1, offset + 1);
    if offsetPrev < theMatch.Index then begin
      tmpStr := Copy(txt, offsetPrev, 1 + theMatch.Index - offsetPrev);
    end
    else tmpStr := '';

    if not (tmpStr = '') then begin //replace
            //theMatchRepl:=theRegexRepl.Match(theMatch.Value, 0, [rmoNotEmpty]);
            //    Result:=Result + tmpStr + GetFileNameForCid(theMatch.Value,theMatchRepl.Value);
      tmpStr2 := TrimPunctuation(TheMatch.Value);
            //write filename to tmpStr2
      tmpStr2 := Fcid2fn.FileName(Fcid2fn.FindFileName('<' +
        RightStr(tmpStr2, Length(tmpStr2) - 4) + '>'));
            //if file name is '' then copy match back
      if tmpStr2 = '' then
        Result := Result + tmpStr + TheMatch.Value
      else begin
        if tmpStr <> '' then begin
          if (tmpStr[Length(tmpStr)] = '"') or
            (tmpStr[Length(tmpStr)] = '''') then
            tmpStr := LeftStr(tmpStr, Length(tmpStr) - 1);

          Result := Result + tmpStr + '"' + tmpStr2 + '"';
        end;
      end;
    end;
    offsetPrev := offset;
    theMatch := theRegex.Match(txt, offset - 1, [rmoNotEmpty]);
  end;

  Result := Result + Copy(txt, offsetPrev, Length(txt) - offsetPrev + 1);

  for offset := 0 to Fcid2fn.Count - 1 do begin
    if (LowerCase(LeftStr(Fcid2fn.Cid(offset), 7)) = 'http://') or
      (LowerCase(LeftStr(Fcid2fn.Cid(offset), 6)) = 'ftp://') then begin
      Result := StringReplace(Result, Fcid2fn.Cid(offset),
        Fcid2fn.FileName(offset), [rfReplaceAll, rfIgnoreCase])
    end;
  end;
  strm.Write(Result[1], Length(Result));

end;

function TfrmMailView.readStringFromStream(stream: TStream; len: Integer): String;
begin
  SetLength(Result, len);
  stream.Read(PChar(Result)^, len);
end;

procedure TfrmMailView.SetLargeHeaders(const Value: Boolean);
begin
  FLargeHeaders := Value;
end;

procedure TfrmMailView.msgAttachmentsGetImageIndex(
  Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
  Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
begin
  //return correct attachment image
  with PTreeAttach((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
    if (Column = 0) and (Kind in [ikNormal, ikSelected]) then ImageIndex := iconId;
  end;
end;

procedure TfrmMailView.msgAttachmentsGetNodeDataSize(
  Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
  NodeDataSize := sizeOf(TTreeAttach);
end;

procedure TfrmMailView.msgAttachmentsGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
begin
  //return each column's text
  with PTreeAttach((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
    case Column of
      0:
      begin
        if mime <> nil then
          CellText := mime.FileName
        else
          CellText := ExtractFileName(FileName);
      end;
      1:
      begin
        if size <> 0 then
          CellText := frmMain.sizeToString(size)
        else
          CellText := '';
      end;
    end;
  end;
end;

//this procedure breaks message to their parts
procedure TfrmMailView.MessageBreakApart(mime_: TMimePart; attachment: Boolean);
var i: Integer;
var tmpStr: String;
var at: PVirtualNode;
begin
  for i := 0 to mime_.GetSubPartCount - 1 do begin
    if (mime_.GetSubPart(i).GetSubPartCount = 0) and
      (mime_.GetSubPart(i).FileName = '') then begin //probably text message
      addNewMenu(LowerCase(mime_.GetSubPart(i).Primary) + '/' +
        LowerCase(mime_.GetSubPart(i).Secondary),
        mime_.GetSubPart(i));
    end
    else if mime_.GetSubPart(i).FileName <> '' then begin //attachment
      if not attachment then begin
        attachment := True;
      end;

      if mime_.GetSubPart(i).ContentID <> '' then
        Fcid2fn.Add(mime_.GetSubPart(i).ContentID, mime_.GetSubPart(
          i).FileName, mime_.GetSubPart(i));
      if mime_.GetSubPart(i).ContentLocation <> '' then
        Fcid2fn.Add(mime_.GetSubPart(i).ContentLocation,
          ExtractFileNameFromURL(mime_.GetSubPart(i).ContentLocation), mime_.GetSubPart(i));

      //add attachment to list
      at := msgAttachments.AddChild(nil);
      with PTreeAttach(msgAttachments.GetNodeData(at))^ do begin
        mime := mime_.GetSubPart(i);
        iconID := frmMain.FindFileIcon(
          ilFiles, mime_.GetSubPart(i).FileName, False);
        size := mime.DecodedLines.Size;
      end;

      tmpStr := LowerCase(mime_.GetSubPart(i).Secondary);
      //we can display jpeg,gif,png & bmp
      if (tmpStr = 'jpeg') or (tmpStr = 'gif') or (tmpStr = 'png') or
        (tmpStr = 'bmp') then
        addNewMenu(LowerCase(mime_.GetSubPart(i).FileName),
          mime_.GetSubPart(i));
    end //end if
    else if mime_.GetSubPart(i).GetSubPartCount > 0 then begin
      MessageBreakApart(mime_.GetSubPart(i), attachment);
    end;
  end;
end;

procedure TfrmMailView.msgAttachmentsGetPopupMenu(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
  var AskParent: Boolean; var PopupMenu: TPopupMenu);
begin
  if Sender.SelectedCount > 0 then
    PopupMenu := popAttach;
end;

procedure TfrmMailView.actSaveAttachExecute(Sender: TObject);
var node: PVirtualNode;
var nd: PTreeAttach;
var fs: TFileStream;
begin
  node := msgAttachments.GetFirstSelected;
  while node <> nil do begin
    nd := PTreeAttach(msgAttachments.GetNodeData(node));
    with SaveDialog1 do begin
      if nd.mime <> nil then begin
        FileName := nd.mime.FileName;
        if Execute then begin
          nd.mime.DecodePart;
          fs := TFileStream.Create(FileName, fmCreate);
          try
            nd.mime.DecodedLines.SaveToStream(fs);
          finally
            FreeAndNil(fs);
          end;
        end
        else
          break;
      end
      else begin
        fileName := nd.fileName;
        if Execute then
          CopyFile(PChar(nd.fileName), PChar(fileName), False)
        else
          break;
      end;
    end;
    node := msgAttachments.GetNextSelected(node);
  end;
end;

procedure TfrmMailView.FormShow(Sender: TObject);
begin
  warningUpdate;
  loadHtmlOptions;

  if Self.Owner = Application then begin
    //tbMenu.Visible := True;
    tbToolbar.Visible := True;
    Self.Caption := _('Message view') + ' - ' + Subject;
    frmMailbox.Profile.Config.ReadControlSettings(self, 'frmMailView');
  end;
  //translate me
  //TP_GlobalIgnoreClassProperty(TWebBrowser,'StatusText');
  //TranslateComponent(Self);
end;

function TfrmMailView.GetFileNameForCid(str1, str2: String): String;
var theRegex: IRegex;
var theMatch: IMatch;
const regExpr = '(?imxs) ("cid:.*?")';
begin

  theRegex := RegexCreate(regExpr, [], 'C');
  //replace cid: with fileName
  theMatch := theRegex.Match(str2, 0, [rmoNotEmpty]);
  Result := theRegex.Replace(str1, '"' + Fcid2fn.FileName(Fcid2fn.FindFileName('<' +
    Copy(theMatch.Value, 6, theMatch.Length - 6) + '>')) + '"');