局域网内送消息,但能不能不用每台机器都运行这个程序?(50分)

  • 主题发起人 主题发起人 sunrain_114
  • 开始时间 开始时间
S

sunrain_114

Unregistered / Unconfirmed
GUEST, unregistred user!
我想做个局域网内可互发消息的程序,但不想象winpopup一样,双方必须都打开此程序,
而是能直接将消息发给对方,目标用ip表示。
 
不大可能,除非用2000的message服务
 
有一个叫通讯员的小软件在于2K已实现这个功能了。
有没有人说说它的原理
 
o,如果在2K下,可以直接使用信使服务,但我想在98下,大侠们有办法帮着个忙吗?急!
 
98下写个程序直接在后台listen一个端口,接收到消息直接弹出个窗体,显示消息不就完了。
 
用系统自带的功能的话是不可以的那,还是老老事实写程序吧
除,netmeeting外
 
不用想了,理论上就是不能实现了。
在客户端可定要有东西接收信息的。
不运行程序怎么接受信息?!
对这种不可能的事情,根本不能实现,不要浪费时间了
 
//客户端
unit Unit_client;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, ComCtrls, ExtCtrls;

type
TfrmMain = class(TForm)
Statusbar1: TStatusBar;
Memo1: TMemo;
Client: TClientSocket;
Edit1: TEdit;
Button1: TButton;
Bevel1: TBevel;
Label1: TLabel;
edtHost: TEdit;
Label2: TLabel;
edtPort: TEdit;
btnConnect: TButton;
bntDisConnect: TButton;
btnSend: TButton;
procedure ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Memo1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure btnConnectClick(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure bntDisConnectClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
TotalLen:Integer;

implementation
uses ShellAPI;
{$R *.DFM}

procedure TfrmMain.ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels.Items[0].Text:='接受连接';
Statusbar1.Panels.items[1].text:='';
end;

procedure TfrmMain.btnSendClick(Sender: TObject);
begin
if client.Active then
begin
Client.Socket.SendText(Edit1.Text);
edit1.SelectAll;
end;
end;

procedure TfrmMain.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
re:pchar;
sbuf:string;
relong:integer;
begin
re:=nil;
while socket.ReceiveLength>0 do
begin
//申请内存
re:=AllocMem(socket.receivelength);
TRY
relong:=socket.ReceiveLength;
Socket.ReceiveBuf(re^,Socket.receivelength);
sBuf:=strpas(re);
Setlength(sbuf,relong);

//计算数据长度
TotalLen:=TotalLen+ relong;
Statusbar1.Panels.Items[1].Text:='总共接收(Byte): ' + IntToStr(TotalLen);
Statusbar1.Update();
FINALLY
freemem(re);
END;
Memo1.Lines.Add(sbuf);
end;
end;

procedure TfrmMain.ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels.Items[0].Text:='关闭与主机的连接';
Statusbar1.Panels.Items[0].Text:='';
Memo1.Lines.Clear;
edit1.Text:='';
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Client.Active then
Client.Close;
end;

procedure TfrmMain.Memo1Click(Sender: TObject);
begin
Edit1.SetFocus;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
ShellExecute(self.handle,nil,Pchar(Application.EXEname),nil,nil,SW_Normal);
end;

procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
Client.Address:=edtHost.Text;
Client.Port:=strtoint(edtPort.Text);
Client.Active:=true;
end;

procedure TfrmMain.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
if not Client.Active then
btnConnectClick(Sender);
Client.Socket.SendText(Edit1.Text);
edit1.SelectAll;
key:=#0;
end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
edtHost.Text:='166.111.187.2';
edtPort.Text:='4012';
TotalLen:=0;
end;

procedure TfrmMain.bntDisConnectClick(Sender: TObject);
begin
Client.Active:=False;
end;



end.
服务器端
unit Unit_Server;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ScktComp,Winsock, ExtCtrls;

type
TForm1 = class(TForm)
Server: TServerSocket;
btnSend: TButton;
edtSend: TEdit;
Label1: TLabel;
btnOneSend: TButton;
Label3: TLabel;
Label4: TLabel;
Bevel1: TBevel;
Combox1: TComboBox;
Statusbar1: TStatusBar;
Memo1: TMemo;
procedure ServerClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure ServerAccept(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure btnSendClick(Sender: TObject);
procedure ServerClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure btnOneSendClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Type UsrRec=Record
SocketID:Integer;
UsrName:string;
Passwd:string;
IP:string;
ReceivingData:string;
End;

var
Form1: TForm1;
buf:string;
bEUserName,bEPasswd:Boolean;
Usr:^UsrRec;

implementation

{$R *.DFM}

procedure TForm1.ServerClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
Var
strIp,strHost:string;
Count:Integer;
begin
strIp:=Socket.RemoteAddress;
strHost:=Socket.RemoteHost;
Memo1.Lines.Add('当前登录用户');
Memo1.Lines.add(#9'SocketID:'+Inttostr(Socket.SocketHandle));
Combox1.Items.Add(Inttostr(Socket.SocketHandle));
Memo1.lines.add(#9'IP地址:'+strIp);
Memo1.Lines.Add(#9'主机名:'+strHost);
Count:=Server.Socket.ActiveConnections;
Statusbar1.Panels.Items[1].Text:='在线用户: '+IntToStr(Count);
end;

procedure TForm1.ServerClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
p:pchar;
length:longint;
Count,i:Integer;
begin
p:=nil;
while socket.ReceiveLength>0 do begin
length:=socket.receivelength;
Getmem(p,length);
TRY
socket.ReceiveBuf(p^,socket.receivelength);
Count:=Server.Socket.ActiveConnections;
for i:=0 to Count-1 do
Server.Socket.Connections.SendBuf(p^,length);
FINALLY
FreeMem(p);
END;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// 程序开始运行时激活服务器端Socket
Server.Active:=true;
Statusbar1.Panels.Items[0].Text:='服务器启动.主机名:'+Server.Socket.LocalHost+' 监听端口:'+inttostr(Server.Port);
self.Caption:=Statusbar1.Panels.Items[0].Text;
Application.Title:=Statusbar1.Panels.Items[0].Text;
Statusbar1.Panels.Items[1].Text:='在线用户数: '+IntToStr(Server.Socket.ActiveConnections);
end;

procedure TForm1.ServerAccept(Sender: TObject; Socket: TCustomWinSocket);
var
Tempstr:pchar;
begin
TempStr:=pchar('欢迎登陆服务器 '#13#10);
socket.SendText(TempStr);
TempStr:=pchar('#######################################'+#13#10);
socket.SendText(TempStr);
TempStr:=pchar('你所输入的内容将发送给所有在线用户'+#13#10);
socket.SendText(TempStr);
end;

procedure TForm1.ServerClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
//错误判断
Case ErrorCode Of
10054:Memo1.lines.add('连接被用户重置.');
Else
Memo1.Lines.Add('发生Socket错误,错误代码:'+InttoStr(errorCode));
// 显示错误码
End;
ErrorCode:=0;
end;

procedure TForm1.btnSendClick(Sender: TObject);
var
i:integer;
Count:Integer;
begin
Count:=Server.Socket.ActiveConnections;
for i:=0 to Count-1 do
Server.Socket.Connections.SendText(edtSend.text);
end;

procedure TForm1.ServerClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
Var
Count:Integer;
IDIndex:Integer;
begin
Memo1.Lines.add('用户离线');
Memo1.Lines.add(' SocketID:'+Inttostr(Socket.SocketHandle));
IDIndex:=Combox1.Items.IndexOf( Inttostr(Socket.SocketHandle));
Combox1.Items.Delete(IDIndex);
//该事件在用户离开前发生
Count:=Server.Socket.ActiveConnections-1;
Statusbar1.Panels.Items[1].Text:='在线用户:'+Inttostr(Count);
end;

procedure TForm1.btnOneSendClick(Sender: TObject);
var
ID:Integer;
Socket:TCustomWinSocket;
begin
if Combox1.Text='' then
exit;
ID:=strtoint(Combox1.text);
//用已有的Socket句柄建立socket对象
Socket:=TCustomWinSocket.Create(ID);
Socket.SendText(EdtSend.text);
end;

end.
 
这个还是在客户端的啊,难道真的作不到吗?!
 
不可能实现的!!!就是NT及2000也是运行信使服务的,你试试关闭message服务还能收到吗?

 
后退
顶部