winnt/2000中利用API实现WINpop发送消息(100分)

winnt/2000中利用API实现WINpop发送消息
总出现
不支持此网络要求；
我用的是WIN200 professional

在命令行输入
net start messenger
然后再试试看

DFW以前的帖子有代码的，找找看把

实验了，不行，结果一样

net send 用戶名 '內容'

使用DElphi编写程序

http://vip.6to23.com/NowCan1/tech/netmsg.htm
这是BCB的，Delphi我不会。

没有DELPHI原代码吗？

这是原代码，但是结构看不明白，请帮帮忙

实现Net send命令？ 主要是要向局域网内的机器发送信息。
function NetSend(dest, Source, Msg: string): Longint; overload;
type
//******
TNetMessageBufferSendFunction = function(servername, msgname, fromname: PWideChar;
buf: PWideChar; buflen: Cardinal): Longint;stdcall;
var
SourceWideChar: PWideChar;

DestWideChar: PWideChar;

MessagetextWideChar: PWideChar;

Handle: THandle;

begin

Handle := LoadLibrary('NETAPI32.DLL');

if Handle = 0 then

begin

Result := GetLastError;

Exit;

end;

@NetMessageBufferSend := GetProcAddress(Handle, 'NetMessageBufferSend');

if @NetMessageBufferSend = nil then

begin

Result := GetLastError;

Exit;

end;

MessagetextWideChar := nil;

SourceWideChar := nil;

DestWideChar := nil;

try

GetMem(MessagetextWideChar, Length(Msg) * SizeOf(WideChar) + 1);

GetMem(DestWideChar, 20 * SizeOf(WideChar) + 1);

StringToWideChar(Msg, MessagetextWideChar, Length(Msg) * SizeOf(WideChar) + 1);

StringToWideChar(Dest, DestWideChar, 20 * SizeOf(WideChar) + 1);

if Source = '' then

Result := NetMessageBufferSend(nil, DestWideChar, nil,

MessagetextWideChar, Length(Msg) * SizeOf(WideChar) + 1)

else

begin

GetMem(SourceWideChar, 20 * SizeOf(WideChar) + 1);

StringToWideChar(Source, SourceWideChar, 20 * SizeOf(WideChar) + 1);

Result := NetMessageBufferSend(nil, DestWideChar, SourceWideChar,

MessagetextWideChar, Length(Msg) * SizeOf(WideChar) + 1);

FreeMem(SourceWideChar);

end;

finally

FreeMem(MessagetextWideChar);

FreeLibrary(Handle);

end;

end;

function NetSend(Dest, Msg: string): Longint; overload;

begin

Result := NetSend(Dest, '', Msg);

end;

function NetSend(Msg: string): Longint; overload;

begin

Result := NetSend('', '', Msg);

end;

winexec(pchar('net send 192.9.201.5 你好'),sw_hide)//不用ip,计算机名也可

哪里有实现NET SEND 命令的DELPHI原代码吗？
我的不好用，总出现
不支持此网络要求；
我用的是WIN200 professional

用clientsocket 和serversocket配合
可以实现

如:
clientsocket1.Socket.SendText(message);
有gettext

我不想在客户端有程序，实现局域网内任一机器发信息，其他用户都可以看到。

不想有客户端，只能用2000或NT了 ，其它它也是在后台运行messager
用API实现的代码如下二个单元一定行我在用。
//1
unit main;

interface

uses Unit2,
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls;
var
username:string;
type
tnetresourcearray=^tnetresource;
TfrmMain = class(TForm)
MesText: TMemo;
btnExit: TBitBtn;
btnSend: TBitBtn;
Label1: TLabel;
Bevel1: TBevel;
Bevel2: TBevel;
Bevel3: TBevel;
Bevel4: TBevel;
Bevel5: TBevel;
AddrBox: TComboBox;
StatusLabel: TLabel;
ComboBox1: TComboBox;
Label2: TLabel;
procedure btnSendClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MesTextChange(Sender: TObject);
procedure AddrBoxChange(Sender: TObject);
procedure ComboBox1Click(Sender: TObject);
private
UserName : string;
MessageHeader : TStringList;
function getusers(groupname:string;var list:tstringlist):boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

uses about;

{$R *.DFM}

function getserverlist(var list:tstringlist):boolean;
var
netresource:tnetresource;
bufointer;
count,bufsize,res:dword;
lphenum:thandle;
p:tnetresourcearray;
i,j:smallint;
networktypelist:tlist;
begin
result:=false;
networktypelist:=tlist.Create ;
list.Clear ;
res:=wnetopenenum(resource_globalnet,resourcetype_disk,resourceusage_container,
nil,lphenum);
if res <>no_error then exit;
count:=$ffffffff;
bufsize:=8192;
getmem(buf,bufsize);
res:=wnetenumresource(lphenum,count,pointer(buf),bufsize);
if (res=error_no_more_items) or (res<>no_error) then exit;
p:=tnetresourcearray(buf);
for i:=0 to count-1 do
begin
networktypelist.Add (p);
inc(p);
end;
res:=wnetcloseenum(lphenum);
if res<>no_error then exit;
for j :=0 to networktypelist.Count -1 do
begin
netresource:=tnetresource(networktypelist.Items[j]^);
res:=wnetopenenum(resource_globalnet,resourcetype_disk,
resourceusage_container,@netresource,lphenum);
if res<>no_error then break;
while true do
begin
count:=$ffffffff;
bufsize:=8192;
getmem(buf,bufsize);
res:=wnetenumresource(lphenum,count,pointer(buf),bufsize);
if (res=error_no_more_items) or (res<>no_error) then break;
p:=tnetresourcearray(buf);
for i:=0 to count-1 do
begin
list.Add (strpas(p^.lpremotename));
inc(p);
end;
end;
res:=wnetcloseenum(lphenum);
if res<>no_error then break;
end;
result:=true;
freemem(buf);
networktypelist.Destroy ;
// procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
//begin
//deletefile(temp);
//end;

end;


procedure TfrmMain.btnSendClick(Sender: TObject);
var
i, res: Integer;
begin
if AddrBox.Text <> '' then
begin
StatusLabel.Font.Color := clBlack;
StatusLabel.Caption := '请等待... ';
Update;
if AddrBox.Items.IndexOf(AddrBox.Text) = -1 then
AddrBox.Items.Add(AddrBox.Text);
res := SendMsg(AddrBox.Text,'',MessageHeader.Text+mesText.Text);
if res = 0 then
frmMain.StatusLabel.Font.Color := clBlue
else
frmMain.StatusLabel.Font.Color := clRed;
case res of
0 : frmMain.StatusLabel.Caption := '本次消息已发送成功！';
87 : frmMain.StatusLabel.Caption := '参数不正确！';
123 : frmMain.StatusLabel.Caption := '不支持此网络请求！';
2273 : frmMain.StatusLabel.Caption := '不能找到 '+frmMain.AddrBox.Text;
else frmMain.StatusLabel.Caption := '错误: '+IntToStr(res);
end;
end;
end;


procedure TfrmMain.FormCreate(Sender: TObject);
var
strUser : PChar;
strSize : DWord;
sl:tstringlist;
i:integer;

list:tstringlist;
i1:integer;
begin
MesText.Lines.Clear;
strUser := StrAlloc(100);
strSize := 100;
GetUserName(strUser,strSize);
UserName := strUser;
StrDispose(strUser);
MessageHeader := TStringList.Create;
MessageHeader.Add('---------------------------------');
MessageHeader.Add(' from '+UserName);
MessageHeader.Add('---------------------------------');


sl:=tstringlist.Create ;
if getserverlist(sl) then
begin
for i:=0 to sl.Count-1 do
combobox1.Items.Add(sl.CommaText) ;
combobox1.Text :=combobox1.Items[0];
end ;



begin
addrbox.Items.Clear ;
try
list:=tstringlist.Create ;
if getusers(combobox1.text,list)then
if list.Count =0 then

else

for i1:=0 to list.count-1 do
begin

addrbox.Items.Add(copy(list.strings[i1],3,length(list.strings[i1])-2));
addrbox.text:=addrbox.Items[0];

end;
finally
list:=tstringlist.Create ;
end;
end;






end;


procedure TfrmMain.MesTextChange(Sender: TObject);
begin
StatusLabel.Caption := ' ';
end;

procedure TfrmMain.AddrBoxChange(Sender: TObject);
begin
StatusLabel.Caption := ' ';
end;



function tfrmmain.getusers (groupname:string;var list:tstringlist):boolean;
var
netresource:tnetresource;
bufointer;
count,bufsize,res:dword;
ind:integer;
lphenum:thandle;
temp:tnetresourcearray;
begin
result:=false;
list.Clear ;
fillchar(netresource,sizeof(netresource),0);//初始化网络层次信息
netresource.lpRemoteName :=@groupname[1];//指定工作组名称
netresource.dwDisplayType :=resourcedisplaytype_server;//类型为服务器
netresource.dwUsage :=resourceusage_container;
netresource.dwScope :=resourcetype_disk;
res:=wnetopenenum(resource_globalnet,resourcetype_disk,resourceusage_container,@netresource,lphenum);
if res<>no_error then exit;
while true do
begin
count:=$ffffffff;
bufsize:=8192;
getmem(buf,bufsize);
res:=wnetenumresource(lphenum,count,pointer(buf),bufsize);
if res=error_no_more_items then break;
if (res<>no_error)then exit;
temp:=tnetresourcearray(buf);
for ind:=0 to count-1 do//列举工作组的计算机名
begin
list.Add (temp^.lpremotename);
inc(temp);
end;
end;
res:=wnetcloseenum(lphenum);//关闭一次列举
if res<>no_error then exit;
result:=true;
freemem(buf);
end;


procedure TfrmMain.ComboBox1Click(Sender: TObject);
var
list:tstringlist;
i:integer;
begin
addrbox.Items.Clear ;
try
list:=tstringlist.Create ;
if getusers(combobox1.text,list)then
if list.Count =0 then

else

for i:=0 to list.count-1 do
begin

addrbox.Items.Add(copy(list.strings,3,length(list.strings)-2));
addrbox.text:=addrbox.Items[0];

end;
finally
list:=tstringlist.Create ;
end;
end;
end. //主程序


unit Unit1;

interface
uses sysutils,classes;
function tounicode(str:string;destwidechar):integer;
function sendmsg(toh,from,msg:string):integer;
function netmessagebuffersend(servernamewidechar;
msgnamewidechar;
fromnamewidechar;
bufwidechar;
var buflen:integer):integer;cdecl;
implementation
function tounicode(str:string;destwidechar):integer;
var
len:integer;
begin
stringtowidechar(str,dest,len);
result:=len;
end;
function NetMessageBufferSend; external 'netapi32.dll' name 'NetMessageBufferSend';
function sendmsg(toh,from,msg:string):integer;
var
toname:array[0..64]of widechar;
wmsgtext:array[0..1000] of widechar;
msglen,i:integer;
begin
for i:=0 to 64 do toname:=#0;
tounicode(toh,toname);
for i:=0 to 1000 do wmsgtext:=#0;
tounicode(msg,wmsgtext);
result:=netmessagebuffersend(nil,toname,nil,@wmsgtext,msglen);
end;
end.

珍藏！

to fisher70
你的程序我实验过了，和我的一样出现：不支持此网络要求；

我的实验环境是 WIN200 professional，2000对等局域网，没有域控制器，没有服务器。

我用net命令发送消息可以，可是换成程序发送就出现“不支持此网络要求”，是否是我的
机器某些协议没装，但net命令可以发给每台机器。

请帮我想想，这是怎么回事情。

to liuhailong1977
怪，我用2000 nt xp 使用 ，目的机有2000 XP 98都未出现你说的情况，
或拿我的程序试试，

收下