unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, jpeg;
type
TForm1 =
class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Timer1: TTimer;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Label2: TLabel;
Edit3: TEdit;
Label3: TLabel;
Edit5: TEdit;
Label4: TLabel;
Edit4: TEdit;
Label5: TLabel;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
i: integer;
implementation
{$R *.dfm}
type
TServerBrowseDialogA0 =
function(hwnd: HWND; pchBuffer: pointer; cchBufSize:
DWord): bool;
stdcall;
var
ServerBrowseDialogA0: TServerBrowseDialogA0 =
nil;
function LoadLanManDLL: Boolean;
var
LANMAN_DLL: THandle;
begin
result := True;
LANMAN_DLL := GetModuleHandle('
NTLANMAN.DLL');
if LANMAN_DLL = 0
then
LANMAN_DLL := LoadLibrary('
NTLANMAN.DLL');
if LANMAN_DLL <> 0
then
begin
@ServerBrowseDialogA0 := GetProcAddress(LANMAN_DLL, '
ServerBrowseDialogA0');
if @ServerBrowseDialogA0 =
nil then
result := False;
end;
end;
function NetMsgSend(
const ServerName, MsgName, FromName, Msg: WideString): Integer;
function WC(
const Name: WideString): PWideChar;
begin
if Name = '
'
then Result :=
nil
else Result := PWideChar(
Name);
end;
var
NetLib: THandle;
NetMessageBufferSend:
function(ServerName, MsgName, FromName: PWideChar;
Buffer: PWideChar; BufferLen: DWord): Integer;
stdcall;
begin
Result := -1;
NetLib := LoadLibrary('
NETAPI32.DLL');
if NetLib <> 0
then
try
@NetMessageBufferSend := GetProcAddress(NetLib, '
NetMessageBufferSend');
if Assigned(NetMessageBufferSend)
then
Result := NetMessageBufferSend(WC(ServerName), WC(MsgName), WC(FromName),
Pointer(Msg), Length(Msg) * 2);
finally
FreeLibrary(NetLib);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
NetMsgSend('
', edit1.text, edit2.text, edit3.text);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
NetMsgSend('
', edit1.text, edit2.text, edit3.text);
i := i+1;
edit5.text := Inttostr(i);
if edit5.text = edit4.Text
then begin
timer1.Enabled := false;
i := 0;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
timer1.Enabled := true;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Buffer:
array[0..1024]
of Char;
s:
String;
begin
if LoadLanManDLL
then
begin
if not ServerBrowseDialogA0(
Handle, @Buffer, sizeof(Buffer))
then
begin
s := copy(
string(Buffer), 3, length(
string(Buffer)));
edit1.text := s;
end;
end;
end;
end.