unit fmInmHistory;

interface

uses
  Dockable,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, RichEdit2, ExRichEdit, Menus, ExtCtrls;

const
  WM_INITINMLIST = WM_APP + 5678;

type
  TInmHistoryForm = class(TfrmDockable)
    lvInm: TListView;
    Panel1: TPanel;
    Splitter1: TSplitter;
    MainMenu1: TMainMenu;
    pnltitle: TPanel;
    txtMsg: TExRichEdit;
    lblFrom: TLabel;
    lblSubject1: TLabel;
    txtFrom: TLabel;
    txtSubject: TLabel;
    PopHistory: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure lvInmChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure lvInmDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure lvInmKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    procedure initinmlist(var msg: Tmessage); message WM_INITINMLIST;
    procedure Addinm(inmFn: string);
  public
    { Public declarations }
    procedure showinmmsg(inmFn: string);
  end;

var
  InmHistoryForm: TInmHistoryForm;

implementation

uses XMLParser, XMLTag, JabberID, InstantMail;

{$R *.dfm}

function SlashSep(const Path, S: string): string;
begin
  if AnsiLastChar(Path)^ <> '\' then
    Result := Path + '\' + S
  else
    Result := Path + S;
end;

function ReadInms(const ParentDirectory: string;
  HistoryList: TStringList): Integer;
var
  Status: Integer;
  SearchRec: TSearchRec;
begin
  Result := 0;
  Status := FindFirst(SlashSep(ParentDirectory, '*.inm'), faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory <> faDirectory) then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          HistoryList.Add(SearchRec.Name);
          Inc(Result);
        end;
      end;
      Status := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
  end;
end;

procedure TInmHistoryForm.Addinm(inmFn: string);
var
  parser: TXMLTagParser;
  XmlTag, tmptag: TXMLTag;
  TagList: TXMLTagList;
  i: Integer;
  ssize: string;
begin
  parser := TXMLTagParser.Create;
  parser.ParseFile(inmFn);
  XmlTag := nil;
  if parser.Count > 0 then
    XmlTag := parser.popTag;
  if XmlTag <> nil then
  begin
    lvinm.Items.BeginUpdate;
    with lvinm.Items.Add do
    begin
      caption := XmlTag.GetAttribute('from');
      SubItems.Add(XmlTag.GetBasicText('subject'));
      SubItems.Add(DateTimeToStr(FileDateToDateTime(FileAge(inmFn))));
      SubItems.Add('');
      SubItems.Add('');
      SubItems.Add('');
      SubItems.Add('');
      SubItems.Add('');
      SubItems.Add('');
      SubItems.Add(inmFn);
    end;
    lvinm.Items.EndUpdate;
  end;
  parser.Free;
end;

procedure TInmHistoryForm.FormShow(Sender: TObject);
begin
  PostMessage(handle, WM_INITINMLIST, 0, 0);
end;

procedure TInmHistoryForm.initinmlist(var msg: Tmessage);
var
  InmList: TStringlist;
  i: Integer;
begin
  InmList := TStringlist.Create;
  ReadInms(SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\'), InmList);
  for i := 0 to InmList.Count - 1 do
  begin
    try
      AddInm(SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\' + InmList[i]));
    except
    end;
    Application.ProcessMessages;
  end;
  InmList.free;
end;

procedure TInmHistoryForm.lvInmChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  if Item <> nil then
  try
    if Item.SubItems.Count >= 9 then
      showinmmsg(Item.SubItems[8]);
  except
  end;
end;

procedure TInmHistoryForm.lvInmDblClick(Sender: TObject);
begin
  if lvInm.Selected <> nil then
  try
    showinm(ExtractFileName(lvInm.Selected.SubItems[8]));
  except
  end;
end;

procedure TInmHistoryForm.showinmmsg(inmFn: string);
var
  parser: TXMLTagParser;
  XmlTag, tmptag: TXMLTag;
  tmpjid: TJabberID;
begin
  parser := TXMLTagParser.Create;
  parser.ParseFile(inmFn);
  if parser.Count > 0 then
    XmlTag := parser.popTag;
  if XmlTag <> nil then
  begin
    tmpjid := TJabberID.Create(XmlTag.GetAttribute('from'));
    txtFrom.Caption := tmpjid.user;
    tmpjid.Free;

    txtSubject.Caption := XmlTag.GetBasicText('subject');

    txtMsg.SelectAll;
    if XmlTag.TagExists('rtf') and (XmlTag.GetFirstTag('rtf').Data <> '') then
      txtMsg.RTFSelText := XmlTag.GetFirstTag('rtf').Data
    else
      txtMsg.WideSelText := XmlTag.GetFirstTag('body').Data;
  end;
  parser.Free;
end;

procedure TInmHistoryForm.FormCreate(Sender: TObject);
begin
  txtFrom.Caption := '';
  txtSubject.Caption := '';
end;

procedure TInmHistoryForm.N1Click(Sender: TObject);
begin
  if lvInm.Selected <> nil then
  try
    showinm(ExtractFileName(lvInm.Selected.SubItems[8]));
  except
  end;
end;

procedure TInmHistoryForm.N2Click(Sender: TObject);
begin
  if lvInm.Selected <> nil then
    if MessageBox(self.Handle, pchar('您确定要删除该即时邮件吗？'), nil, MB_YESNO) = IDYes then
    begin
      DeleteFile(SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\' + ExtractFileName(lvInm.Selected.SubItems[8])));
      lvInm.DeleteSelected;
    end;
end;

procedure TInmHistoryForm.lvInmKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Delete then
    if lvInm.Selected <> nil then
      if MessageBox(self.Handle, pchar('您确定要删除该即时邮件吗？'), nil, MB_YESNO) = IDYes then
      begin
        DeleteFile(SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\' + ExtractFileName(lvInm.Selected.SubItems[8])));
        lvInm.DeleteSelected;
      end;
end;

end.
