现在有些网站提供在线聊天服务,请大家说说是如何实现的?--急需这方面的参考(200分)

  • 主题发起人 主题发起人 lsj
  • 开始时间 开始时间
L

lsj

Unregistered / Unconfirmed
GUEST, unregistred user!
有个Web应用要求实现这个功能,要求只用浏览器,请大家帮帮忙.
 
如果是普通的,有很多的你可以去下载一个asp、php、jsp都有,各种样式的。如果要做复杂一点,高负载
你需要了解irc服务,你知道irc服务么?是unix上的一个和telnet smtp ftp一样古老的服务,不过他有着非常好的
可扩展性和稳定性,msn chat、网易chat、sohu chat 都是用这个咚咚,不过你要在web上
做他,你需要做一个ie的插件,你可以用active x或者java来实现,这是前台的东西,后台很简单
只需要装一个irc服务就可以了,unix上有现成的,windows上也有这样的服务软件,不过一般都需要crack
别的没有了。
 
to eflyer:
我找了个irc服务软件回来了,能否说说active x插件的实现方法?特别是如何自动安装?
 
网络聊天可以去www.playicq.com看看,有这方面的资料的![:)]
 
文档: http://202.96.70.228/cakk/delphi/Internet_Explorer_Plug-Ins_and_ActiveX_Companion.ZIP
就在caak.delphibbs.com上
下面的转自http://www.delphibbs.com/delphibbs/dispq.asp?lid=642446
利用Delphi编写IE扩展

在自己的程序中使用过WebBrowser控件的朋友都知道,WebBrowser控件定义了诸如BeforeNavigate、DownloadComplete 等事件,我们可以通过编写事件处理代码实现对WebBrowser控件的操作。那么如何实现对IE的事件响应和处理呢?同建立IE面板一样。我们需要建立一个实现IObjectWithSite接口的COM组件,不同的是,我们还需要实现IDispatch接口,在IObjectWithSite接口的SetSite方法中获得IE的WebBrowser接口并建立自身与WebBrowser的连接,然后如果在IE的Webbrowser对象中发生什么事件的话,那么IE就会回调连接的IDispatch接口的Invoke方法。我们通过在Invoke方法中编写代码就可以获得IE事件了。这个利用的是COM编程的回调接口原理。
下面我们首先来实现代码。点击Delphi菜单 File | New 。在 ActiveX 页面中选择Active Library ,然后点击 OK 按钮。然后用同样的方法建立一个COM Object。在COM Object Wizard 窗口中,将复选框 Included typelibrary 去掉。然后在Class Name中输入IEHelper,在Implemented Interface中输入:IDispatch;IObjectwithSite 。然后点击 OK 按钮建立一个COM组件。保存工程,将工程保存为IEHelper.dpr,将Unit1保存为IEHelperUnit.pas。下面是IEHelperUnit.pas的具体代码:
unit iehelperunit;

interface

uses
WIndows, Comobj, ActiveX, SHDOCVW, MSHTML,Dialogs;


type

TIEHelperFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register: Boolean);
override;
end;



TIEHelper = class(TComObject, IDispatch, IObjectWithSite)
public
function GetTypeInfoCount(out Count: Integer): HResult;
stdcall;
function GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo):
HResult;
stdcall;
function GetIDsOfNames(const IID: TGUID;
Names: Pointer;
NameCount, LocaleID: Integer;
DispIDs: Pointer): HResult;
stdcall;
function Invoke(DispID: Integer;
const IID: TGUID;
LocaleID:
Integer;
Flags: Word;
var Params;
VarResult, ExcepInfo, ArgErr:
Pointer): HResult;
stdcall;
function SetSite(const pUnkSite: IUnknown): HResult;
stdcall;
function GetSite(const riid: TIID;
out site: IUnknown): HResult;
stdcall;
private
IE: IWebbrowser2;
Cookie: Integer;
end;


const
Class_IEHelper: TGUID = '{3D898C55-74CC-4B7C-B5F1-45913F368388}';


implementation

uses ComServ, Registry, SysUtils;


proceduredo
StatusTextChange(const Text: WideString);
begin


end;


proceduredo
ProgressChange(Progress: Integer;
ProgressMax: Integer);
begin


end;


proceduredo
CommandStateChange(Command: Integer;
Enable: WordBool);
begin


end;


proceduredo
Downloadbegin
;
begin


end;


proceduredo
DownloadComplete;
begin


end;


proceduredo
TitleChange(const Text: WideString);
begin


end;


proceduredo
PropertyChange(const szProperty: WideString);
begin


end;


proceduredo
BeforeNavigate2(const pDisp: IDispatch;
var URL:
OleVariant;
var Flags: OleVariant;
var TargetFrameName: OleVariant;
var PostData: OleVariant;
var Headers: OleVariant;
var Cancel:
WordBool);
begin

if URL<>'http://www.applevb.com/'then
begin

Showmessage('你不可以浏览其它站点');
Cancel:=True;
URL:='http://www.applevb.com';
(pDisp as
IWebbrowser2).Navigate2(URL,Flags,TargetFrameName,PostData,Headers);
end;

end;


proceduredo
NewWindow2(var ppDisp: IDispatch;
var Cancel: WordBool);
begin


end;


proceduredo
NavigateComplete2(const pDisp: IDispatch;
var URL:
OleVariant);
begin


end;


proceduredo
DocumentComplete(const pDisp: IDispatch;
var URL:
OleVariant);
begin


end;


proceduredo
OnQuit;
begin


end;


proceduredo
OnVisible(Visible: WordBool);
begin


end;


proceduredo
OnToolBar(ToolBar: WordBool);
begin


end;


proceduredo
OnMenuBar(MenuBar: WordBool);
begin


end;


proceduredo
OnStatusBar(StatusBar: WordBool);
begin


end;


proceduredo
OnFullScreen(FullScreen: WordBool);
begin


end;


proceduredo
OnTheaterMode(TheaterMode: WordBool);
begin


end;



procedure BuildPositionalDispIds(pDispIds: PDispIdList;
const dps:
TDispParams);
var
i: integer;
begin

Assert(pDispIds <> nil);
for i := 0 to dps.cArgs - 1do

pDispIds^ := dps.cArgs - 1 - i;
if (dps.cNamedArgs <= 0) then
Exit;
for i := 0 to dps.cNamedArgs - 1do

pDispIds^[dps.rgdispidNamedArgs^] := i;
end;


function TIEHelper.Invoke(DispID: Integer;
const IID: TGUID;
LocaleID: Integer;
Flags: Word;
var Params;
VarResult, ExcepInfo, ArgErr: Pointer):
HResult;
type
POleVariant = ^OleVariant;
var
dps: TDispParams absolute Params;
bHasParams: boolean;
pDispIds: PDispIdList;
iDispIdsSize: integer;
begin

Result := DISP_E_MEMBERNOTFOUND;
pDispIds := nil;
iDispIdsSize := 0;
bHasParams := (dps.cArgs > 0);
if (bHasParams) then

begin

iDispIdsSize := dps.cArgs * SizeOf(TDispId);
GetMem(pDispIds, iDispIdsSize);
end;

try
if (bHasParams) then
BuildPositionalDispIds(pDispIds, dps);
case DispId of
102:
begin

DoStatusTextChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;

108:
begin

DoProgressChange(dps.rgvarg^[pDispIds^[0]].lval,
dps.rgvarg^[pDispIds^[1]].lval);
Result := S_OK;
end;

105:
begin

DoCommandStateChange(dps.rgvarg^[pDispIds^[0]].lval,
dps.rgvarg^[pDispIds^[1]].vbool);
Result := S_OK;
end;

106:
begin

DoDownloadbegin
();
Result := S_OK;
end;

104:
begin

DoDownloadComplete();
Result := S_OK;
end;

113:
begin

DoTitleChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;

112:
begin

DoPropertyChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;

250:
begin


DoBeforeNavigate2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[2]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[3]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[4]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[5]].pvarval)^,
dps.rgvarg^[pDispIds^[6]].pbool^);
Result := S_OK;
end;

251:
begin


DoNewWindow2(IDispatch(dps.rgvarg^[pDispIds^[0]].pdispval^),
dps.rgvarg^[pDispIds^[1]].pbool^);
Result := S_OK;
end;

252:
begin


DoNavigateComplete2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;

259:
begin


DoDocumentComplete(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;

253:
begin

DoOnQuit();
Result := S_OK;
end;

254:
begin

DoOnVisible(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;

255:
begin

DoOnToolBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;

256:
begin

DoOnMenuBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;

257:
begin

DoOnStatusBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;

258:
begin

DoOnFullScreen(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;

260:
begin

DoOnTheaterMode(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;

end;

finally
if (bHasParams) then
FreeMem(pDispIds, iDispIdsSize);
end;

end;



function TIEHelper.GetIDsOfNames(const IID: TGUID;
Names: Pointer;
NameCount, LocaleID: Integer;
DispIDs: Pointer): HResult;
begin

Result := E_NOTIMPL;
end;


function TIEHelper.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin

Result := E_NOTIMPL;
pointer(TypeInfo) := nil;
end;


function TIEHelper.GetTypeInfoCount(out Count: Integer): HResult;
begin

Result := E_NOTIMPL;
Count := 0;
end;



function TIEHelper.GetSite(const riid: TIID;
out site: IUnknown):
HResult;
begin

// Result := S_OK;
if Assigned(IE) then
result:=IE.QueryInterface(riid, site)
else

Result:= E_FAIL;
end;


function TIEHelper.SetSite(const pUnkSite: IUnknown): HResult;
var
cmdTarget: IOleCommandTarget;
Sp: IServiceProvider;
CPC: IConnectionPointContainer;
CP: ICOnnectionPoint;
begin

if Assigned(pUnkSite) then
begin

cmdTarget := pUnkSite as IOleCommandTarget;
Sp := CmdTarget as IServiceProvider;

if Assigned(Sp)then

Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
if Assigned(IE) then
begin

IE.QueryInterface(IConnectionPointContainer, CPC);
CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
CP.Advise(Self, Cookie)
end;

end;

Result := S_OK;
end;



procedure TIEHelperFactory.AddKeys;
var S: string;
begin

S := GUIDToString(CLASS_IEHelper);
with TRegistry.Createdo

try
RootKey := HKEY_LOCAL_MACHINE;
if
OpenKey('Software/Microsoft/Windows/CurrentVersion/explorer/Browser
Helper Objects/' + S, TRUE)
then
CloseKey;
finally
free;
end;

end;


procedure TIEHelperFactory.RemoveKeys;
var S: string;
begin

S := GUIDToString(CLASS_IEHelper);
with TRegistry.Createdo

try
RootKey := HKEY_LOCAL_MACHINE;

DeleteKey('Software/Microsoft/Windows/CurrentVersion/explorer/Browser
Helper Objects/' + S);
finally
free;
end;

end;


procedure TIEHelperFactory.UpdateRegistry(Register: Boolean);
begin

inherited UpdateRegistry(Register);
if Register then
AddKeys else
RemoveKeys;
end;


initialization
TIEHelperFactory.Create(ComServer, TIEHelper, Class_IEHelper,
'IEHelper', '', ciMultiInstance, tmApartment);
end.


代码很长,但是关键的是TIEHelper.SetSite方法以及TIEHelper.Invoke方
法。在TIEHelper.SetSite方法中注意以下语句:
if Assigned(Sp)then

Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
if Assigned(IE) then
begin

IE.QueryInterface(IConnectionPointContainer, CPC);
CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
CP.Advise(Self, Cookie)

上面的语句作用是,首先获得IE的Webbrowser接口,然后寻找到连接点。并通过Advise方法建立COM自身与连接点的连接。当连接建立成功后,IE在有事件引发后,会调用连接到自身的IDispatch接口对象的Invoke方法。不同的事件对应不同的DispID编码,我们可以在程序中判断DispID并做相应的处理。在上面的程序中,我们只处理了BeforeNavigate2事件,处理函数是DoBeforeNavigate2,在该函数中,如果浏览的站点不是'http://www.applevb.com/'的话,程序会提示:'你不可以浏览其它站点'并强行转到http://www.applevb.com。
很多的软件,象“护花使者”以及“3721”一类的中文网址”都是利用上面的原理来实现对IE浏览器事件响应的,例如3721,当用户输入一个中文词并浏览时,COM组件可以在BeforeNavigate2 事件中编写代码访问服务器并转到正确的站点上去。
以上程序在Win2K、Delphi 5下编写 Win98、Win2K下编辑通过 。

 
非常感谢eflyer!
我看了你的提示后,重新整理了自己的想法,同时也接受另一个朋友的意见,考虑了一
下Netmeeting,我想如果不是为大量用户提供语音服务的话,Netmeeting也是一个很好
的解决方法,而且它的功能更强,是一个不错的客户端,而且也容易嵌入网页中。
但现在的问题是如何通过浏览器控制Netmeeting的目录信息:主要是增加和删除联系人信息,也
就是控制*.wab,我查过论坛的旧贴也没发现完整的解决方法。我猜测Delphi6的Server组件
是解决的关键控件,但资料太少了,希望各位能继续指点小弟,先谢谢了!
 
多人接受答案了。
 
后退
顶部