fmailview.pas

siMail, siMail, siMail, siMail

(*var pos:Integer;
var cid:String;
begin
    cid:=Copy(str1,1 + Length(str2),1 + Length(str1) - Length(str2));

    pos:=1;
    while (cid[pos] <> '"') and (cid[pos] <> ' ') and (cid[pos] <> '''') do begin
        Inc(pos);
        if pos > Length(cid) then begin
            pos:=-1;
            break;
        end;
    end;

    if pos < 0 then
        Result:=cid
    else begin
        Result:=Fcid2fn.FileName(Fcid2fn.FindFileName('<'+Copy(cid,0,pos-1)+'>')) + '"';
        if Result = '' then
            Result:=cid
        else
            Result:='src="' + Result + '" ';
    end;
*)
end;

procedure TfrmMailView.msgAttachmentsDblClick(Sender: TObject);
var nd: PTreeAttach;
var fs: TFileStream;
var fn: String;
begin
  Screen.Cursor := crHourglass;
  nd := PTreeAttach((Sender as TVirtualStringTree).GetNodeData(
    (Sender as TVirtualStringTree).FocusedNode));

  with nd^ do begin
    if mime <> nil then begin
      frmMain.StatusBar1.Panels[infoPanel].Caption :=
        Format(_('Extracting attachment: %s'), [mime.FileName]);
      Application.ProcessMessages;
      mime.DecodePart;
      fn := df.Temp + tmpFilePrefix + IntToHex(GetTickCount, 8) + '-' + mime.FileName;
      fs := TFileStream.Create(fn, fmCreate);
      try
        mime.DecodedLines.SaveToStream(fs);
      finally
        FreeAndNil(fs);
      end;
    end
    else begin
      frmMain.StatusBar1.Panels[infoPanel].Caption :=
        Format(_('Extracting attachment: %s'), [ExtractFileName(fileName)]);
      Application.ProcessMessages;
      fn := fileName;
    end;
  end;
  ShellExecute(Self.Handle, 'open', PChar(fn), nil, nil, SW_SHOWNORMAL);
  Screen.Cursor := crDefault;
  frmMain.StatusBar1.Panels[infoPanel].Caption := '';
end;

procedure TfrmMailView.LoadAttachments(lstAttach: TVirtualStringTree;
  iconList: TImageList; lstFiles: TStringList; fromHeader: Boolean);
var at: PVirtualNode;
var strm: TFileStream;
var i: Integer;
begin
  for i := 0 to lstFiles.Count - 1 do begin
    if fromHeader then
      lstFiles.Strings[i] := UTF8Decode(lstFiles.Strings[i]);
    if FileExists(lstFiles.Strings[i]) then begin
      strm := TfileStream.Create(lstFiles.Strings[i], fmOpenRead or fmShareDenyNone);
      try
        //add attachment to list
        at := lstAttach.AddChild(nil);
        with PTreeAttach(lstAttach.GetNodeData(at))^ do begin
          fileName := lstFiles.Strings[i];
          iconID := frmMain.FindFileIcon(iconList, lstFiles.Strings[i], False);
          size := strm.Size;
          mime := nil;
        end;
      finally
        FreeAndNil(strm);
      end;
    end;
  end;
end;

procedure TfrmMailView.msgViewStatusTextChange(Sender: TObject; const Text: WideString);
begin
  frmMain.StatusBar1.Panels[infoPanel].Caption := Text;
end;

procedure TfrmMailView.cmdZoomPlusClick(Sender: TObject);
begin
  msgImage.Scale := msgImage.Scale + 0.1;
end;

procedure TfrmMailView.cmdZoomMinusClick(Sender: TObject);
begin
  if Trunc(msgImage.Scale * 10) <> 0 then
    msgImage.Scale := msgImage.Scale - 0.1;
end;

function TfrmMailView.lTrimPunctuation(Value: String): String;
var i: Integer;
begin
  //remove <, >, ", ', ' ' from left
  Result := '';
  if Length(Value) = 0 then
    exit;

  i := 1;
  while (Value[i] = '<') or (Value[i] = '''') or
    (Value[i] = ' ') or (Value[i] = '"') or (Value[i] = '>') do Inc(i);

  Result := Copy(Value, i, Length(Value) - i + 1);

end;

function TfrmMailView.rTrimPunctuation(Value: String): String;
var i: Integer;
begin
  //remove <, >, ", ', ' ' from right
  i := Length(Value);
  if i = 0 then
    exit;

  while (Value[i] = '<') or (Value[i] = '''') or
    (Value[i] = ' ') or (Value[i] = '"') or (Value[i] = '>') do Dec(i);

  Result := Copy(Value, 1, i);
end;

function TfrmMailView.TrimPunctuation(Value: String): String;
begin
  Result := lTrimPunctuation(Value);
  Result := rTrimPunctuation(Result);
end;

function TfrmMailView.ExtractFileNameFromURL(Value: String): String;
var i: Integer;
begin
  Result := Value;
  i := Length(Value);
  while i > 0 do begin
    if Value[i] = '/' then break;
    Dec(i);
  end;

  Result := RightStr(Value, -i + Length(Value));
end;

procedure TfrmMailView.clearMenus;
begin
  tbParts.Items.Clear;
end;

procedure TfrmMailView.addNewMenu(caption: String; obj: TMimePart);
var m: TTBXItem;
var sep: TTBXSeparatorItem;
begin
  FMimeParts.Add(obj);

  m := TTBXItem.Create(tbParts);
  m.Caption := caption;
  m.Tag := FMimeParts.Count - 1;
  m.OnClick := tbPartsClick;
  m.AutoCheck := True;
  m.GroupIndex := 1;
  tbParts.Items.Add(m);
  sep := TTBXSeparatorItem.Create(tbParts);
  tbParts.Items.Add(sep);
end;

procedure TfrmMailView.insertMenu(position: Integer; caption: String; obj: TMimePart);
var m: TTBXItem;
var sep: TTBXSeparatorItem;
begin
  FMimeParts.Add(obj);

  m := TTBXItem.Create(tbParts);
  m.Caption := caption;
  m.Tag := FMimeParts.Count - 1;
  m.OnClick := tbPartsClick;
  m.AutoCheck := True;
  m.GroupIndex := 1;
  tbParts.Items.Insert(position, m);
  sep := TTBXSeparatorItem.Create(tbParts);
  tbParts.Items.Insert(position, sep);
end;

function TfrmMailView.doAnchors(str: String): String;
const cMail = '(?imxs)(([\w\.\-]+))(@)([\w\.\-]+)';
const cMailRepl = '<a href="mailto:$0">$0</a>';
const cUrl1 = '(?imxs)((((http|https|ftp):\/\/))([\w\.]+)([,:%#&\/?~=\w+\.-]+)((?!&gt;)|(?!&lt;)|(?!&\#)))';
const cUrlRepl1 = '<a href="$1">$1</a>';
const cUrl2 = '(?imxs)(?<!http:\/\/)(((www\.))([\w\.]+)([,:%#&\/?~=\w+\.-]+))';
const cUrlRepl2 = '<a href="http://$1\">$1</a>';
begin
  if regMail = nil then
    regMail := RegexCreate(cMail, [], 'C');

  if regUrl1 = nil then
    regUrl1 := RegexCreate(cUrl1, [], 'C');

  if regUrl2 = nil then
    regUrl2 := RegexCreate(cUrl2, [], 'C');

  Result :=  regMail.Replace(str, cMailRepl);
  Result :=  regUrl1.Replace(Result, cUrlRepl1);
  Result :=  regUrl2.Replace(Result, cUrlRepl2);
end;

procedure TfrmMailView.warningUpdate;
var tmpStr: String;
begin
  if actDOOffline.Checked = False then begin
    //gettext: warning if some options are set on html message view
    lblWarning.Caption := _('WARNING: you are viewing HTML document in online mode with <');

    if actDOImages.Checked then
      //gettext:  warning if some options are set on html message view
      tmpStr := tmpStr + _('download images, ');

    if actDOScripts.Checked then
      //gettext:  warning if some options are set on html message view
      tmpStr := tmpStr + _('run scripts on page, ');

    if actDOActiveXRun.Checked then
      //gettext:  warning if some options are set on html message view
      tmpStr := tmpStr + _('use ActiveX controls, ');
    if Length(tmpStr) > 0 then
      tmpStr := LeftStr(tmpStr, Length(tmpStr) - 2);

    //gettext:  warning if some options are set on html message view
    lblWarning.Caption := lblWarning.Caption + tmpStr + _('> options set.');
    if (tmpStr <> '') and (Pos('html', AnsiLowerCase(FSelectedMessageMime)) > 0 )then
     lblWarning.Visible := True
    else
     lblWarning.Visible := False;
  end
  else
    lblWarning.Visible := False;
end;

procedure TfrmMailView.actDOOfflineExecute(Sender: TObject);
begin
  if (Sender as TAction).Checked then
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_FORCEOFFLINE]
  else
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_FORCEOFFLINE];
  warningUpdate;
  frmMailbox.Profile.Config.WriteBool('frmMailView', 'DLCTL_FORCEOFFLINE',
    (Sender as TAction).Checked);
  msgView.Refresh;
end;

procedure TfrmMailView.actDOOfflineUpdate(Sender: TObject);
begin
  if DLCTL_FORCEOFFLINE in msgView.DownloadOptions then
    (Sender as TAction).Checked := True
  else
    (Sender as TAction).Checked := False;
end;

procedure TfrmMailView.actDOImagesExecute(Sender: TObject);
begin
  if (Sender as TAction).Checked then
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_DLIMAGES]
  else
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_DLIMAGES];
  warningUpdate;
  frmMailbox.Profile.Config.WriteBool('frmMailView', 'DLCTL_DLIMAGES',
    (Sender as TAction).Checked);
  msgView.Refresh;
end;

procedure TfrmMailView.actDOImagesUpdate(Sender: TObject);
begin
  if DLCTL_DLIMAGES in msgView.DownloadOptions then
    (Sender as TAction).Checked := True
  else
    (Sender as TAction).Checked := False;
end;

procedure TfrmMailView.actDOBackgroundMusicExecute(Sender: TObject);
begin
  if (Sender as TAction).Checked then
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_BGSOUNDS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_BGSOUNDS];
  warningUpdate;
  frmMailbox.Profile.Config.WriteBool('frmMailView', 'DLCTL_BGSOUNDS',
    (Sender as TAction).Checked);
  msgView.Refresh;
end;

procedure TfrmMailView.actDOBackgroundMusicUpdate(Sender: TObject);
begin
  if DLCTL_BGSOUNDS in msgView.DownloadOptions then
    (Sender as TAction).Checked := True
  else
    (Sender as TAction).Checked := False;
end;

procedure TfrmMailView.actDOVideosExecute(Sender: TObject);
begin
  if (Sender as TAction).Checked then
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_VIDEOS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_VIDEOS];
  warningUpdate;
  frmMailbox.Profile.Config.WriteBool('frmMailView', 'DLCTL_VIDEOS',
    (Sender as TAction).Checked);
  msgView.Refresh;
end;

procedure TfrmMailView.actDOVideosUpdate(Sender: TObject);
begin
  if DLCTL_VIDEOS in msgView.DownloadOptions then
    (Sender as TAction).Checked := True
  else
    (Sender as TAction).Checked := False;
end;

procedure TfrmMailView.actDOActiveXExecute(Sender: TObject);
begin
  if (Sender as TAction).Checked then
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_NO_DLACTIVEXCTLS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_NO_DLACTIVEXCTLS];
  warningUpdate;
  frmMailbox.Profile.Config.WriteBool('frmMailView', 'DLCTL_NO_DLACTIVEXCTLS',
    (Sender as TAction).Checked);
  msgView.Refresh;
end;

procedure TfrmMailView.actDOActiveXUpdate(Sender: TObject);
begin
  if not (DLCTL_NO_DLACTIVEXCTLS in msgView.DownloadOptions) then
    (Sender as TAction).Checked := True
  else
    (Sender as TAction).Checked := False;
end;

procedure TfrmMailView.actDOScriptsExecute(Sender: TObject);
begin
  if (Sender as TAction).Checked then
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_NO_SCRIPTS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_NO_SCRIPTS];
  warningUpdate;
  frmMailbox.Profile.Config.WriteBool('frmMailView', 'DLCTL_NO_SCRIPTS',
    (Sender as TAction).Checked);
  msgView.Refresh;
end;

procedure TfrmMailView.actDOScriptsUpdate(Sender: TObject);
begin
  if not (DLCTL_NO_SCRIPTS in msgView.DownloadOptions) then
    (Sender as TAction).Checked := True
  else
    (Sender as TAction).Checked := False;
end;

procedure TfrmMailView.actDOJavaExecute(Sender: TObject);
begin
  if (Sender as TAction).Checked then
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_NO_JAVA]
  else
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_NO_JAVA];
  warningUpdate;
  frmMailbox.Profile.Config.WriteBool('frmMailView', 'DLCTL_NO_JAVA',
    (Sender as TAction).Checked);