unit pptConsole;

interface

uses
  XMLTag, ChatWin, UDP, Zlib, Zlibconst, IBB, IdcoderMIME, IQ, JabberID,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Dockable, ComCtrls, StdCtrls, ToolWin, ImgList, Animate, GIFCtrl;

type
  TfrmPPT = class(TfrmDockable)
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    tbFirst: TToolButton;
    tbPrevious: TToolButton;
    tbNext: TToolButton;
    tbLast: TToolButton;
    tbSync: TToolButton;
    ImageList1: TImageList;
    RxGIFAnimator1: TRxGIFAnimator;
    tbWindow: TToolButton;
    ToolButton2: TToolButton;
    tbClose: TToolButton;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tbFirstClick(Sender: TObject);
    procedure tbPreviousClick(Sender: TObject);
    procedure tbLastClick(Sender: TObject);
    procedure tbNextClick(Sender: TObject);
    procedure tbSyncClick(Sender: TObject);
    procedure tbCloseClick(Sender: TObject);
    procedure tbWindowClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RxGIFAnimator1MouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ToolButton2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ToolBar1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CoolBar1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    _task: TAnyQBaseUDPTask;
    _taskhost: TStringList;
    _pptOpened: Boolean;

    IsHost: Boolean;
    IsReady: Boolean;
    pptID: TGUID;
    toJID: widestring;
    pptapp: OleVariant;
    pptPresentation: OleVariant;
    pptView: OleVariant;
    rcvFileSize: Int64;

    _rcvfile: file of byte;
    _sendfile: TFileStream;
    fstream: TFileStream;
    FZRec: zlib.TZStreamRec;
    FBuffer: array[0..4999] of char;

    Buf: widestring;
    SeqNo: cardinal;
    SeqCount: cardinal;

    procedure DoSended;
    procedure DoRcved;

    procedure PPTCallback(event: string; tag: TXMLTag);
  public
    { Public declarations }
    _ChatForm: TCustomForm;
    _extForm: TCustomForm;
    _SID: widestring;
    _ReadyID: widestring;

    PPTFileName: string;
    procedure SendPPT;
    procedure Sendpptbyibb;

    procedure startrcv;
    procedure StartSend;
    procedure SendNext;

    procedure sendpptCmd(cmd:string);

    procedure pptibbRcv(tag: TXMLTag);
    procedure pptibbSend(sender: TJabberIBBTask);

    procedure pptUdpRcv(sender: TObject; Adata: TStream);
    procedure pptUdpRcvStatus(sender: TObject);
    procedure pptUdpFail(sender: TObject);
    procedure pptUdpTimeout(Sender: TObject);

    procedure fullScreen;
    procedure goPage(PageNumber: Integer);
    procedure gotoPage(PageNumber: Integer);
    procedure Openppt;
    procedure Closeppt;
  end;

var
  frmPPT: TfrmPPT;

procedure AnyQpptReceive(tag: TXMLTag);
function startppt(pptfilename: string; chat: TfrmChat; tojid: widestring): TfrmPPT;
function starrcvtppt(task: TAnyQBaseUDPTask; pptfilename: string; fileSize:Int64;
    chat: TfrmChat; tojid: widestring; hosts: TStringList): TfrmPPT;


implementation

uses BaseChat, Session, JabberConst, RiserWindow, PowerPointXP, ComObj, ComServ,
  Presence, pptExt, Jabber1;

{$R *.dfm}

procedure Senderror(tojid, id: string);
var
  iq: TXMLTag;
begin
  iq := TXMLTag.Create('iq');
  with iq do begin
    setAttribute('to', tojid);
    setAttribute('id', id);
    setAttribute('type', 'error');
    AddBasicTag('error', '同步错误').setAttribute('code', '406');
  end;
  MainSession.SendTag(iq);
end;

procedure Sendresult(tojid, id: string);
var
  iq: TXMLTag;
begin
  iq := TXMLTag.Create('iq');
  with iq do begin
    setAttribute('to', tojid);
    setAttribute('id', id);
    setAttribute('type', 'result');
  end;
  MainSession.SendTag(iq);
end;


procedure AnyQpptReceive(tag: TXMLTag);
var
  qTag, tmp_tag: TXMLTag;
  from, ID: string;
  pptid: TGuid;
  i,pageno: integer;
  frm: TfrmPPT;
begin
  // Callback for receiving file transfers
  from := tag.GetAttribute('from');
  ID := tag.GetAttribute('id');
  qTag := tag.getFirstTag('query');
  if tag.GetAttribute('type') <> 'set' then
    exit;

  if not qtag.TagExists('pptid') then exit;
  pptid := StringToGUID(qtag.GetBasicText('pptid'));

  frm := nil;
  for i :=  Application.ComponentCount-1 downto 0 do
  begin
    if not (Application.Components[i] is TfrmPPT) then
      Continue;
    if IsEqualGUID(TfrmPPT(Application.Components[i]).pptID, pptid) then
    begin
      frm := TfrmPPT(Application.Components[i]);
      break;
    end;
  end;

  if frm = nil then
    exit;

  if qtag.TagExists('close') then  //关闭
  begin
    ShowRiserWindow(nil,'对方已经关闭PowerPoint演讲。',ico_info);
    frm.Close;
    exit;
  end;

  try
    if qtag.TagExists('page') then
    begin
      pageno := strtoint(qtag.GetBasicText('page'));
      frm.gotoPage(pageno);
    end;
    SendResult(from, id);
  except
    ShowRiserWindow(nil, '同步过程出现错误，PowerPoint演讲被终止。', ico_info);
    frm.sendpptCmd('close');
    frm.Close;
  end;
end;

const
  BlockSize = 4096;

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 startppt(pptfilename: string; chat: TfrmChat; tojid: widestring): TfrmPPT;
var
  pptfrm: TfrmPPT;
begin
  Result := nil;
  pptfrm := TfrmPPT.Create(Application);

  chat._pptForm := pptfrm;
  pptfrm._ChatForm := chat;

  pptfrm.IsHost := True;
  pptfrm.PPTFileName := pptfilename;
  pptfrm.toJID := tojid;
  pptfrm.SendPPT;
  pptfrm.show;
  pptfrm._extForm := TFrmPPTExt.Create(application);
  pptfrm._extForm.Parent := chat.pnlchat;
  pptfrm._extForm.Top := chat.pnlchat.Height;
  pptfrm._extForm.Show;
  TFrmPPTExt(pptfrm._extForm)._ConsoleForm := pptfrm;
end;

function starrcvtppt(task: TAnyQBaseUDPTask; pptfilename: string; fileSize:Int64;
    chat: TfrmChat; tojid: widestring; hosts: TStringList): TfrmPPT;
var
  pptfrm: TfrmPPT;
begin
  Result := nil;
  pptfrm := TfrmPPT.Create(Application);

  chat._pptForm := pptfrm;
  pptfrm._ChatForm := chat;

  pptfrm.pptID := task.TaskID;
  pptfrm._task := task;
  pptfrm._Task.OnRcvData := pptfrm.pptUdpRcv;
  pptfrm._Task.OnRcvStatus := pptfrm.pptUdpRcvStatus;
  pptfrm._Task.OnFail := pptfrm.pptUdpFail;
  pptfrm._Task.OnTimeOut := pptfrm.pptUdpTimeout;

  pptfrm.SaveDialog1.FileName := pptfilename;
  pptfrm.rcvFileSize := fileSize;
  pptfrm.toJID := tojid;
  task.Connect(hosts);
  pptfrm.Top := 0;
  pptfrm.Left := 0;
  pptfrm.show;
  pptfrm._extForm := TFrmPPTExt.Create(application);
  pptfrm._extForm.Parent := chat.pnlchat;
  pptfrm._extForm.Top := chat.pnlchat.Height;
  pptfrm._extForm.Show;
  TFrmPPTExt(pptfrm._extForm)._ConsoleForm := pptfrm;
end;

{ TfrmPPT }

procedure TfrmPPT.Closeppt;
begin
//  sendpptCmd('close');
//  pptView.View.exit;
  if not _pptOpened then
    exit;
  pptPresentation.close;
  if pptapp.Presentations.count<=0 then
  begin
    pptapp.quit;
  end;
end;

procedure TfrmPPT.goPage(PageNumber: Integer);
begin
  sendpptCmd(inttostr(PageNumber));
  tbFirst.Enabled := false;
  tbPrevious.Enabled := false;
  tbNext.Enabled := false;
  tbLast.Enabled := False;
  RxGIFAnimator1.Animate := True;
  gotoPage(PageNumber);
  if _extForm<>nil then
  begin
    TFrmPPTExt(_extForm).sbFirst.Enabled := False;
    TFrmPPTExt(_extForm).sbPrevious.Enabled := False;
    TFrmPPTExt(_extForm).sbNext.Enabled := False;
    TFrmPPTExt(_extForm).sbLast.Enabled := False;
    TFrmPPTExt(_extForm).RxGIFAnimator1.Animate := True;
    TFrmPPTExt(_extForm).lbStatus.Caption := '正在同步...';
    TFrmPPTExt(_extForm).ComboBox1.ItemIndex := PageNumber-1;
  end;
end;

procedure TfrmPPT.Openppt;
var
  i: integer;
begin
  try
    pptapp := GetActiveOleObject('PowerPoint.Application');
  except
    pptapp := CreateOleObject('PowerPoint.Application');
    pptapp.Activate;
    pptapp.WindowState := ppWindowMinimized;
  end;
  pptPresentation := OleVariant(pptapp).Presentations.open(PPTFileName, True, False, False);
  pptPresentation.SlideShowSettings.ShowType := ppShowTypeKiosk;
  pptView := pptPresentation.SlideShowSettings.Run;
  pptView.Top := 0;
  pptView.Left := 0;
  if _extForm<>nil then
  begin
    TFrmPPTExt(_extForm).ComboBox1.Items.Clear;
    for i:= 1 to pptPresentation.Slides.Count do
      TFrmPPTExt(_extForm).ComboBox1.Items.Add('第'+inttostr(i)+'页/共'+inttostr(pptPresentation.Slides.Count)+'页');
    TFrmPPTExt(_extForm).ComboBox1.ItemIndex := 0;
  end;
  _pptOpened := True;
//  pptView.Height := screen.Height div 2;
//  pptView.Width := screen.Width div 2;
end;

procedure TfrmPPT.pptUdpFail(sender: TObject);
var
  hosts: TStringList;
  iq: TXMLTag;
  i: integer;
begin
  if IsHost then
  begin
    if _task.Status='connecting' then
    begin
      hosts := TStringList.Create;
      UDPController.GetUDPInfo(hosts);
      iq := TXMLTag.Create('iq');
      with iq do begin
        setAttribute('to', Tojid);
        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);
    end
    else
    begin
      ShowRiserWindow(nil, '接收文件失败', ico_info);
      Close;
    end;
  end
  else begin
    if _task.Status='connecting' then
    begin
      FreeAndNil(_task);
      sendpptbyibb;
    end
    else
    begin
      ShowRiserWindow(nil, '传送文件失败', ico_info);
      _task.Free;
      _task := nil;
      close;
    end;
  end;
end;

procedure TfrmPPT.pptUdpRcv(sender: TObject; Adata: TStream);
var
  UDPHead: TAnyQUDPHead;
  Buf: array of Byte;
  decsize: integer;
begin
  AData.Seek(0,0);
  if AData.Size = 0 then
  begin
    CCheck(inflateEnd(FZRec));
    CloseFile(_rcvfile);
    IsReady := True;
//    FreeAndNil(_task);
    _task := nil;
    DoRcved;
  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
        BlockWrite(_rcvfile, FBuffer[0], decsize);
        FZRec.next_out := @FBuffer[0];
        FZRec.avail_out := 4096;
      end;
      DCheck(inflate(FZRec, 0));
      decsize := 4096 - FZRec.avail_out;
    end;
    BlockWrite(_rcvfile, FBuffer[0], decsize);
  end;
end;

procedure TfrmPPT.pptUdpRcvStatus(sender: TObject);
begin
  if TAnyQBaseUDPTask(Sender).Status='connected' then
  begin
    if IsHost then
    begin
      StartSend;
    end
    else
    begin
      startrcv;
    end;
  end;
  if TAnyQBaseUDPTask(Sender).Status='sended' then
    if IsHost then
      SendNext;
  {TODO 检测继续发送数据}
end;

procedure TfrmPPT.pptUdpTimeout(Sender: TObject);
begin
  if IsHost then
    ShowRiserWindow(nil,'由于网络连接原因，发送文件失败!',ico_info)
  else
    ShowRiserWindow(nil,'由于网络连接原因，接收文件失败!',ico_info);
  close;
end;

procedure TfrmPPT.Sendpptbyibb;
var
  task: TJITSendFile;
begin
  Task := TJITSendFile.Create;
  with task do
  begin
    TOJID := self.ToJID;
    IBBController := MainIBBController;
    IBBSID := GUIDToString(PPTID);
    _SID := IBBSID;
    OnProcessReceive := self.pptibbRcv;
    OnSend := self.pptibbSend;
    FileName := ExtractFileName(self.PPTFileName);
  end;
  MainIBBController.AddTask(task.IBBSID, task);
  SeqNo := 0;
  SeqCount := 0;
  Buf := '';
  _ReadyId := MainSession.generateID();
  task.AskReady(_ReadyId);
end;

procedure TfrmPPT.SendPPT;
var
  file_path: string;
  f: file of byte;
  iq: TXMLTag;
  hosts: Tstringlist;
  i: Integer;
begin
  CreateGUID(pptID);
  try
    _Task := TAnyQBaseUDPTask.Create(UDPController, pptID);
    _Task.OnRcvData := pptUdpRcv;
    _Task.OnRcvStatus := pptUdpRcvStatus;
    _Task.OnFail := pptUdpFail;
    _Task.OnTimeOut := pptUdpTimeout;
    hosts := TStringList.Create;
    UDPController.GetUDPInfo(hosts);

    iq := TXMLTag.Create('iq');
    with iq do begin
      setAttribute('to', tojid);
      setAttribute('id', MainSession.generateID());
      setAttribute('type', 'set');
      with AddTag('query') do begin
        setAttribute('xmlns', XMLNS_AnyQUDP);
        AddBasicTag('taskid', GUIDToString(_Task.TaskID));
        AddBasicTag('type', 'powerpoint');
        with AddBasicTag('desc', '') do
        begin
          setAttribute('filename', ExtractFileName(PPTFileName));
          AssignFile(f, PPTFileName);
          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
    Sendpptbyibb;
  end;
end;

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

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

  AssignFile(_rcvfile, PPTFileName);
  Rewrite(_rcvfile);
end;

procedure TfrmPPT.FormCreate(Sender: TObject);
begin
  inherited;
  IsHost := False;
  IsReady := False;
  _pptOpened := False;
end;

procedure TfrmPPT.SendNext;
var
  Buf: array [0..4095] of Byte;
  BufSize: Integer;
  i: integer;
begin
  try
    if _sendfile.Position<_sendfile.Size then
    begin
      bufsize := _sendfile.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 _sendfile.Position>=_sendfile.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);
    end
    else
    begin
      CCheck(deflateEnd(FZRec));
      _task.SendEndFlag;
      FreeAndNil(_sendfile);
      FreeAndNil(_task);
      IsReady := True;
      DoSended;
    end;
  except
    ShowRiserWindow(nil,'由于网络连接原因，发送文件失败!',ico_info);
    close;
  end;   {}
end;

procedure TfrmPPT.StartSend;
var
  Buf: array [0..4095] of Byte;
  BufSize: Integer;
  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)));
  _sendfile := TFileStream.Create(PPTfilename, fmOpenRead  or fmShareDenyNone);
  try
    if _sendfile.Position<_sendfile.Size then
    begin
      bufsize := _sendfile.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 _sendfile.Position>=_sendfile.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);
    end
    else
    begin
      CCheck(deflateEnd(FZRec));
      _task.SendEndFlag;
      FreeAndNil(_sendfile);
      FreeAndNil(_task);
      IsReady := True;
      DoSended;
    end;
  except
    ShowRiserWindow(nil,'由于网络连接原因，发送文件失败!',ico_info);
    close;
  end;   {}
end;

procedure TfrmPPT.FormDestroy(Sender: TObject);
begin
  if _ChatForm <> nil then
    if not (csDestroying in _ChatForm.ComponentState) then
      TfrmChat(_ChatForm)._pptForm := nil;
  _ChatForm := nil;
  if _extForm<>nil then
    Freeandnil(_extForm);
  if (fstream <> nil) then
    FreeAndNil(fstream);
  if UDPController<>nil then
    if _task<> nil then
      FreeAndNil(_task);
  if _sendfile<>nil then
    FreeAndNil(_sendfile);
  inherited;
end;

procedure TfrmPPT.DoRcved;
begin
  Openppt;
end;

procedure TfrmPPT.DoSended;
begin
  Openppt;
end;

procedure TfrmPPT.pptibbRcv(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
    Close;
    exit;
  end;

  if t = 'result' then
  begin
    if IsHost then
      if MainIBBController.FindTask(_SID) <> nil then
        TJITSendFile(MainIBBController.FindTask(_SID)).startsend;
    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
      StartRcv;
      //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;
    BlockWrite(_rcvfile, decbuf[0], decsize);
  end;

  if qtag.TagExists('close') then
  begin
    CloseFile(_rcvfile);
    if seqcount <> seqNo + 1 then
    begin
      ShowRiserWindow(nil, '对方已取消文件接收!', ico_info);
    end
    else
    begin
      IsReady := True;
      DoRcved;
    end;
    exit;
  end;
end;

procedure TfrmPPT.pptibbSend(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
  fstream := TFileStream.Create(pptfilename, fmOpenRead or fmShareDenyNone);
  seqNo := 0;
  seqCount := (fstream.Size) div (BlockSize * 3 div 4);

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

  sending := seqNo < seqcount;
  fstream.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 := fstream.Read(fbuf, 4096);
      FillChar(FBuffer, 5000, #0);

      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);
      if seqNo = 0 then
      begin
        FZRec.zalloc := zlibAllocMem;
        FZRec.zfree := zlibFreeMem;
        CCheck(deflateInit_(FZRec, -1, zlib_version, sizeof(FZRec)));
      end;

      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;
    Application.ProcessMessages;
  end;
  FreeAndNil(fstream);
//  ShowRiserWindow(nil, '文件传送完毕！', ico_info);
  DoSended;
end;

procedure TfrmPPT.tbFirstClick(Sender: TObject);
begin
  try
    goPage(1);
  except
    Close;
  end;
end;

procedure TfrmPPT.tbPreviousClick(Sender: TObject);
begin
  try
    if pptView.View.CurrentShowPosition>1 then
      goPage(pptView.View.CurrentShowPosition-1);
  except
    Close;
  end;
end;

procedure TfrmPPT.tbLastClick(Sender: TObject);
begin
  try
    goPage(pptPresentation.Slides.Count);
  except
    Close;
  end;
end;

procedure TfrmPPT.tbNextClick(Sender: TObject);
begin
  try
    if pptView.View.CurrentShowPosition<pptPresentation.Slides.Count then
      goPage(pptView.View.CurrentShowPosition+1);
  except
    Close;
  end;
end;

procedure TfrmPPT.tbSyncClick(Sender: TObject);
begin
  try
    goPage(pptView.View.CurrentShowPosition);
  except
    Close;
  end;
end;

procedure TfrmPPT.tbCloseClick(Sender: TObject);
begin                                                                          
  sendpptCmd('close');
  Close;
end;

procedure TfrmPPT.tbWindowClick(Sender: TObject);
begin
  pptView.Height := 72*(Screen.DesktopHeight div 2)/screen.PixelsPerInch;
  pptView.width := 72*(Screen.DesktopWidth div 2)/screen.PixelsPerInch;
  hide;
  if _extForm<>nil then
  begin
    TFrmPPTExt(_extForm).sbFullscreen.Enabled := True;
  end;
end;

procedure TfrmPPT.sendpptCmd(cmd: string);
var
  iq: TJabberIQ;
  q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
  taskguid: TGUID;
begin
  tmp_id := TJabberID.Create(toJid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '对方已经脱机，演讲结束。', ico_info);
      if cmd<>'close' then
        Close;
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := toJid;
  tmp_id.Free;

  try
    iq := TJabberIQ.Create(MainSession, MainSession.generateID, pptCallback, 15);
    with iq do begin
      Namespace := XMLNS_AnyQPPT;
      iqType := 'set';
      toJid := tmps;
      qTag.AddBasicTag('pptid', GUIDToString(pptID));
      if Cmd='close' then
      begin
        qTag.AddBasicTag('close', '');
        Send;
        exit;
      end;
      qTag.AddBasicTag('page', cmd);
      Send;
    end;
  except
    ShowRiserWindow(nil, 'PowerPoint演讲中出错，将被关闭。', ico_info);
    close;
  end;    {}
end;

procedure TfrmPPT.PPTCallback(event: string; tag: TXMLTag);
var
  errtag: TXMLTag;
begin
  if ((event = 'xml') or (event = 'cache')) then begin
    if (tag.GetAttribute('type') = 'error') then
    begin
      ShowRiserWindow(nil, '出现错误，PowerPoint演讲将关闭', ico_info);
      close;
    end;

    if (tag.GetAttribute('type') = 'result') then
    begin
      //对方接受请求，进行处理
      tbFirst.Enabled := True;
      tbPrevious.Enabled := True;
      tbNext.Enabled := True;
      tbLast.Enabled := True;
      if _extForm<>nil then
      begin
        TFrmPPTExt(_extForm).sbFirst.Enabled := True;
        TFrmPPTExt(_extForm).sbPrevious.Enabled := True;
        TFrmPPTExt(_extForm).sbNext.Enabled := True;
        TFrmPPTExt(_extForm).sbLast.Enabled := True;
        TFrmPPTExt(_extForm).RxGIFAnimator1.Animate := False;
        TFrmPPTExt(_extForm).RxGIFAnimator1.FrameIndex := 0;
        TFrmPPTExt(_extForm).lbStatus.Caption := '已同步';
      end;

      RxGIFAnimator1.Animate := False;
      RxGIFAnimator1.FrameIndex := 0;
    end;
  end
  else
  begin
    //超时或者其他错误;
    if _extForm=nil then
      exit;
    ShowRiserWindow(nil, '对方没有响应，PowerPoint演讲将关闭', ico_info);
    Close;
  end;
end;

procedure TfrmPPT.gotoPage(PageNumber: Integer);
begin
  pptView.View.GotoSlide(PageNumber);
  if _extForm<>nil then
  begin
    TFrmPPTExt(_extForm).ComboBox1.ItemIndex := PageNumber-1;
  end;
end;

procedure TfrmPPT.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Closeppt;
  Action := caFree;
end;

procedure TfrmPPT.RxGIFAnimator1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
  sc_dragmove = $f012;
begin
  releasecapture;
  twincontrol(self).perform(wm_syscommand,sc_dragmove, 0);
end;

procedure TfrmPPT.ToolButton2MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
  sc_dragmove = $f012;
begin
  releasecapture;
  twincontrol(self).perform(wm_syscommand,sc_dragmove, 0);
end;

procedure TfrmPPT.ToolBar1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  sc_dragmove = $f012;
begin
  releasecapture;
  twincontrol(self).perform(wm_syscommand,sc_dragmove, 0);
end;

procedure TfrmPPT.CoolBar1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  sc_dragmove = $f012;
begin
  releasecapture;
  twincontrol(self).perform(wm_syscommand,sc_dragmove, 0);
end;

procedure TfrmPPT.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  sc_dragmove = $f012;
begin
  releasecapture;
  twincontrol(self).perform(wm_syscommand,sc_dragmove, 0);
end;

procedure TfrmPPT.fullScreen;
begin
  pptView.Height := 72*Screen.DesktopHeight/screen.PixelsPerInch;
  pptView.width := 72*Screen.DesktopWidth/screen.PixelsPerInch;
  Show;
  if _extForm<>nil then
  begin
    TFrmPPTExt(_extForm).sbFullscreen.Enabled := False;
  end;
end;

end.
