{----------------------------------------------------------------
  改为由服务器转发，服务器可暂存即时文件直到用户上线接收到文件。
  对<message>消息进行修改，增加<attachment>标识，具体格式如下:
  <message to="" id="jcl_7">
    <body></body>
    <attachment>
      <filename></filename>
      <filesize></filesize>
      <filedata></filedata>
    </attachment>
  </message>
  其中filedata的内容为文件实际内容用base64编码。
 ----------------------------------------------------------------}

unit InstantMail;

interface

uses
  XMLTAG, IBB, Dockable, IdCompressionIntercept, Zlib, udp,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, RichEdit2, ExRichEdit, Buttons, ExtCtrls,
  IdBaseComponent, IdCoder, IdCoder3to4, IdCoderMIME, ToolWin, ImgList,
  Menus, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

type
  TInstantForm = class(TfrmDockable)
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    pnlBottom: TPanel;
    pnlBtn: TPanel;
    btnClose: TButton;
    btnAction: TButton;
    pnlNote: TPanel;
    lbNote: TLabel;
    pnlTitle: TPanel;
    lblFrom: TLabel;
    txtFrom: TLabel;
    lblSubject1: TLabel;
    edtSubject: TEdit;
    txtMsg: TExRichEdit;
    lblAttach: TLabel;
    ToolbarImages: TImageList;
    lvAttach: TListView;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    cboFontName: TComboBox;
    ToolButton7: TToolButton;
    cboFontSize: TComboBox;
    ToolButton8: TToolButton;
    BoldButton: TToolButton;
    ItalicButton: TToolButton;
    UnderlineButton: TToolButton;
    ToolButton9: TToolButton;
    ColorBox1: TColorBox;
    ToolButton4: TToolButton;
    AttachButton: TToolButton;
    PopAttach: TPopupMenu;
    D1: TMenuItem;
    Panel2: TPanel;
    ProgressBar1: TProgressBar;
    N1: TMenuItem;
    O1: TMenuItem;
    AttachAV: TToolButton;
    pnlPlay: TPanel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure spbtnFile1Click(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnActionClick(Sender: TObject);
    procedure cboFontNameChange(Sender: TObject);
    procedure cboFontSizeChange(Sender: TObject);
    procedure BoldButtonClick(Sender: TObject);
    procedure ItalicButtonClick(Sender: TObject);
    procedure UnderlineButtonClick(Sender: TObject);
    procedure ColorBox1Change(Sender: TObject);
    procedure txtMsgSelectionChange(Sender: TObject);
    procedure lvAttachInsert(Sender: TObject; Item: TListItem);
    procedure lvAttachDeletion(Sender: TObject; Item: TListItem);
    procedure AttachButtonClick(Sender: TObject);
    procedure pnlTitleResize(Sender: TObject);
    procedure D1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure O1Click(Sender: TObject);
    procedure PopAttachPopup(Sender: TObject);
    procedure AttachAVClick(Sender: TObject);
  private
    { Private declarations }
    _task: TAnyQBaseUDPTask;
    _taskhost: TStringList;
    FBuffer: array[0..4999] of char;
    fs: TFileStream;

    _ReadyID: widestring;
    BlockSize: Integer;
    _Updateing: Boolean;
    filename: string;
    FZRec: TZStreamRec;
    procedure GetFontNames;
    function CurrText: TTextAttributes98;
    procedure AdjectlvAttach;
    procedure InstantmailCallback(event: string; tag: TXMLTag);
    procedure SaveAttach(fn: string);
    procedure WMAnyQSTARTUDPSEND(var msg: TMessage); message WM_AnyQ_STARTUDPSEND;
    procedure AfterReocordClose(Sender: TObject);
  public
    { Public declarations }
    _JID: widestring;
    _SID: widestring;
    Buf: widestring;
    BufStream: TFileStream;
    SeqNo: cardinal;
    SeqCount: cardinal;
    ShareTag: TXMLTAG;
    Mode: Integer; //0:send; 1:Receive;
    TaskID: TGUID;

    procedure Init(initMode: Integer);

    procedure preparesend;

    procedure sendudpRequest;
    procedure sendbyudp;

    procedure udpstartSend;
    procedure udpsendnext;

    procedure UdpRcv(sender: TObject; Adata: TStream);
    procedure UdpRcvStatus(sender: TObject);
    procedure UdpFail(sender: TObject);
    procedure UdpTimeout(Sender: TObject);
    procedure InitRcv;

    procedure ProcessReceive(tag: TXMLTag);
    procedure startsend;
    procedure Send(sender: TJabberIBBTask);
    procedure sendbyhttp;
    procedure sendbyibb;
    procedure showinmmessage;
  end;

var
  InstantForm: TInstantForm;

procedure RcvAttachment(tag: TXMLTag);

procedure showinm(fn: string);
procedure InstantMailReceive(tag: TXMLTag); overload;
procedure InstantmailReceive(from, url, ID: widestring); overload;
procedure InstantmailReceive(task: TAnyQBaseUDPTask; from, desc, rcvfilename: string; size: Int64; hosts: TStringList); overload;
procedure InstantMailSend(tojid: string; fn: string = '');

implementation

uses JabberID, presence, Roster, Session, XMLUtils, JabberConst, shellapi, math,
  RiserWindow, commctrl, Types, DateUtils, iq, RosterWindow, filectrl, zlibconst,
  FileServer, ExSession, XMLParser, AvRecorder, AvPlayer, StrUtils,
  Jabber1;

{$R *.dfm}

function CCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise ECompressionError.Create(sError); //!!
end;

function DCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EDecompressionError.Create(sError); //!!
end;

function sizestr(size: Integer): widestring;
begin
  Result := '';
  size := Ceil(size / 1024);
  Result := FormatFloat('#,##0 KB', size);
end;

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

procedure showinm(fn: string);
var
  frm: TInstantForm;
begin
  frm := TInstantForm.Create(Application);
  frm.Init(1);
  frm.filename := fn;
  frm.showinmmessage;
end;

procedure RcvAttachment(tag: TXMLTag);
var
  frm: TInstantForm;
  fs: TFileStream;
  DeCoder: TIdDecoderMIME;
  fn, tmpfn, tmpext, buf, body: Widestring;
  From, SID: Widestring;
  i: integer;
  atag: TXMLTag;
begin
  atag := tag.GetFirstTag('attachment');
  if atag = nil then exit;

  From := tag.GetAttribute('from');
  fn := atag.GetBasicText('filename');
  fn := SlashSep(MainSession.Prefs.getString('xfer_path'), fn);
  tmpfn := fn;
  tmpext := ExtractFileExt(fn);
  i := 1;
  while FileExists(tmpfn) do
  begin
    inc(i);
    tmpfn := fn;
    tmpfn := ChangeFileExt(tmpfn, '');
    tmpfn := tmpfn + ' (' + inttostr(i) + ')';
    tmpfn := ChangeFileExt(tmpfn, tmpext);
  end;
  fn := tmpfn;

  ForceDirectories(ExtractFilePath(fn));
  fs := TFileStream.Create(fn, fmCreate);
  DeCoder := TIdDecoderMIME.Create(nil);
  buf := atag.GetBasicText('filedata');
  DeCoder.DecodeToStream(buf, fs);
  DeCoder.Free;
  fs.Free;

  body := tag.GetFirstTag('body').Data;
//  body := body+#13+#10+'文件已保存到 '+fn;
//  tag.GetFirstTag('body').ClearCData;
//  tag.GetFirstTag('body').AddCData(body);

  frm := TInstantForm.Create(Application);
  frm._JID := From;
  frm.Init(1);
  frm.txtMsg.Lines.Add(body);
  frm.edtSubject.Text := tag.GetFirstTag('subject').Data;
//  frm.edtFileName.Text := fn;
  frm.show;
end;

procedure InstantMailReceive(tag: TXMLTag);
var
  frm: TInstantForm;
  qtag, taskinfo: TXMLTag;
  From, SID: Widestring;
  task: TJITRcvInstantMail;
  GUID: TGUID;
  i: Integer;
begin
  frm := nil;
  From := tag.GetAttribute('from');
  qtag := tag.GetFirstTag('query');
  taskinfo := qtag.GetFirstTag('taskinfo');
  if qtag = nil then exit;

  SID := qtag.GetAttribute('sid');
  if SID = '' then exit;

  for i:= Application.ComponentCount-1 downto 0 do
    if Application.Components[i] is TInstantForm then
      if IsEqualGUID(TInstantForm(Application.Components[i]).TaskID, StringToGUID(SID)) then
      begin
        frm := TInstantForm(Application.Components[i]);
        break;
      end;

  if frm = nil then
  begin
    frm := TInstantForm.Create(Application);
    frm.tag := 1;
  end;

  frm._JID := From;
  frm.Init(1);
  frm._SID := SID;
  frm._ReadyID := tag.GetAttribute('id');

  frm.filename := taskinfo.GetBasicText('filename');
  if frm.filename = '' then
  begin
    CreateGUID(GUID);
    frm.filename := GUIDToString(GUID) + '.inm';
  end;

  task := TJITRcvInstantMail.Create;
  with task do
  begin
    TOJID := frm._JID;
    IBBController := MainIBBController;
    IBBSID := frm._SID;
    frm._SID := IBBSID;
    OnProcessReceive := frm.ProcessReceive;
    frm.BufStream := TFileStream.Create(SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\' + frm.filename), fmCreate);
    SendReady(frm._ReadyID);
  end;
  MainIBBController.AddTask(task.IBBSID, task);
  frm.SeqNo := 0;
  frm.SeqCount := 0;
  frm.Buf := '';

//  frm.show;
end;

procedure InstantMailSend(tojid: string; fn: string = '');
var
  tmp_id: TJabberID;
  ip, tmps: string;
  pri: TJabberPres;
  ritem: TJabberRosterItem;
  p: integer;
  frm: TInstantForm;
  f: file;
begin
  tmp_id := TJabberID.Create(tojid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      MessageBox(application.Handle, '只能给连机用户发送即时文件!', '错误', MB_OK or MB_ICONERROR);
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := tojid;

  tojid := tmps;
//  tmp_id.Free();
{}
  if tojid = '' then exit;
  frm := TInstantForm.Create(Application);

//  if (fn <> '') then
//    frm.edtFileName.Text := fn;
//  else begin
//    if not frm.OpenDialog1.Execute then exit;
//    try
//      assignfile(f,frm.OpenDialog1.Filename);
//      reset(f);
//      if FileSize(f)>1024*1024 then
//      begin
//        MessageBox(application.Handle, '即时文件大小不能超过1M!', '错误', MB_OK OR MB_ICONERROR);
//        exit;
//      end;
//      CloseFile(f);
//      frm.edtFileName.Text := frm.OpenDialog1.Filename;
//    except
//      MessageBox(application.Handle, '文件正被使用，无法发送!', '错误', MB_OK OR MB_ICONERROR);
//      exit;
//    end;
//  end;

  frm._JID := tojid;

  frm.txtFrom.Caption := tmp_id.user;
  tmp_id.free;
  frm.Init(0);

  frm.show;
end;

{ TInstantForm }

procedure TInstantForm.Init(initMode: Integer);
begin
  mode := initMode;
  case mode of
    0: begin
        caption := '发送即时邮件';
        lblFrom.Caption := '发往:';
//        lblFile.Caption := '附件:';
//        spbtnFile.hint := '选择要发送的文件';
        btnAction.Caption := '发送';
        CoolBar1.Visible := true;
        pnlBottom.Visible := true;
        txtMsg.ReadOnly := false;
        n1.Visible := false;
        O1.Visible := false;
        D1.Visible := true;
      end;
    1: begin
        caption := '收到即时邮件';
        lblFrom.Caption := '来自:';
//        lblFile.Caption := '附件:';

        CoolBar1.Visible := false;
        pnlBottom.Visible := false;
        txtMsg.ReadOnly := true;
//        spbtnFile.hint := '转到附件所在目录';
        btnAction.Visible := false;
        btnClose.Caption := '关闭';
        n1.Visible := true;
        O1.Visible := true;
        D1.Visible := false;
      end;
  end;
  pnlNote.Visible := false;
  edtSubject.ReadOnly := Mode = 1;
//  edtFileName.ReadOnly := Mode=1;
  txtmsg.ReadOnly := Mode = 1;
//  pnlProgress.Visible := false;
end;

procedure TInstantForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if MainIBBController<>nil then
    if MainIBBController.FindTask(_SID) <> nil then
      MainIBBController.FindTask(_SID).Close;
  if UDPController<>nil then
    if _task<> nil then
      FreeAndNil(_task);
  if BufStream<> nil then
    FreeAndNil(BufStream);
  Action := caFree;
end;

procedure TInstantForm.FormCreate(Sender: TObject);
var
  i: Integer;
  si: TSHFILEINFO;
  ImageListHandle: THandle;
begin
  inherited;
  ImageListHandle := SHGetFileInfo('C:\',
    0,
    SI,
    SizeOf(SI),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  SendMessage(lvAttach.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, ImageListHandle);
  txtFrom.Caption := '';
  BlockSize := 4096;

  GetFontNames;
  cboFontName.ItemIndex := cboFontName.Items.IndexOf(txtMsg.Font.Name);
  for i := 6 to 32 do
  begin
    cboFontSize.Items.Add(IntToStr(i));
  end;
  cboFontSize.ItemIndex := cboFontSize.Items.IndexOf(IntToStr(txtMsg.Font.Size));
  FZRec.zalloc := zlibAllocMem;
  FZRec.zfree := zlibFreeMem;
end;

procedure TInstantForm.spbtnFile1Click(Sender: TObject);
var
  f: file;
begin
{  case mode of
    1: if SaveDialog1.Execute then
      begin
        ShellExecute(0,'Open',pchar(ExtractFilePath(edtFileName.Text)),nil,nil,SW_SHOW);
//        edtFileName.Text := OpenDialog1.FileName;
      end;

    0: if OpenDialog1.Execute then
      begin
        AssignFile(f, OpenDialog1.FileName);
        reset(f);
        if FileSize(f)>1024*1024 then
        begin
          ShowRiserWindow(nil,'即时文件大小不能超过1M!',ico_info);
          //MessageBox(application.Handle, '即时文件大小不能超过1M!', '错误', MB_OK OR MB_ICONERROR);
          exit;
        end;
        CloseFile(f);
        edtFileName.Text := OpenDialog1.FileName;
      end;
  end; {}
end;

procedure TInstantForm.btnCloseClick(Sender: TObject);
begin
  close;
end;

procedure TInstantForm.btnActionClick(Sender: TObject);
var
  task: TJITSendInstantMail;
begin
  btnAction.Enabled := false;
  case mode of
    0: begin
        //
        preparesend;
        sendudpRequest;
//        sendbyhttp;
//        close;
        exit;
        //

{        Task := TJITSendInstantMail.Create;
        with task do
        begin
          TOJID := _JID;
          IBBController := MainIBBController;
          IBBSID := Sha1Hash(FormatDateTime('MMDDYYYYHHMM', now) + _jid +
            MainSession.Username + MainSession.Server);
          _SID := IBBSID;
          OnProcessReceive := self.ProcessReceive;
          OnSend := self.Send;
        end;
        MainIBBController.AddTask(task.IBBSID, task);
        SeqNo := 0;
        SeqCount := 0;
        Buf := '';
        ShareTag := nil;
        _ReadyId := MainSession.generateID();
        task.AskReady(_ReadyId);  {}
      end;
    1: begin
//        if MainIBBController.FindTask(_SID)<>nil then
//          TJITRcvInstantMail(MainIBBController.FindTask(_SID)).SendReady(_ReadyId);
//        BufStream := TFileStream.Create(edtFileName.Text, fmCreate);
      end;
  end;
end;

procedure TInstantForm.ProcessReceive(tag: TXMLTag);
var
  DeCoder: TIdDecoderMIME;
  t: Widestring;
  qtag: TXMLTag;
  decstr: string;
  decpos: Integer;
  decbuf: array[0..4095] of byte;
  FBuffer: array[0..4999] of char;
  decsize: Integer;
begin
  t := tag.GetAttribute('type');

  if t = 'error' then
  begin
    btnAction.Enabled := false;
    Close;
    exit;
  end;

  if t = 'result' then
  begin
    if mode = 0 then
    begin
      if tag.GetAttribute('id') = _ReadyID then
        startsend;
      _ReadyID := '';
    end;
    exit;
  end;

  if t <> 'set' then
    exit;

  qtag := Tag.GetFirstTag('query');
  if qtag = nil then exit;

  if qtag.GetAttribute('seq') <> '' then
  begin
    seqNo := strtoint(qtag.GetAttribute('seq'));
  end;

  if qtag.GetAttribute('totalseq') <> '' then
  begin
    seqcount := strtoint(qtag.GetAttribute('totalseq'));
  end;

  if qtag.GetFirstTag('data') <> nil then
  begin
    //接收文件处理

    if seqNo = 0 then
    begin
      FZRec.next_in := FBuffer;
      FZRec.avail_in := 0;
      DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
    end;

    decstr := qtag.GetFirstTag('data').Data;
    DeCoder := TIdDecoderMIME.Create(nil);
    decstr := DeCoder.DecodeToString(decstr);
    DeCoder.Free;

    FZRec.next_out := @decbuf;
    FZRec.avail_out := 4096;
    FZRec.next_in := @decstr[1];
    FZRec.avail_in := length(decstr);
    decsize := 4096;
    while (FZRec.avail_out > 0) do
    begin
      if FZRec.avail_in = 0 then
      begin
        decsize := 4096 - FZRec.avail_out;
        break;
      end;
      DCheck(inflate(FZRec, 0));
    end;

    BufStream.Write(decbuf, decsize);
  end;


  if qtag.TagExists('close') then
  begin
    if seqcount <> seqNo + 1 then
      case mode of
        0: ShowRiserWindow(nil, '对方已取消文件接收!', ico_info);
          //MessageBox(application.Handle, '对方已取消文件接收!', '取消', MB_OK OR MB_ICONEXCLAMATION);
        1: ShowRiserWindow(nil, '对方已取消文件发送!', ico_info);
          //MessageBox(application.Handle, '对方已取消文件发送!', '取消', MB_OK OR MB_ICONEXCLAMATION);
      end
    else
      ShowRiserWindow(handle, '接收到一封即时邮件！', ico_info);
//      showmessage('文件接收完毕！');
    FreeAndNil(BufStream);
    Showinmmessage;
//    Show;
    exit;
  end;
end;

procedure TInstantForm.startsend;
begin
  if MainIBBController.FindTask(_SID) <> nil then
    TJITSendInstantMail(MainIBBController.FindTask(_SID)).startsend;
end;

procedure TInstantForm.Send(sender: TJabberIBBTask);
var
  EnCoder: TIdEncoderMIME;
  _iq: TXMLTag;
  sending: boolean;
  fbuf: array[0..4095] of byte;
  FBuffer: array[0..4999] of char;
  CM: TMemoryStream;
  bufsize: integer;
begin
  BufStream := TFileStream.Create(filename, fmOpenRead);
  seqNo := 0;
  seqCount := (BufStream.Size) div (BlockSize * 3 div 4);

  ProgressBar1.Visible := seqCount > 0;
  ProgressBar1.Max := seqCount;

  if (BufStream.Size * 4) mod (BlockSize * 3) <> 0 then
    inc(seqCount);

  sending := seqNo < seqcount;
  BufStream.Seek(0, soBeginning);
  while sending and assigned(sender) do
  begin
    _iq := TXMLTag.Create('iq');
    _iq.setAttribute('id', MainSession.generateID());
    _iq.setAttribute('type', 'set');
    _iq.setAttribute('to', sender.TOJID);
    with _iq.AddTag('query') do
    begin
      setAttribute('xmlns', XMLNS_IBB);
      setAttribute('sid', sender.IBBSID);
      setAttribute('seq', inttostr(seqNo));
      setAttribute('totalseq', inttostr(seqcount));

      bufsize := BufStream.Read(fbuf, 4096);
      FillChar(FBuffer, 5000, #0);

      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);
      if seqNo = 0 then
        CCheck(deflateInit_(FZRec, -1, zlib_version, sizeof(FZRec)));

      FZRec.next_in := @fbuf;
      FZRec.avail_in := bufsize;
      while (FZRec.avail_in > 0) do
      begin
        CCheck(deflate(FZRec, 2));
      end;

      inc(seqNo);
      if seqNo >= seqcount then
      begin
        while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
          and (FZRec.avail_out = 0) do
        begin
          FZRec.next_out := FBuffer;
          FZRec.avail_out := sizeof(FBuffer);
        end;
      end;
      bufsize := 5000 - FZRec.avail_out;

      EnCoder := TIdEncoderMIME.Create(nil);
      CM := TMemoryStream.Create;
      bufsize := cm.Write(FBuffer, bufsize);
      cm.Seek(0, soFromBeginning);
      buf := EnCoder.Encode(cm);
      CM.Free;
      EnCoder.Free;

      with AddTag('data') do
        AddCData(copy(buf, 1, length(buf)));
      if seqNo >= seqcount then
        AddTag('close');
    end;
    MainSession.SendTag(_iq);
    sending := seqNo < seqcount;
    ProgressBar1.Position := seqNo;
    Application.ProcessMessages;
  end;

  FreeAndNil(BufStream);
  ShowRiserWindow(nil, '即时邮件传送完毕！', ico_info);
//  Showmessage('文件传送完毕！');
  Close;

//  btnAction.Enabled := false;
//  btnClose.Caption := '关闭';
end;

procedure TInstantForm.sendbyhttp;
var
  tag: TXMLTag;
  attach: TXMLTag;
  EnCoder: TIdEncoderMIME;
  i: integer;
  GUID: TGUID;

  iq: TJabberIQ;
  myip: Widestring;
  q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
  xml: string;
  p: integer;
  f: file of byte;
begin
  tmp_id := TJabberID.Create(_Jid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能给联机用户发送即时邮件！', ico_info);
      tmp_id.Free;
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := tmp_id.full;
  tmp_id.Free;

  tag := TXMLTag.Create('message');
  tag.setAttribute('from', MainSession.BareJid);
  tag.setAttribute('to', _JID);
  tag.setAttribute('id', MainSession.generateID);
  if txtmsg.WideLines.Text = '' then
    tag.AddBasicTag('body', '无信息')
  else
  begin
    tag.AddBasicTag('body', txtmsg.WideLines.Text);
    txtmsg.SelectAll;
    tag.AddBasicTag('rtf', txtmsg.RTFSelText);
    txtmsg.SelLength := 0;
  end;

  tag.AddBasicTag('subject', edtSubject.Text);
  tag.SetAttribute('stamp', DateTimetostr(Now));

  for i := 0 to lvAttach.Items.Count - 1 do
  begin
    attach := tag.AddTag('attachment');
    attach.AddBasicTag('filename', ExtractFileName(lvAttach.Items.Item[i].SubItems[0]));
    AssignFile(f, lvAttach.Items.Item[i].SubItems[0]);
    Reset(f);
    attach.AddBasicTag('filesize', inttostr(FileSize(f)));
    closefile(f);
    EnCoder := TIdEncoderMIME.Create(nil);
    BufStream := TFileStream.Create(lvAttach.Items.Item[i].SubItems[0], fmOpenRead);
    buf := EnCoder.Encode(BufStream, (BufStream.Size + 2) - ((BufStream.Size + 2) mod 3));
    freeandnil(BufStream);
    EnCoder.Free;
    attach.AddBasicTag('filedata', buf);
  end;

  ForceDirectories(ExtractFilePath(Application.ExeName) + '\SendInstant');
  CreateGUID(GUID);
  filename := SlashSep(ExtractFilePath(Application.ExeName), 'SendInstant\' + GUIDToString(GUID) + '.inm');
  xml := UTF8Encode(tag.xml);
  BufStream := TFileStream.Create(filename, fmCreate);
  BufStream.Write(xml[1], length(xml));
  freeandnil(BufStream);

  myip := MainSession.Stream.LocalIP;
  if (myip = '') then begin
    ShowRiserWindow(nil, sNetMeetingConnError, ico_info);
    exit;
  end;

  p := MainSession.Prefs.getInt('xfer_port');

  iq := TJabberIQ.Create(MainSession, MainSession.generateID, InstantmailCallback, 300);
  with iq do begin
    Namespace := XMLNS_IQOOB;
    iqType := 'set';
    toJid := tmps;
    qTag.AddBasicTag('url', 'instantmailto:' + myip + ':' + inttostr(p) + '/' + GUIDToString(GUID) + '.inm');
    qTag.AddBasicTag('desc', '即时邮件');
    Send();
  end;
  ExFileServer.AddFile(filename);

//  MainSession.SendTag(tag);
end;

function TInstantForm.CurrText: TTextAttributes98;
begin
  if txtMsg.SelLength > 0 then Result := txtMsg.SelAttributes
  else Result := txtMsg.DefAttributes;
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

procedure TInstantForm.GetFontNames;
var
  DC: HDC;
begin
  DC := GetDC(0);
  EnumFonts(DC, nil, @EnumFontsProc, Pointer(cboFontName.Items));
  ReleaseDC(0, DC);
  cboFontName.Sorted := True;
end;

procedure TInstantForm.cboFontNameChange(Sender: TObject);
begin
  inherited;
  if _Updateing then
    Exit;
  CurrText.Name := cboFontName.Text
end;

procedure TInstantForm.cboFontSizeChange(Sender: TObject);
begin
  inherited;
  if _Updateing then
    Exit;
  CurrText.Size := strtoint(cboFontSize.Text);
end;

procedure TInstantForm.BoldButtonClick(Sender: TObject);
begin
  inherited;
  if _Updateing then
    Exit;
  if BoldButton.Down then
    CurrText.Style := CurrText.Style + [fsBold]
  else
    CurrText.Style := CurrText.Style - [fsBold]
end;

procedure TInstantForm.ItalicButtonClick(Sender: TObject);
begin
  inherited;
  if _Updateing then
    Exit;
  if ItalicButton.Down then
    CurrText.Style := CurrText.Style + [fsItalic]
  else
    CurrText.Style := CurrText.Style - [fsItalic];
end;

procedure TInstantForm.UnderlineButtonClick(Sender: TObject);
begin
  inherited;
  if _Updateing then
    Exit;
  if UnderlineButton.Down then
    CurrText.Style := CurrText.Style + [fsUnderline]
  else
    CurrText.Style := CurrText.Style - [fsUnderline];
end;

procedure TInstantForm.ColorBox1Change(Sender: TObject);
begin
  inherited;
  if _Updateing then
    Exit;
  CurrText.Color := ColorBox1.Selected;
end;

procedure TInstantForm.txtMsgSelectionChange(Sender: TObject);
begin
  inherited;
  _Updateing := True;
  cboFontName.ItemIndex := cboFontName.items.indexof(txtMsg.SelAttributes.Name);
  cboFontSize.ItemIndex := cboFontSize.Items.indexof(IntToStr(txtMsg.SelAttributes.size));
  BoldButton.Down := fsBold in txtMsg.SelAttributes.Style;
  ItalicButton.Down := fsItalic in txtMsg.SelAttributes.Style;
  UnderlineButton.Down := fsUnderline in txtMsg.SelAttributes.Style;
  ColorBox1.Selected := txtMsg.SelAttributes.Color;
  _Updateing := False;
end;

procedure TInstantForm.lvAttachInsert(Sender: TObject; Item: TListItem);
begin
  inherited;
  if not lvAttach.Visible then
  begin
    lvAttach.Height := 24;
    lvAttach.Visible := true;
    lblAttach.Visible := true;
  end;
  if lvAttach.Height >= 58 then exit;
  lvAttach.Height := 24 + item.Position.Y; //(lvAttach.Items.Count-1)*18;
end;

procedure TInstantForm.lvAttachDeletion(Sender: TObject; Item: TListItem);
var
  h: Integer;
begin
  inherited;
  if lvAttach.Items.Count <= 1 then
  begin
    lvAttach.Height := 24;
    lvAttach.Visible := false;
    lblAttach.Visible := false;
  end;
  if lvAttach.Height <= 24 then exit;

  h := lvAttach.Items.Item[lvAttach.Items.Count - 1].Position.y;
  if 24 + h >= 58 then exit;
  lvAttach.Height := 24 + h;
end;

procedure TInstantForm.AttachButtonClick(Sender: TObject);
var
  oldsize: Integer;
  i: integer;
  f: file of Byte;
  ssize: string;
  si: TSHFILEINFO;
begin
  if OpenDialog1.Execute then
  begin
    oldsize := 0;
    for i := 0 to lvAttach.Items.Count - 1 do
    begin
      if lvAttach.Items.Item[i].SubItems.Count = 0 then
        Continue;
      AssignFile(f, lvAttach.Items.Item[i].SubItems[0]);
      reset(f);
      oldsize := oldsize + FileSize(f);
      CloseFile(f);
    end;

    AssignFile(f, OpenDialog1.FileName);
    reset(f);
    if FileSize(f) + oldsize > 2048 * 1024 then
    begin
      ShowRiserWindow(nil, '即时文件大小不能超过2M!', ico_info);
      CloseFile(f);
      exit;
    end;
    ssize := sizestr(FileSize(f));
    CloseFile(f);

    lvAttach.Items.BeginUpdate;
    with lvAttach.Items.Add do
    begin
      caption := ExtractFileName(OpenDialog1.FileName) + ' (' + ssize + ')';
      SubItems.Add(OpenDialog1.FileName);
      SHGetFileInfo(pchar(OpenDialog1.FileName), FILE_ATTRIBUTE_NORMAL, si, sizeof(si),
        SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_TYPENAME);
      ImageIndex := si.iIcon;
    end;
    lvAttach.Items.EndUpdate;
    AdjectlvAttach;
//    lvAttach.Arrange(arAlignTop);
  end;
end;

procedure TInstantForm.pnlTitleResize(Sender: TObject);
begin
  inherited;
  lvAttach.Width := pnlTitle.Width - 44;
  edtSubject.Width := pnlTitle.Width - 44;
  if lvAttach.Visible then AdjectlvAttach;
end;

procedure TInstantForm.D1Click(Sender: TObject);
begin
  inherited;
  lvAttach.DeleteSelected;
  AdjectlvAttach;
end;

procedure TInstantForm.AdjectlvAttach;
var
  i: integer;
  w: Integer;
  maxW: Integer;
  r, c: integer;
begin
  lvAttach.Visible := lvAttach.Items.Count > 0;
  lblAttach.Visible := lvAttach.Visible;
  if not lvAttach.Visible then exit;
  maxW := 0;
  lvAttach.Items.BeginUpdate;
  for i := 0 to lvAttach.Items.Count - 1 do
  begin
    W := lvAttach.StringWidth(lvAttach.Items.item[i].Caption) + 18;
    Maxw := max(w, maxw);
  end;
  r := 0;
  C := 0;
  for i := 0 to lvAttach.Items.Count - 1 do
  begin
    lvAttach.Items.item[i].SetPosition(point(C * (Maxw + 16) + 2, r * 18 + 2));
    inc(C);
    if C * (Maxw + 16) + 2 + Maxw > lvAttach.Width then
    begin
      c := 0;
      inc(R);
    end;
  end;

  if c = 0 then
    dec(R);
  lvAttach.Height := min(r + 1, 3) * 18 + 8;
  pnlTitle.Height := lvAttach.Height + 52;
  lvAttach.Items.endUpdate;
end;

procedure TInstantForm.InstantmailCallback(event: string; tag: TXMLTag);
var
  errtag: TXMLTag;
begin
  if ((event = 'xml') or (event = 'cache')) then begin
    if (tag.GetAttribute('type') = 'error') then
    begin
      sendbyibb;
    end;

    if (tag.GetAttribute('type') = 'result') then
    begin
      //对方接受请求，进行处理
    end;
  end
  else
  begin
    //超时或者其他错误;
    sendbyibb;
  end;
end;

type
  TConnect = class
  public
    from: widestring;
    ID: widestring;
    procedure Connect(Sender: TObject);
  end;

procedure TInstantForm.InitRcv;
begin
  FZRec.zalloc := zlibAllocMem;
  FZRec.zfree := zlibFreeMem;
  FZRec.next_in := FBuffer;
  FZRec.avail_in := 0;
  DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));

  while FileExists(filename) do
  begin
    if MessageBox(application.Handle, '文件已经存在，要覆盖吗？','文件已存在', MB_ICONQUESTION or MB_YESNO) = IDYes then
      break;
    if OpenDialog1.Execute then
      filename := OpenDialog1.FileName;
  end;

  if BufStream=nil then
    BufStream := TFileStream.Create(SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\' + filename), fmCreate);
end;

procedure TInstantForm.sendbyudp;
var
  Buf: array [0..4095] of Byte;
  BufSize: Integer;
  fs: TFileStream;
  i: integer;
begin
{  FZRec.zalloc := zlibAllocMem;
  FZRec.zfree := zlibFreeMem;
  FillChar(FBuffer, 5000, #0);
  FZRec.next_out := FBuffer;
  FZRec.avail_out := sizeof(FBuffer);
  CCheck(deflateInit_(FZRec, -1, zlib_version, sizeof(FZRec)));
  fs := TFileStream.Create(filename, fmOpenRead);
  ProgressBar1.Max := fs.Size;
  try
    while fs.Position<fs.Size do
    begin
      bufsize := fs.Read(buf, 4096);
      FZRec.next_in := @buf;
      FZRec.avail_in := bufsize;

      FillChar(FBuffer, 5000, #0);
      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);

      while (FZRec.avail_in > 0) do
      begin
        CCheck(deflate(FZRec, 2));
      end;

      if fs.Position>=fs.Size then
      begin
        while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
          and (FZRec.avail_out = 0) do
        begin
          FZRec.next_out := FBuffer;
          FZRec.avail_out := sizeof(FBuffer);
        end;
      end;
      bufsize := 5000 - FZRec.avail_out;

      _task.SendDataBuffered(FBuffer[0], bufsize, fs.Position>=fs.Size);

      ProgressBar1.Position := fs.Position;
      ProgressBar1.Refresh;
    end;

    CCheck(deflateEnd(FZRec));
    _task.SendEndFlag;
    FreeAndNil(fs);
    FreeAndNil(_task);

  except
    ShowRiserWindow(nil,'由于网络连接原因，发送即时邮件失败!',ico_info);
    close;
  end;   {}
end;

procedure TInstantForm.UdpRcvStatus(sender: TObject);
begin
  if TAnyQBaseUDPTask(Sender).Status='connected' then
    case Self.Mode of
      0: udpStartSend;
      1: InitRcv;
    end;
  if TAnyQBaseUDPTask(Sender).Status='sended' then
    if Mode=0 then
      udpSendNext;
end;

procedure TInstantForm.UdpFail(sender: TObject);
var
  hosts: TStringList;
  iq: TXMLTag;
  i: integer;
begin
  case self.Mode of
    0:
      if _task.Status='connecting' then
      begin
//        ShowRiserWindow(nil, '无法建立连接', ico_info);
        FreeAndNil(_task);
        sendbyibb;
        exit
      end;
    1:
      if _task.Status='connecting' then
      begin
        hosts := TStringList.Create;
        UDPController.GetUDPInfo(hosts);
        iq := TXMLTag.Create('iq');
        with iq do begin
          setAttribute('to', _jid);
          setAttribute('id', MainSession.generateID());
          setAttribute('type', 'set');
          with AddTag('query') do begin
            setAttribute('xmlns', XMLNS_AnyQUDP);
            AddBasicTag('taskid', GUIDToString(_Task.TaskID));
            for i:= 0 to hosts.Count-1 do
              AddBasicTag('host', hosts[i]);
          end;
        end;
        hosts.Free;
        MainSession.SendTag(iq);
        exit;
      end;
  end;
  Close;
end;

procedure TInstantForm.UdpRcv(sender: TObject; Adata: TStream);
var
  Buf: array of Byte;
//  DecBuf: array [0..4095] of Byte;
  decsize: integer;
begin
  AData.Seek(0,0);
  if AData.Size = 0 then
  begin
    CCheck(inflateEnd(FZRec));
    FreeAndNil(BufStream);
    _task := nil;
//    FreeAndNil(_task);
    Showinmmessage;
    ShowRiserWindow(handle, '接收到一封即时邮件！', ico_info);
  end
  else
  begin
    setlength(Buf, AData.Size);
    AData.Read(Buf[0], AData.Size);

    FZRec.next_out := @FBuffer[0];
    FZRec.avail_out := 4096;
    FZRec.next_in := @Buf[0];
    FZRec.avail_in := AData.Size;
    decsize := 0;

    while FZRec.avail_in > 0 do
    begin
      if FZRec.avail_out = 0 then
      begin
        BufStream.Write(FBuffer[0], decsize);
        FZRec.next_out := @FBuffer[0];
        FZRec.avail_out := 4096;
      end;
      DCheck(inflate(FZRec, 0));
      decsize := 4096 - FZRec.avail_out;
    end;
    BufStream.Write(FBuffer[0], decsize);
  end;
end;

procedure TInstantForm.sendudpRequest;
var
  file_path: string;
  f: file of byte;
  iq: TXMLTag;
  hosts: Tstringlist;
  i: Integer;
  taskguid: TGUID;
begin
  CreateGUID(taskguid);
  TaskID := taskguid;
  try
    _Task := TAnyQBaseUDPTask.Create(UDPController, taskguid);
    _Task.OnRcvData := UdpRcv;
    _Task.OnRcvStatus := UdpRcvStatus;
    _Task.OnFail := UdpFail;
    _Task.OnTimeOut := UdpTimeout;
    hosts := TStringList.Create;
    UDPController.GetUDPInfo(hosts);
    iq := TXMLTag.Create('iq');
    with iq do begin
      setAttribute('to', _jid);
      setAttribute('id', MainSession.generateID());
      setAttribute('type', 'set');
      with AddTag('query') do begin
        setAttribute('xmlns', XMLNS_AnyQUDP);
        AddBasicTag('taskid', GUIDToString(_Task.TaskID));
        AddBasicTag('type', 'instantmail');
        with AddBasicTag('desc', '') do
        begin
          setAttribute('filename', ExtractFileName(filename));
          AssignFile(f, filename);
          Reset(f);
          setAttribute('filesize', inttostr(FileSize(f)));
          CloseFile(f);
        end;
        for i:= 0 to hosts.Count-1 do
          AddBasicTag('host', hosts[i]);
      end;
    end;
    FreeAndNil(hosts);
    MainSession.SendTag(iq);
  except
    _Task.Free;
    sendbyibb;
  end;    {}
end;

procedure TInstantForm.preparesend;
var
  tag: TXMLTag;
  attach: TXMLTag;
  EnCoder: TIdEncoderMIME;
  i: integer;
  GUID: TGUID;

  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
  xml: string;
  f: file of byte;
begin
  tmp_id := TJabberID.Create(_Jid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能给联机用户发送即时邮件！', ico_info);
      tmp_id.Free;
      abort;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := tmp_id.full;
  tmp_id.Free;

  tag := TXMLTag.Create('message');
  tag.setAttribute('from', MainSession.BareJid);
  tag.setAttribute('to', _JID);
  tag.setAttribute('id', MainSession.generateID);
  if txtmsg.WideLines.Text = '' then
    tag.AddBasicTag('body', '无信息')
  else
  begin
    tag.AddBasicTag('body', txtmsg.WideLines.Text);
    txtmsg.SelectAll;
    tag.AddBasicTag('rtf', txtmsg.RTFSelText);
    txtmsg.SelLength := 0;
  end;

  tag.AddBasicTag('subject', edtSubject.Text);
  tag.SetAttribute('stamp', DateTimetostr(Now));

  for i := 0 to lvAttach.Items.Count - 1 do
  begin
    attach := tag.AddTag('attachment');
    attach.AddBasicTag('filename', ExtractFileName(lvAttach.Items.Item[i].SubItems[0]));
    AssignFile(f, lvAttach.Items.Item[i].SubItems[0]);
    Reset(f);
    attach.AddBasicTag('filesize', inttostr(FileSize(f)));
    closefile(f);
    EnCoder := TIdEncoderMIME.Create(nil);
    BufStream := TFileStream.Create(lvAttach.Items.Item[i].SubItems[0], fmOpenRead);
    buf := EnCoder.Encode(BufStream, (BufStream.Size + 2) - ((BufStream.Size + 2) mod 3));
    freeandnil(BufStream);
    EnCoder.Free;
    attach.AddBasicTag('filedata', buf);
  end;

  ForceDirectories(ExtractFilePath(Application.ExeName) + '\SendInstant');
  CreateGUID(GUID);
  filename := SlashSep(ExtractFilePath(Application.ExeName), 'SendInstant\' + GUIDToString(GUID) + '.inm');
  xml := UTF8Encode(tag.xml);
  BufStream := TFileStream.Create(filename, fmCreate);
  BufStream.Write(xml[1], length(xml));
  freeandnil(BufStream);
end;

procedure TInstantForm.WMAnyQSTARTUDPSEND(var msg: TMessage);
begin
  sendbyudp;
end;

procedure TInstantForm.UdpTimeout(Sender: TObject);
begin
  if Mode=0 then
  begin
    //ShowRiserWindow(nil,'由于网络连接原因，发送即时邮件失败!',ico_info);
    close;
  end
  else
  begin
    ShowRiserWindow(nil,'由于网络连接原因，发送即时邮件失败!',ico_info);
    close;
  end;
end;

procedure TInstantForm.AfterReocordClose(Sender: TObject);
var
  f: file of byte;
  ssize: string;
  si: TSHFILEINFO;
begin
  if TAvRecForm(sender).ModalResult=mrok then
    with TAvRecForm(sender) do
    begin
      AssignFile(f, SavedFileName);
      reset(f);
      ssize := sizestr(FileSize(f));
      CloseFile(f);

      lvAttach.Items.BeginUpdate;
      with lvAttach.Items.Add do
      begin
        caption := ExtractFileName(SavedFileName) + ' (' + ssize + ')';
        SubItems.Add(SavedFileName);
        SHGetFileInfo(pchar(SavedFileName), FILE_ATTRIBUTE_NORMAL, si, sizeof(si),
          SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_TYPENAME);
        ImageIndex := si.iIcon;
      end;
      lvAttach.Items.EndUpdate;
      AdjectlvAttach;
    end;
  self.pnlPlay.OnResize := nil;
  self.pnlPlay.hide;
  AttachAV.Enabled := true;
end;

procedure TInstantForm.udpsendnext;
var
  Buf: array [0..4095] of Byte;
  BufSize: Integer;
begin
  try
    if fs.Position<fs.Size then
    begin
      bufsize := fs.Read(buf, 4096);
      FZRec.next_in := @buf;
      FZRec.avail_in := bufsize;

      FillChar(FBuffer, 5000, #0);
      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);

      while (FZRec.avail_in > 0) do
      begin
        CCheck(deflate(FZRec, 2));
      end;

      if fs.Position>=fs.Size then
      begin
        while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
          and (FZRec.avail_out = 0) do
        begin
          FZRec.next_out := FBuffer;
          FZRec.avail_out := sizeof(FBuffer);
        end;
      end;
      bufsize := 5000 - FZRec.avail_out;

      _task.SendData(FBuffer[0], bufsize);

      ProgressBar1.Position := fs.Position;
      ProgressBar1.Refresh;
    end
    else
    begin
      CCheck(deflateEnd(FZRec));
      _task.SendEndFlag;
      FreeAndNil(fs);
      FreeAndNil(_task);
      ShowRiserWindow(nil, '即时邮件传送完毕！', ico_info);
      Close;
    end;
  except
    ShowRiserWindow(nil,'由于网络连接原因，发送即时邮件失败!',ico_info);
    close;
  end;   {}
end;

procedure TInstantForm.udpstartSend;
var
  Buf: array [0..4095] of Byte;
  BufSize: Integer;
begin
  FZRec.zalloc := zlibAllocMem;
  FZRec.zfree := zlibFreeMem;
  FillChar(FBuffer, 5000, #0);
  FZRec.next_out := FBuffer;
  FZRec.avail_out := sizeof(FBuffer);
  CCheck(deflateInit_(FZRec, -1, zlib_version, sizeof(FZRec)));
  fs := TFileStream.Create(filename, fmOpenRead);
  ProgressBar1.Max := fs.Size;
  try
    if fs.Position<fs.Size then
    begin
      bufsize := fs.Read(buf, 4096);
      FZRec.next_in := @buf;
      FZRec.avail_in := bufsize;

      FillChar(FBuffer, 5000, #0);
      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);

      while (FZRec.avail_in > 0) do
      begin
        CCheck(deflate(FZRec, 2));
      end;

      if fs.Position>=fs.Size then
      begin
        while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
          and (FZRec.avail_out = 0) do
        begin
          FZRec.next_out := FBuffer;
          FZRec.avail_out := sizeof(FBuffer);
        end;
      end;
      bufsize := 5000 - FZRec.avail_out;

      _task.SendData(FBuffer[0], bufsize);

      ProgressBar1.Position := fs.Position;
      ProgressBar1.Refresh;
    end
    else
    begin
      CCheck(deflateEnd(FZRec));
      _task.SendEndFlag;
      FreeAndNil(fs);
      FreeAndNil(_task);
    end;
  except
    ShowRiserWindow(nil,'由于网络连接原因，发送即时邮件失败!',ico_info);
    close;
  end;   {}
end;

{ TConnect }

procedure TConnect.Connect(Sender: TObject);
var
  iq, q: TXMLTag;
begin
  iq := TXMLTag.Create('iq');
  iq.setAttribute('to', from);
  iq.setAttribute('type', 'result');
  iq.setAttribute('id', ID);
  MainSession.SendTag(iq);
end;

procedure InstantmailReceive(from, url, ID: widestring);
var
  iq, q: TXMLTag;
  fs: TFileStream;
  http: TIdHTTP;
  inmfn: string;
  myConnect: TConnect;
begin
  http := TIDHttp.Create(application);
  myConnect := TConnect.Create;
  myConnect.from := from;
  myConnect.ID := ID;
  http.OnConnected := myConnect.Connect;

  ForceDirectories(SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\'));
  Delete(url, 1, 14);
  inmfn := SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\' + ExtractFileName(StringReplace(url, '/', '\', [rfReplaceAll])));
  fs := TFileStream.Create(inmfn, fmCreate);
  url := 'http://' + url;
  try
    try
      if http.Intercept = nil then
        http.Intercept := TIdCompressionIntercept.Create(nil);
      TIdCompressionIntercept(http.Intercept).CompressionLevel := 9;
      http.Get(url, fs);
      http.Disconnect;
      FreeAndNil(myConnect);
      if http.Intercept <> nil then
        http.Intercept.Free;
      http.Intercept := nil; {}
      FreeAndNil(fs);
      showinm(ExtractFileName(inmfn));
    finally
      if http.Intercept <> nil then
        http.Intercept.Free;
      http.Intercept := nil; {}
      if Assigned(fs) then
        FreeAndNil(fs);
      FreeAndNil(myConnect);
      FreeAndNil(http);
    end;
  except
    iq := TXMLTag.Create('iq');
    iq.setAttribute('to', from);
    iq.setAttribute('id', ID);
    iq.setAttribute('type', 'error');
    iq.AddBasicTag('error', '无法连接').setAttribute('code', '404');
    MainSession.SendTag(iq);
  end;
end;

procedure InstantmailReceive(task: TAnyQBaseUDPTask; from, desc, rcvfilename: string; size: Int64; hosts: TStringList); overload;
var
  tmps: string;
  tmp_jid: TJabberID;
  frm: TInstantForm;
  ritem: TJabberRosterItem;
  fp: string;
begin
  frm := TInstantForm.Create(Application);
  frm._task := task;
  with frm do begin
    TaskID := task.TaskID;
    _taskhost := tstringlist.Create;
    _taskhost.Assign(hosts);
    _jid := from;
    Init(1);

    tmp_jid := TJabberID.Create(_jid);
    ritem := MainSession.Roster.Find(tmp_jid.jid);
    if (ritem = nil) then
      ritem := MainSession.Roster.Find(tmp_jid.full);

    if (ritem <> nil) then begin
      tmps := ritem.Nickname;
      txtFrom.Hint := from;
    end
    else
      tmps := tmp_jid.jid;

    tmp_jid.Free();
    txtFrom.Caption := tmps;

    fp := MainSession.Prefs.getString('xfer_path');
    if fp = '' then
      fp := ExtractFilePath(Application.ExeName);
    if (AnsiEndsText('\', fp)) then
      FileName := fp + rcvfilename
    else
      FileName := fp + '\' + rcvfilename;

    FileName := rcvfilename;
    ProgressBar1.Max := size;

    if _task=nil then
    begin
      if (Tag <> 1) or (MainIBBController.FindTask(_SID)=nil) then
      begin
//        ShowRiserWindow(nil,'无法接收文件',ico_info);
        close;
      end;
      TJITRcvFile(MainIBBController.FindTask(_SID)).SendReady(_ReadyID);
    end
    else
    begin
      _Task.OnRcvData := UdpRcv;
      _Task.OnRcvStatus := UdpRcvStatus;
      _Task.OnFail := UdpFail;
      _Task.OnTimeOut := UdpTimeout;
//      _Task.OnRcvData := UdpRcv;
//      _Task.OnConnected := UdpConnected;
//      _Task.OnConnectFail := UdpConnectFail;
//      _Task.OnSendTimeOut := UdpSendTimeout;
//      _task.OnRcvTimeOut := UdpRcvTimeout;
      _Task.Connect(_taskhost);
    end;
  end; {}
end;

procedure TInstantForm.sendbyibb;
var
  task: TJITSendInstantMail;
begin
  Task := TJITSendInstantMail.Create;
  with task do
  begin
    TOJID := _JID;
    IBBController := MainIBBController;
    IBBSID := GUIDToString(TaskID);
    _SID := IBBSID;
    OnProcessReceive := self.ProcessReceive;
    OnSend := self.Send;
    InmFileName := ExtractFileName(self.filename);
  end;
  MainIBBController.AddTask(task.IBBSID, task);
  SeqNo := 0;
  SeqCount := 0;
  Buf := '';
  ShareTag := nil;
  _ReadyId := MainSession.generateID();
  task.AskReady(_ReadyId);
end;

procedure TInstantForm.showinmmessage;
var
  parser: TXMLTagParser;
  XmlTag, tmptag: TXMLTag;
  TagList: TXMLTagList;
  i: Integer;
  ssize: string;
  si: TSHFILEINFO;
  tmpjid: TJabberID;
  Played: Boolean;
  tmppath: pchar;
  fn: string;
  fs: TFileStream;
  DeCoder: TIdDecoderMIME;
  Playfn: string;
begin
  Played := False;
  parser := TXMLTagParser.Create;
  parser.ParseFile(SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\' + filename));
  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;

    edtSubject.Text := 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;

    TagList := XmlTag.ChildTags;
    lvAttach.Items.BeginUpdate;

    Played := false;
    for i := 0 to TagList.Count - 1 do
    begin
      tmptag := TagList.Tags[i];
      if tmptag.Name <> 'attachment' then Continue;
      fn := tmptag.GetBasicText('filename');

      with lvAttach.Items.Add do
      begin
        ssize := sizestr(strtoint(tmptag.GetBasicText('filesize')));
        caption := fn + ' (' + ssize + ')';
        SubItems.Add(fn);
        SHGetFileInfo(pchar(caption), FILE_ATTRIBUTE_NORMAL, si, sizeof(si),
          SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_TYPENAME);
        ImageIndex := si.iIcon;
        if not Played then
        begin
          if (UpperCase(ExtractFileExt(fn))='.AVI') or
              (UpperCase(ExtractFileExt(fn))='.WAV') or
              (UpperCase(ExtractFileExt(fn))='.SQA') then
          begin
            Played := true;
            tmppath := StrAlloc(MAX_PATH);
            GetTempPath(MAX_PATH, tmppath);
            Playfn := SlashSep(tmppath, fn);
            StrDispose(tmppath);
            fs := TFileStream.Create(Playfn, fmCreate);
            Buf := tmptag.GetBasicText('filedata');
            DeCoder := TIdDecoderMIME.Create(nil);
            DeCoder.DecodeToStream(Buf, fs);
            DeCoder.Free;
            fs.Free;
          end;
        end;
      end;
    end;

    lvAttach.Items.EndUpdate;
    AdjectlvAttach;

    TagList.Free;
    XmlTag.Free;
  end;
  parser.Free;            {}
  show;
  if Played then
    PlayAVFile(Playfn, pnlPlay);
end;

procedure TInstantForm.N1Click(Sender: TObject);
var
  savefn: string;
begin
  if lvAttach.Selected = nil then exit;

  SaveDialog1.FileName := lvAttach.Selected.SubItems[0];
  if not SaveDialog1.Execute then exit;
  savefn := SaveDialog1.FileName;
  SaveAttach(savefn);
end;

procedure TInstantForm.SaveAttach(fn: string);
var
  fs: TFileStream;
  DeCoder: TIdDecoderMIME;

  parser: TXMLTagParser;
  XmlTag, tmptag: TXMLTag;
  TagList: TXMLTagList;
  i, c: Integer;
begin
  if lvAttach.Selected=nil then
    exit;

  fs := TFileStream.Create(fn, fmCreate);

  parser := TXMLTagParser.Create;
  parser.ParseFile(SlashSep(ExtractFilePath(Application.ExeName), 'SMAIL\InstantMail\' + filename));
  if parser.Count > 0 then
    XmlTag := parser.popTag;
  if XmlTag <> nil then
  begin
    TagList := XmlTag.ChildTags;
    c := 0;
    for i := 0 to TagList.Count - 1 do
    begin
      tmptag := TagList.Tags[i];
      if tmptag.Name <> 'attachment' then
        Continue;
      if C = lvAttach.Selected.Index then
      begin
        Buf := tmptag.GetBasicText('filedata');
        DeCoder := TIdDecoderMIME.Create(nil);
        DeCoder.DecodeToStream(Buf, fs);
        DeCoder.Free;
        break;
      end;
      inc(C);
    end;
    TagList.Free;
  end;
  fs.Free;
  parser.Free;
end;

procedure TInstantForm.O1Click(Sender: TObject);
var
  tmppath: pchar;
  fn: string;
begin
  tmppath := StrAlloc(MAX_PATH);
  GetTempPath(MAX_PATH, tmppath);
  fn := SlashSep(tmppath, lvAttach.Selected.SubItems[0]);
  SaveAttach(fn);
  if (UpperCase(ExtractFileExt(fn))='.AVI') or
      (UpperCase(ExtractFileExt(fn))='.SQA') or
      (UpperCase(ExtractFileExt(fn))='.WAV')
  then
    PlayAVFile(fn, pnlPlay)
  else
    ShellExecute(application.Handle, 'open', pchar(fn), nil, tmppath, SW_SHOWNORMAL);
  StrDispose(tmppath);
end;

procedure TInstantForm.PopAttachPopup(Sender: TObject);
var
  can: boolean;
begin
  inherited;
  can := not ((lvAttach.Selected = nil) or (lvAttach.SelCount <= 0));
  o1.Enabled := can;
  N1.Enabled := can;
  D1.Enabled := can;
end;

procedure TInstantForm.AttachAVClick(Sender: TObject);
{var
  f: file of byte;
  ssize: string;
  si: TSHFILEINFO; {}
begin
  inherited;
  AttachAV.Enabled := false;
  with TAvRecForm.Create(Application) do
  try
    self.pnlPlay.Width := Width+8;
    self.pnlPlay.Show;
    self.pnlPlay.OnResize := ParentResize;
    AttachNo := lvAttach.Items.Count+1;
    AfterClose := self.AfterReocordClose;
    parent := self.pnlPlay;
    Left := (self.pnlPlay.Width-Width) div 2;
    Top := Max((self.pnlPlay.Height-386) div 2, 0);  {}
{    Left := 100;
    Top := 100;    {}
    show;
    Activate;
    self.pnlPlay.Width := Width;
    self.pnlPlay.Width := Width+4;
  except
    self.pnlPlay.OnResize := nil;
    self.pnlPlay.hide;
    Free;
    AttachAV.Enabled := true;
  end;
end;

end.

