消息发送的问题

[yanweidong1030]

大家帮我看一下以下的这个发送代码。为什么接收不到呢？
——————————————————————————————————————
procedure HKSendread.Execute;
begin
Self.NetSend('newp4','127.0.0.1','哈哈');
end;

function HKSendread.NetSend(dest, Source, Msg: string): Longint;
type
TNetMessageBufferSendFunction = function(servername, msgname, fromname: PWideChar;
buf: PWideChar; buflen: Cardinal): Longint;
stdcall;
var
NetMessageBufferSend: TNetMessageBufferSendFunction;
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;

[李乐宁]

哈哈，看不懂，还是帮你顶吧！

[flyforlove]

信使服务开着没？开了以后，你运行以下net send 127.0.0.1 hello
看能不能收到。

[txmjs]

给你一个消息发送的,你可以参考一下.
procedure TForm1.Button1Click(Sender: TObject);
var
CmdLine: string;
begin
CmdLine:='cmd /c "net send '+Edit1.Text+' '+Edit2.Text+'"';
winexec(pchar(CmdLine),SW_HIDE);
end;

[txmjs]

Edit1.text中添入IP.
Edit2.text中添入要发送的内容

[yanweidong1030]

我不想用net send 来发送。
因为这种方式发送出去不会返回参数。我也就没有办法知道是否发送成功。


我的这个程序是一个多线程的使用了API中的发送函数

[whitetiger8]

我给你一个例子吧。发的程序是：
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
procedure WndProc(var Message: TMessage); override;
{ Public declarations }
end;

const UserMessageStr = 'testmsg';
var
Form1: TForm1;
UserWindowHandle : THandle = 0;
UserMessage : UINT;
implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.WndProc(var Message: TMessage);
begin
if(Message.Msg = UserMessage) and (Message.wParam <> Handle) then
begin // 客户发过来的消息
UserWindowHandle := Message.wParam;
ReplyMessage(0); // 回应消息 , 因为SendMessage是一个阻塞函数,就是要等回应后才继续执行
end;
inherited;
end;


procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
ds: TCopyDataStruct; // WM_COPYDATA所需要的结构
str : string;
begin
if UserWindowHandle = 0 then
begin
SendMessage(HWND_BROADCAST,UserMessage,handle,0); // 进行广播
i:=1;
while(i<=20) and (UserWindowHandle=0) do
begin
label3.caption := '正在连接用户程序,已试'+inttostr(i)+'次';
application.ProcessMessages;
sleep(100);
i := i+1;
end;
if UserWindowHandle=0 then //等待回应失败
begin
Showmessage('连接用户程序失败');
exit;
end;
// 已经连接到用户程序
label3.caption := '连接用户程序成功!';
application.ProcessMessages;
end;
str := edit1.text;
ds.cbData := Length (str) + 1;
GetMem (ds.lpData, ds.cbData ); //为传递的数据区分配内存
StrCopy (ds.lpData, PChar (str));
SendMessage(UserWindowHandle,WM_COPYDATA,handle,Cardinal(@ds)); // 已经连接过,直接发消息
freemem(ds.lpdata);
label3.caption := '已经发送!';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
UserMessage := RegisterWindowMessage(UserMessageStr); // 注册消息
end;

end.

[whitetiger8]

接收的　
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
procedure WndProc(var Message: TMessage); override;
procedure Mymessage(var t:TWmCopyData);message WM_COPYDATA;
{ Public declarations }
end;

const UserMessageStr = 'testmsg';
var
Form1: TForm1;
UserWindowHandle : THandle = 0;
UserMessage : UINT;

implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.WndProc(var Message: TMessage);
begin
if(Message.Msg = UserMessage) and (Message.wParam <> Handle) then
begin // 对方发过来的消息
UserWindowHandle := Message.wParam;
ReplyMessage(0); // 回应消息
SendMessage(UserWindowHandle, UserMessage, Handle, 1);
end;
inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
UserMessage := RegisterWindowMessage(UserMessageStr); // 注册消息
end;

procedure TForm1.Mymessage(var t: TWmCopyData);
var str : string;
begin
if t.From = UserWindowHandle then // 确认是从对方发过来的
begin
str := strpas(t.CopyDataStruct^.lpData);
ReplyMessage(1);
Edit1.text := str;
end;
end;

end.

[「已注销」]

procedure HKSendread.Execute;
begin
Self.NetSend('newp4','127.0.0.1','哈哈');
end;
要修改为
procedure HKSendread.Execute;
begin
Self.NetSend(要发送机器IP或机器名,必须是本机的机器名而不能是IP,'哈哈');
end;

[「已注销」]

楼主结帖吧

[flyforlove]

楼上这位，还不知道问题是什么就稀里糊涂的贴了一大堆代码。
贴串了吧。
建议以后不要同时打开那么多帖子。