tpsystools_4.04/source/StNetMsg.pas

// Upgraded to Delphi 2009: Sebastian Zierer

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StNetMsg.pas 4.04                           *}
{*********************************************************}
{* SysTools: Net Message Class                           *}
{*********************************************************}

{$I StDefine.inc}

{$H+} {Huge strings}

unit StNetMsg;

interface

uses
  Windows, Classes, StBase;

type
  TStNetMessage = class(TStComponent)
   private   { Private Methods/Properties   }
    FAliasNames    : TStringList;
    FMsgFrom       : string;
    FMsgText       : string;
    FMsgTo         : string;
    FServerName    : string;
    FOnMessageSent : TNotifyEvent;
   protected { Protected Methods/Properties }
    function GetServer: string;
    procedure SetServer(Value: string);

   public    { Public Methods/Properties    }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    procedure AddAlias(AName: string);
    function AliasNames: TStringList;
    procedure RemoveAlias(AName: string);
    procedure Send;
   published { Published Methods/Properties }
    property MsgFrom: string
      read FMsgFrom  write FMsgFrom;
    property MsgText: string
      read FMsgText  write FMsgText;
    property MsgTo  : string
      read FMsgTo    write FMsgTo;
    property Server : string
      read GetServer write SetServer;
    property OnMessageSent: TNotifyEvent
      read FOnMessageSent write FOnMessageSent;
  end;

implementation

uses SysUtils, StStrL, StNetApi,
  Dialogs;

constructor TStNetMessage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAliasNames := TStringList.Create;
end;

destructor TStNetMessage.Destroy;
begin
  FAliasNames.Free;

  inherited Destroy;
end;

procedure TStNetMessage.AddAlias(AName: string);
var
  ErrorD : DWord;
begin
  ErrorD := StNetMessageNameAdd(FServerName, AName);
  if ErrorD <> NERR_SUCCESS then
    RaiseStWin32Error(EStNetException, ErrorD);
end;

function TStNetMessage.AliasNames: TStringList;
var
  ErrorD : DWord;
  Buffer : Pointer;
  TotalEntries : DWord;
  EntriesRead : DWord;
  I : Integer;
begin
  ErrorD := StNetMessageNameEnum(FServerName, 0, Buffer, DWord(-1),
                                 EntriesRead, TotalEntries, nil);
  if ErrorD = NERR_SUCCESS then begin
    FAliasNames.Clear;
    for I := 0 to EntriesRead-1 do begin
      FAliasNames.Add(TMsgInfo0Array(Buffer^)[I].msgi0_name);
    end;
    StNetApiBufferFree(Buffer);
  end else begin
    RaiseStWin32Error(EStNetException, ErrorD);
  end;
  Result := FAliasNames;
end;

procedure TStNetMessage.RemoveAlias(AName: string);
var
  ErrorD : DWord;
begin
  ErrorD := StNetMessageNameDel(FServerName, AName);
  if ErrorD <> NERR_SUCCESS then
    RaiseStWin32Error(EStNetException, ErrorD);
end;

procedure TStNetMessage.Send;
var
  ErrorD : DWord;
  Buffer : TLMWideChar;
begin
  Buffer.Value := nil;
  try
    CvtToWideChar(FMsgText, Buffer);

    ErrorD := StNetMessageBufferSend(FServerName, FMsgTo, FMsgFrom,
                                     Buffer.Value, Buffer.Length);
    if ErrorD <> NERR_SUCCESS then
      RaiseStWin32Error(EStNetException, ErrorD)
    else
      if Assigned(FOnMessageSent) then FOnMessageSent(Self);
  finally
    FreeMem(Buffer.Value, Buffer.Length);
  end;
end;

function TStNetMessage.GetServer: string;
begin
  { don't return any UNC notation }
  Result := FilterL(FServerName, '\');
end;

procedure TStNetMessage.SetServer(Value: string);
begin
  { get rid of any UNC notation or trailing marks }
  Value := FilterL(Value, '\');

  { do we have a valid server name? }
  if (Length(Value) > 0) then

    if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
      FServerName := Value
    else
      FServerName := '\\' + Value
  else
    FServerName := Value;
end;


end.
1	// Upgraded to Delphi 2009: Sebastian Zierer
2
3	(* *** BEGIN LICENSE BLOCK ***
4	* Version: MPL 1.1
5	*
6	* The contents of this file are subject to the Mozilla Public License Version
7	* 1.1 (the "License"); you may not use this file except in compliance with
8	* the License. You may obtain a copy of the License at
9	* http://www.mozilla.org/MPL/
10	*
11	* Software distributed under the License is distributed on an "AS IS" basis,
12	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13	* for the specific language governing rights and limitations under the
14	* License.
15	*
16	* The Original Code is TurboPower SysTools
17	*
18	* The Initial Developer of the Original Code is
19	* TurboPower Software
20	*
21	* Portions created by the Initial Developer are Copyright (C) 1996-2002
22	* the Initial Developer. All Rights Reserved.
23	*
24	* Contributor(s):
25	*
26	* *** END LICENSE BLOCK *** *)
27
28	{*********************************************************}
29	{* SysTools: StNetMsg.pas 4.04 *}
30	{*********************************************************}
31	{* SysTools: Net Message Class *}
32	{*********************************************************}
33
34	{$I StDefine.inc}
35
36	{$H+} {Huge strings}
37
38	unit StNetMsg;
39
40	interface
41
42	uses
43	Windows, Classes, StBase;
44
45	type
46	TStNetMessage = class(TStComponent)
47	private { Private Methods/Properties }
48	FAliasNames : TStringList;
49	FMsgFrom : string;
50	FMsgText : string;
51	FMsgTo : string;
52	FServerName : string;
53	FOnMessageSent : TNotifyEvent;
54	protected { Protected Methods/Properties }
55	function GetServer: string;
56	procedure SetServer(Value: string);
57
58	public { Public Methods/Properties }
59	constructor Create(AOwner : TComponent); override;
60	destructor Destroy; override;
61
62	procedure AddAlias(AName: string);
63	function AliasNames: TStringList;
64	procedure RemoveAlias(AName: string);
65	procedure Send;
66	published { Published Methods/Properties }
67	property MsgFrom: string
68	read FMsgFrom write FMsgFrom;
69	property MsgText: string
70	read FMsgText write FMsgText;
71	property MsgTo : string
72	read FMsgTo write FMsgTo;
73	property Server : string
74	read GetServer write SetServer;
75	property OnMessageSent: TNotifyEvent
76	read FOnMessageSent write FOnMessageSent;
77	end;
78
79	implementation
80
81	uses SysUtils, StStrL, StNetApi,
82	Dialogs;
83
84	constructor TStNetMessage.Create(AOwner: TComponent);
85	begin
86	inherited Create(AOwner);
87	FAliasNames := TStringList.Create;
88	end;
89
90	destructor TStNetMessage.Destroy;
91	begin
92	FAliasNames.Free;
93
94	inherited Destroy;
95	end;
96
97	procedure TStNetMessage.AddAlias(AName: string);
98	var
99	ErrorD : DWord;
100	begin
101	ErrorD := StNetMessageNameAdd(FServerName, AName);
102	if ErrorD <> NERR_SUCCESS then
103	RaiseStWin32Error(EStNetException, ErrorD);
104	end;
105
106	function TStNetMessage.AliasNames: TStringList;
107	var
108	ErrorD : DWord;
109	Buffer : Pointer;
110	TotalEntries : DWord;
111	EntriesRead : DWord;
112	I : Integer;
113	begin
114	ErrorD := StNetMessageNameEnum(FServerName, 0, Buffer, DWord(-1),
115	EntriesRead, TotalEntries, nil);
116	if ErrorD = NERR_SUCCESS then begin
117	FAliasNames.Clear;
118	for I := 0 to EntriesRead-1 do begin
119	FAliasNames.Add(TMsgInfo0Array(Buffer^)[I].msgi0_name);
120	end;
121	StNetApiBufferFree(Buffer);
122	end else begin
123	RaiseStWin32Error(EStNetException, ErrorD);
124	end;
125	Result := FAliasNames;
126	end;
127
128	procedure TStNetMessage.RemoveAlias(AName: string);
129	var
130	ErrorD : DWord;
131	begin
132	ErrorD := StNetMessageNameDel(FServerName, AName);
133	if ErrorD <> NERR_SUCCESS then
134	RaiseStWin32Error(EStNetException, ErrorD);
135	end;
136
137	procedure TStNetMessage.Send;
138	var
139	ErrorD : DWord;
140	Buffer : TLMWideChar;
141	begin
142	Buffer.Value := nil;
143	try
144	CvtToWideChar(FMsgText, Buffer);
145
146	ErrorD := StNetMessageBufferSend(FServerName, FMsgTo, FMsgFrom,
147	Buffer.Value, Buffer.Length);
148	if ErrorD <> NERR_SUCCESS then
149	RaiseStWin32Error(EStNetException, ErrorD)
150	else
151	if Assigned(FOnMessageSent) then FOnMessageSent(Self);
152	finally
153	FreeMem(Buffer.Value, Buffer.Length);
154	end;
155	end;
156
157	function TStNetMessage.GetServer: string;
158	begin
159	{ don't return any UNC notation }
160	Result := FilterL(FServerName, '\');
161	end;
162
163	procedure TStNetMessage.SetServer(Value: string);
164	begin
165	{ get rid of any UNC notation or trailing marks }
166	Value := FilterL(Value, '\');
167
168	{ do we have a valid server name? }
169	if (Length(Value) > 0) then
170
171	if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
172	FServerName := Value
173	else
174	FServerName := '\\' + Value
175	else
176	FServerName := Value;
177	end;
178
179
180	end.