Message

← →
pkm (2004-09-07 19:26) [0]

Доброе время суток. Подскажите с помощью каких процедур и функций в Delphi можно написать программку, отправляющие сообщения на другие компьютеры находящиеся в сети. Спасибо за внимание.

← →
Rouse_ © (2004-09-07 20:29) [1]

NetMessageBuferSend или мэйлслоты или ShellExecute(WinExec) с использованием "net send /?"

← →
dr Tr0jan (2004-09-08 09:15) [2]

А как экспортировать NetMessageBufferSend (ИМХО, это надо делать из netapi32.dll)?

← →
Rouse_ © (2004-09-08 09:41) [3]

function NetMessageBufferSend(servername: LPCWSTR; msgname: LPCWSTR; fromname: LPCWSTR; buf: Pointer; buflen: DWORD): DWORD; stdcall; external "NETAPI32.DLL";

← →
Дмитрий Ботвин (2004-09-08 10:56) [4]

Вот тебе работающий модуль:

unit Unit6;

interface

uses
Windows, SysUtils, Forms, StdCtrls,
ExtCtrls, Classes, Controls;

type
TForm6 = class(TForm)
SendButton: TButton;
SendText: TEdit;
Label1: TLabel;
SendUser: TEdit;
Label2: TLabel;
Label3: TLabel;
procedure SendTextChange(Sender: TObject);
procedure SendButtonClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form6: TForm6;

implementation

{$R *.dfm}

Uses Unit1,Winsvc,lm;

//Доступность отпарвки сообщений
procedure TForm6.SendTextChange(Sender: TObject);
begin
if Length(SendText.Text)<>0 then SendButton.Enabled:=true
else SendButton.Enabled:=false;
end;

//Отправка сообщения
procedure TForm6.SendButtonClick(Sender: TObject);
var i: integer;
SList: TStringList;
Msg: String;
HostName,MessageName: WideString;
buflen: DWORD;
error: NET_API_STATUS;
begin
if Length(SendUser.Text)=0 then
begin
Application.MessageBox("Не указан пользователь, от имени которого отправляем!","Ошибка",MB_OK+MB_ICONSTOP);
exit;
end;
if Length(Form1.CompName.Text)<>0 then
begin
HostName:=WideString(Trim(Form1.CompName.Text));
MessageName:=WideString(Trim(SendText.Text));
buflen:=200;
error:=NetMessageBufferSend(nil,PWideChar(HostName),PWideChar(WideString(Trim(SendUser.Text))),PWideChar(MessageName),bu flen);
if error=NERR_Success then Application.MessageBox("Сообщение успешно отправлено!","Отправка сообщений",MB_OK+MB_ICONINFORMATION)
else Application.MessageBox("Сообщение не отправлено!"+#13#10+"Проверьте состояние службы сообщений","Отправка сообщений",MB_OK+MB_ICONSTOP);
Form6.Close;
end
else
begin
SList:=TStringList.Create;
for i:=0 to Form1.Computers.Items.Count-1 do
begin
HostName:=WideString(Trim(Form1.Computers.Items[i].Caption));
MessageName:=WideString(Trim(SendText.Text));
buflen:=200;
error:=NetMessageBufferSend(nil,PWideChar(HostName),PWideChar(WideString(Trim(SendUser.Text))),PWideChar(MessageName),bu flen);
if error<>NERR_Success then SList.Add(Form1.Computers.Items[i].Caption);
Label3.Caption:="Отправлено собщение на "+IntToStr(i+1)+" из "+IntToStr(Form1.Computers.Items.Count);
Application.ProcessMessages;
end;
if SList.Count=0 then Application.MessageBox("Сообщение успешно отправлено на все компьютеры!","Отправка сообщений",MB_OK+MB_ICONINFORMATION)
else
begin
for i:=0 to SList.Count-1 do
if i<SList.Count-1 then Msg:=Msg+SList.Strings[i]+", "
else Msg:=Msg+SList.Strings[i];
Application.MessageBox(PChar("Не смог отправить сообщение на следующие компьютеры: "+Msg),"Отправка сообщений",MB_OK+MB_ICONEXCLAMATION)
end;
Form6.Close;
end;
end;

//Текущий прользователь
function GetUserFromWindows: string;
Var
UserName : string;
UserNameLen : Dword;
Begin
UserNameLen := 50;
SetLength(userName, UserNameLen);
If GetUserName(PChar(UserName), UserNameLen) Then
Result := Copy(UserName,1,UserNameLen - 1)
Else Result := "Unknown";
End;

//Управление заголовком
procedure TForm6.FormShow(Sender: TObject);
begin
if Length(Form1.CompName.Text)=0 then Form6.Caption:="Отправка сообщения на "+IntToStr(Form1.Computers.Items.Count)+" комьютер(а)(ов)"
else Form6.Caption:="Отправка сообщения на "+Trim(Form1.CompName.Text);
SendUser.Text:=GetUserFromWindows;
end;

end.

← →
Artin (2004-09-08 17:05) [5]

Кочай исходники.
http://www.verf.ru/delphi/get.php?arts/netsendD7.zip
ЗЫ
Думаю что у тебя она откроется с ошибкой, удаляй всё что вызывает ошибки. Всё работает !
Если запустишь с параметром то параметр и будет твоё имя!
NetSend.exe Имя

Message Найти похожие ветки