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	torben	2671	// 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.