delphi 内嵌HTML的问题

Question

有如下一段代码  if not IsScreen then
  begin
    HTML:='<table width="100%" style="font-size:9pt;border:1px solid #808080;background-color:#FFCCFF;padding:2px;Scolor:'+SysTextColor+';margin-top:2px;margin-bottom:5px;filter: alpha(opacity=80);"><tr><td>';    //if FileSize > 1024*1024 then
    //  FileSizeStr:=FloatToStr(StrToFloat(Copy(FloatToStr( FileSize / (1024*1024) ),1,3))) +' M'
    //else    if FileSize > 1024 then
      FileSizeStr:=IntToStr(FileSize div 1024) +' K'
    else
      FileSizeStr:=IntToStr(FileSize) +' 字节';    ImageID:='Image_'+BaseID;
    HTML:=HTML+'<img id="'+ImageID+'" src="'+ResPath+'\Images\File.gif'+'" align="absbottom"> ';    if Category = tfSend then
      HTML:=HTML+' 您要给 '+FilterHTMLCode(ReceiverName)+' 发送文件：'+FilterHTMLCode(FileName)+'（'+FileSizeStr+'）<br>'
    else
      HTML:=HTML+FilterHTMLCode(SenderName)+' 要给您发送文件：'+FilterHTMLCode(FileName)+'（'+FileSizeStr+'）<br>';    PercentID:='Percent_'+BaseID;
    if Category = tfSend then
      HTML:=HTML+'<span id="'+PercentID+'" style="position:relative;top:18px;left:5px;">等待对方回应...</span><br>'
    else
      HTML:=HTML+'<span id="'+PercentID+'" style="position:relative;top:18px;left:5px;">等待您的回应...</span><br>';    HTML:=HTML+'<table  width="288" border="0" cellpadding="0" cellspacing="1" bgcolor="#808080" style="margin-bottom:5px">'+
             '   <tr bgcolor="#FFCCFF">'+
             '     <td>'+
          '       <table width="288" border="0" cellpadding="0" cellspacing="0" bgcolor="#FFCCFF" height="18">'+
            '       <tr bgcolor="#FFCCFF">';    CompletedID:='Completed_'+BaseID;
    HTML:=HTML+'<td id="'+CompletedID+'" width="0%" bgcolor="#5FFF3F"></td>';
  
    UndoneID:='Undone_'+BaseID;
    HTML:=HTML+'<td id="'+UndoneID+'" width="100%" ></td>';    HTML:=HTML+'      </tr>'+
             '      </table>'+
             '    </td>'+
          '  </tr>'+
            '</table>';
             
    ActionID:='Action'+BaseID;
    HTML:=HTML+'<span id="'+ActionID+'">';
    if Category = tfSend then
      HTML:=HTML+'<a href="TFCancel_'+BaseID+'" title="取消发送此文件">取消</a> '
    else
      HTML:=HTML+'<a href="TFAccept_'+BaseID+'" title="接受此文件">接受</a>　'+
               '<a href="TFdecline_'+BaseID+'" title="拒绝接受此文件">拒绝</a> ';
    HTML:=HTML+'</span>';    HTML:=HTML+'</td></tr></table>';
  end
  else
  begin
    HTML:='<DIV style="padding-bottom:2px;color:'+SysTextColor+'">'+SenderName+' '+TimeToStr(Now)+' ：<br> ';
    ImageID:='Image_'+BaseID;
    if Category = tfSend then
    begin
      HTML:=HTML+'<img id="'+ImageID+'" src="'+FileName+'" hspace="2" vspace="2"> ';
    end
    else
    begin
      HTML:=HTML+'<img id="'+ImageID+'" src="'+ResPath+'\Images\progress.gif'+'" hspace="2" vspace="2"> ';
      Accept();
    end;
    HTML:=HTML+' </DIV>';
  end;代码里还有Accept事件，就是接收文件的事件当我点击“接受”超连接后，没有任何反应，也没有触发Accept事件，我应该怎么做

Answer 1

你的HTML变量最后是给谁的？
win32应用里的Twebbrowser的显示内容？
isapi应用的返回值response.content？

Answer 2

<a href="TFAccept_'+BaseID+'" title="接受此文件">接受</a>
要看 TFAccept_'+BaseID+' 到底是怎么做的

Answer 3

TFAccept_'+BaseID的完整字符串是TFAccept_23DKDIGKSKGNHI445
23DKDIGKSKGNHI445这个不一定准确，但是表示的是文件的MD5值，整个字符串是一个超连接，我看了程序上下部分，都没发现这个超连接究竟做了什么。

Answer 4

最后是这样的。InsertHTML(ChatingForm,ChatingForm.MsgContent,HTML);
InsertHTML是一个自定义函数procedure InsertHTML(ChatingForm:TChatingForm;IE:TWebbrowser;HTML:String);
var
  DoC: IHTMLDocument2;
begin
  Doc := IE.Document as IHTMLDocument2;
  Doc.body.innerHTML:=Doc.body.innerHTML+HTML;  sendMessage(GetWindow(GetWindow(IE.Handle,GW_CHILD),GW_CHILD), WM_VSCROLL, SB_BOTTOM, 0); 
  sendMessage(GetWindow(GetWindow(IE.Handle,GW_CHILD),GW_CHILD), WM_VSCROLL, SB_BOTTOM, 0); 
  sendMessage(GetWindow(GetWindow(IE.Handle,GW_CHILD),GW_CHILD), WM_VSCROLL, SB_BOTTOM, 0);  if ChatingForm<>nil then
  begin
    with ChatingForm do
    begin
      if (not Focused) and (GetForegroundWindow<>Handle) and ((not Pushed and not Visible) or (Pushed and Visible)) and (not DontPlaySound) then
      begin
        PlayEventSound(MsgSound);
        FocusForm(ChatingForm);
      end;
    end
  end;
end;

Answer 5

等于是说最后只是把这个HTML变量的内容写到CHATINGFORM的某个框框里

Answer 6

那这个TFAccept_xxx应该是一个 什么链接 ？
感觉应该是一个js函数来实现对应的行为，但是看代码显然不是js函数

Answer 7

也许是被操控的浏览器在点击事件里接管了点击的对象。
转交操控者（delphi程序）来做相应的动作了

Answer 8

被操控的浏览器?是从这里看出来的吗
  Doc := IE.Document as IHTMLDocument2;
  Doc.body.innerHTML:=Doc.body.innerHTML+HTML;  sendMessage(GetWindow(GetWindow(IE.Handle,GW_CHILD),GW_CHILD), WM_VSCROLL, SB_BOTTOM, 0); 
  sendMessage(GetWindow(GetWindow(IE.Handle,GW_CHILD),GW_CHILD), WM_VSCROLL, SB_BOTTOM, 0); 
  sendMessage(GetWindow(GetWindow(IE.Handle,GW_CHILD),GW_CHILD), WM_VSCROLL, SB_BOTTOM, 0);你的意思是说这个程序还差一些东西？

Answer 9

它这样做，好像没什么操控
一般的操控是通过Twebbrowser的事件接管的

Answer 10

这个程序也有一个专门的接受函数Accept();procedure TTransmitFile.Accept();
var
  E:IHTMLElement;
  CBSendFileResponse:TCBSendFileResponse;
  CBPleaseCallMe:TCBPleaseCallMe;
  Buffer:Array[1..2048]of char;
  iLoop:Integer;
  IsInSameNet:Boolean;
  Employee:PEmployee;
  TransmitFile:TTransmitFile;
  NullChar:char;
  SendFileResume:TCBSendFileResume;
  FileTableUnit:PFileTableUnit;
  Start,TFCount:Integer;
begin
  if Category = tfGet then
  begin
    TFCount:=0;
    with TransmitFiles.LockList do
    try
      for iLoop:=0 to Count - 1 do
      begin
        TransmitFile:=Items[iLoop];
        if (TransmitFile.SenderID = SenderID) and (TransmitFile.ReceiverID = ReceiverID) and (TransmitFile.IsAccepted=True) then
        begin
          Inc(TFCount);
          if TFCount>=3 then
          begin
            messagebox(ChatingForm.Handle,'在其它文件或图片发送完毕之前，您不能接受新的文件传输邀请！','提示',MB_ICONINFORMATION);
            exit;
          end;
        end;
      end;
    finally
      TransmitFiles.UnlockList;
    end;    try
      if not IsScreen then
      begin
        ChatingForm.SaveDialog.FileName:=FileName;
        if ChatingForm.SaveDialog.Execute then
        begin
          SaveFileName := ChatingForm.SaveDialog.Files.Strings[0];
          if FileExists(SaveFileName) then DeleteFile(PChar(SaveFileName));
        end
        else
        begin
          exit;
        end;
      end
      else
      begin
        SaveFileName := ResPath+'\Screens\'+IntToStr(SenderID)+'\R'+FileName;
        if not DirectoryExists(ExtractFilePath(SaveFileName)) then CreateDir(ExtractFilePath(SaveFileName));
      end;      if FileExists(CachePath+'\'+FileHashCode) then
      begin
        if IsScreen or (MessageBox(ChatingForm.handle,'此文件在上次传输时被中断，是否使用断点续传方式接收？','提示',MB_ICONQUESTION or MB_YESNO) = ID_YES) then
        begin
          FileStream:=TFileStream.Create(CachePath+'\'+FileHashCode,fmOpenReadWrite or fmShareDenyWrite);          try
            FileStream.Position:=0;
            Start:=0;
            E:=(ChatingForm.MsgContent.Document as IHTMLDocument2).all.item(PercentID,0) as IHTMLElement;
            E.innerHTML:='准备接收文件（正在发送断点续传信息）...';
            Application.ProcessMessages;
            ResumedSize:=0;
            while Start<FileTable.Count do
            begin
                if FileTable.Count-Start>SizeOf(SendFileResume.ResumBuffer) then
                  SendFileResume.BufferLength:=SizeOf(SendFileResume.ResumBuffer)
                else
                  SendFileResume.BufferLength:=FileTable.Count-Start;
                                FileStream.Read(SendFileResume.ResumBuffer,SendFileResume.BufferLength);
                SendFileResume.Start:=Start;
                Start:=Start+SendFileResume.BufferLength;
                for iLoop:=0 to SendFileResume.BufferLength-1 do
                begin
                  PFileTableUnit(FileTable.Items[SendFileResume.Start+iLoop]).IsAccepted:=SendFileResume.ResumBuffer[iLoop+1];
                  if PFileTableUnit(FileTable.Items[SendFileResume.Start+iLoop]).IsAccepted='1' then ResumedSize:=ResumedSize+FilePackSize;
                end;
                SendFileResume.Sender:=Me.ID;
                SendFileResume.Receiver:=SenderID;
                SendFileResume.BaseID:=BaseID;
                Buffer[1]:=skSendFileResume;
                CopyMemory(@Buffer[2],@SendFileResume,SizeOf(SendFileResume));
                MySocket.SendBuffer(Buffer,SizeOf(SendFileResume)+1,True);
                Sleep(50);
                Application.ProcessMessages;
            end;
          except
          end;
        end;
      end;      if FileStream=nil then
      begin
        FileStream:=TFileStream.Create(CachePath+'\'+FileHashCode,fmCreate or fmShareDenyWrite);
        if not IsScreen then
        begin
          NullChar:='0';
          for iLoop:=0 to FileTable.Count-1 do FileStream.Write(NullChar,1);
        end;
      end;    except
      on E: Exception do
      begin
        MessageBox(ChatingForm.handle,PChar(E.message),'错误',MB_ICONERROR);
        exit;
      end;
    end;
  end;  IsAccepted:=True;
  StartTime:=GetTickcount;
  UsedTime:=0;
  LastGetOrResultTicket:=GetTickCount;
  RealMessengerX.TimeCheckTransmitFileError.Enabled:=True;  if not IsScreen then
  begin
    E:=(ChatingForm.MsgContent.Document as IHTMLDocument2).all.item(PercentID,0) as IHTMLElement;
    if Category = tfSend then
      E.innerHTML:='准备发送文件...'
    else
      E.innerHTML:='准备接受文件...';    E:=(ChatingForm.MsgContent.Document as IHTMLDocument2).all.item(ActionID,0) as IHTMLElement;
    E.innerHTML:='<a href="TFStop_'+BaseID+'" title="中断传输文件" >中断</a> ';
  end;  if Category = tfGet then
  begin
    CBSendFileResponse.IsAccept :=True;
    CBSendFileResponse.Receiver :=SenderID;
    CBSendFileResponse.BaseID   :=BaseID;
    CBSendFileResponse.IP:=MySocket.IP;
    CBSendFileResponse.Port:=MySocket.Port;
    CBSendFileResponse.LocalIP:=MySocket.LocalIP;
    CBSendFileResponse.LocalPort:=MySocket.LocalPort;    Buffer[1]:=skSendFileResponse;
    CopyMemory(@Buffer[2],@CBSendFileResponse,SizeOf(CBSendFileResponse));
    MySocket.SendBuffer(Buffer,SizeOf(CBSendFileResponse)+1,True);     
  end
  else
  begin
    SendFileThread:=TSendFile.Create(ReceiverID,BaseID,FileStream,Self);
  end;但根据上面的代码，不知道如何触发的。IsScreen一直都为FALSE

Answer 11

这个是 接受函数Accept(); 了
问题是它是如何在点击链接时被触发的一般就是我上面说的事件里截取接管触发的，但是你的代码里好像看不到