利用netmessagebuffersend实现的局域网发送信息. ( 积分: 0 )

小弟是菜鸟,刚学,不太会,感谢在编写过程中给我帮助的朋友 TYZhang,hotboys,lgxyy,n_y_system.大富翁真是学习的好地方,有这么多热心的朋友.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
NET_API_STATUS = LongInt;
function netmessagebuffersend(servernamewidechar;tonamewidechar;fromnamewidechar;bufwidechar;var buflen:integer):integer;stdcall; external 'netapi32.dll' name 'NetMessageBufferSend'; //声明自库文件中netapi32.dll中引入一个函数,函数的原始名是NetMessageBufferSend，但其作为netmessagebuffersend被引入.
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
Label3: TLabel;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.Clear;
edit2.Clear;
edit3.Clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
string1,string2,string3:string;
pstring1,pstring2:array[0..28] of widechar;
pstring3:array[0..1024] of widechar;
i,j,length,max_length:integer;
begin
length:=28;
max_length:=1025; //发送内容长度
string1:=edit1.Text; //发送者
string2:=edit2.Text; //目的地址
string3:=edit3.Text; //发送内容
for i:=0 to 28 do
begin
pstring1:=#0; //将所有的字节都填充#0字符
stringtowidechar(string1,pstring1,length); //将string类型转换成api函数的pwidechar类型
pstring2:=#0;
stringtowidechar(string2,pstring2,length);
pstring3:=#0;
stringtowidechar(string3,pstring3,length);
end;
netmessagebuffersend(nil,pstring2,pstring1,pstring3,max_length);
j:=netmessagebuffersend(nil,pstring2,pstring1,pstring3,max_length); //用来判断是否发送成功
if j<>0 then
showmessage('send error')
else
showmessage('send success');

end;

end.

小弟是菜鸟,刚学,不太会,感谢在编写过程中给我帮助的朋友 TYZhang,hotboys,lgxyy,n_y_system.大富翁真是学习的好地方,有这么多热心的朋友.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
NET_API_STATUS = LongInt;
function netmessagebuffersend(servernamewidechar;tonamewidechar;fromnamewidechar;bufwidechar;var buflen:integer):integer;stdcall; external 'netapi32.dll' name 'NetMessageBufferSend'; //声明自库文件中netapi32.dll中引入一个函数,函数的原始名是NetMessageBufferSend，但其作为netmessagebuffersend被引入.
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
Label3: TLabel;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.Clear;
edit2.Clear;
edit3.Clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
string1,string2,string3:string;
pstring1,pstring2:array[0..28] of widechar;
pstring3:array[0..1024] of widechar;
i,j,length,max_length:integer;
begin
length:=28;
max_length:=1025; //发送内容长度
string1:=edit1.Text; //发送者
string2:=edit2.Text; //目的地址
string3:=edit3.Text; //发送内容
for i:=0 to 28 do
begin
pstring1:=#0; //将所有的字节都填充#0字符
stringtowidechar(string1,pstring1,length); //将string类型转换成api函数的pwidechar类型
pstring2:=#0;
stringtowidechar(string2,pstring2,length);
pstring3:=#0;
stringtowidechar(string3,pstring3,length);
end;
netmessagebuffersend(nil,pstring2,pstring1,pstring3,max_length);
j:=netmessagebuffersend(nil,pstring2,pstring1,pstring3,max_length); //用来判断是否发送成功
if j<>0 then
showmessage('send error')
else
showmessage('send success');

end;

end.

呵呵，我才提过这个问题，没人理我。
如果你需要，明天我给你源码。
不过存在我提过的问题，向其他机器发送消息是没问题的。

unit main;

interface

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

type
TfrmMain = class(TForm)
MesText: TMemo;
btnExit: TBitBtn;
btnSend: TBitBtn;
Label1: TLabel;
Bevel1: TBevel;
Bevel2: TBevel;
Bevel3: TBevel;
Bevel4: TBevel;
AddrBox: TComboBox;
StatusBar1: TStatusBar;
procedure btnSendClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MesTextChange(Sender: TObject);
procedure AddrBoxChange(Sender: TObject);
procedure btnExitClick(Sender: TObject);
private
UserName : string;
MessageHeader : TStringList;
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation
uses about;

{$R *.DFM}


procedure TfrmMain.btnSendClick(Sender: TObject);
var
i, res: Integer;
begin
if AddrBox.Text <> '' then
begin
statusbar1.font.Color := clBlack;
Statusbar1.panels[0].text:= '正在连接，请稍待... ';
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.statusbar1.font.Color := clBlue
else
frmMain.statusbar1.font.Color := clRed;
case res of
0 : frmMain.Statusbar1.panels[0].text:= '消息已发送！';
87 : frmMain.Statusbar1.panels[0].text:= '参数错误';
123 : frmMain.Statusbar1.panels[0].text:= 'sintax is incorrect';
2273 : frmMain.Statusbar1.panels[0].text:= '找不到 '+frmMain.AddrBox.Text;
else frmMain.Statusbar1.panels[0].text:= '出错: '+IntToStr(res);
end;
end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
strUser : PChar;
strSize : DWord;
begin
strUser := StrAlloc(100);
strSize := 100;
GetUserName(strUser,strSize);
UserName := strUser;
StrDispose(strUser);
MessageHeader := TStringList.Create;
MessageHeader.Add('---------------------------------');
MessageHeader.Add(' 从 '+UserName);
MessageHeader.Add('---------------------------------');
statusbar1.Panels.Add;
end;


procedure TfrmMain.MesTextChange(Sender: TObject);
begin
Statusbar1.panels[0].text := ' ';
end;

procedure TfrmMain.AddrBoxChange(Sender: TObject);
begin
statusbar1.panels[0].text:= ' ';
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
close;
end;

end.