AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi Net Send Mailslot selbst verarbeiten!
Thema durchsuchen
Ansicht
Themen-Optionen

Net Send Mailslot selbst verarbeiten!

Ein Thema von J Kadison · begonnen am 25. Aug 2009 · letzter Beitrag vom 2. Okt 2009
Antwort Antwort
alzaimar
(Moderator)

Registriert seit: 6. Mai 2005
Ort: Berlin
4.956 Beiträge
 
Delphi 2007 Enterprise
 
#1

Re: Net Send Mailslot selbst verarbeiten!

  Alt 26. Aug 2009, 06:56
Hier mal eine uralte Unit von mir, die Mails mit einer bekannten maximalen Länge verschicken kann:
Instanziiere einen TMailReceiver in den Anwendungen, die Mails empfangen sollen und weise das den 'SlotName' sowie das OnMailReceived-Ereignis zu. Starte den Receiver mit 'Start', beende ihn mit 'Stop'.

Verschicke eine Mail an einen Computer mit 'SendMail'. Wenn Du als Computernamen '*' angibst, wird die Mail an alle Rechner verschickt.

Die Unit ist gefühlte 79 Jahre alt und stammt noch aus den Anfängen meiner Delphi-Zeit. Ich würde mich freuen, wenn Jemand diese Unit auf Vordermann bringt und verbessert.

Delphi-Quellcode:
unit csMail;

interface
uses Classes;
Type
  TMailReceiveEvent = Procedure (Sender : TObject; aMessage : TStrings) of Object;
  TMailReceiver = Class (TThread)
  private
    fMaxLength : Integer;
    fHandle : THandle;
    fOnMail : TMailReceiveEvent;
    fMessage : String;
    fSlotName: String;
    procedure DoOnMailReceived;
  Protected
    Procedure Execute; Override;
  Public
    Constructor Create (aSlotName : String; aMaxLength : Integer);
    Destructor Destroy; Override;
    Procedure Start;
    Procedure Stop;
    Property OnMailReceived : TMailReceiveEvent Read fOnMail Write fOnMail;
    Property SlotName : String Read fSlotName;
    End;

Procedure SendMail (aComputer, aSlotName, aMessage : String);
Function CsGetComputerName:String;

implementation
uses windows, SysUtils;

Function CsGetComputerName:String;
var
  le: DWORD;

begin
   le:=63;
   SetLength(result,le);
   if GetComputerName(PChar(result),le) then
     SetLength(result, le)
   else
     result:= '??';
End;

///////////////////////////////////////////////////////////////////////////////
// SendMail: Send a Mail 'aMessage' to the Mailslot 'aSlotName' on the //
// Machine 'aComputer' //
///////////////////////////////////////////////////////////////////////////////
Procedure SendMail (aComputer, aSlotName, aMessage : String);
var
  Bytes: DWord;
  aPath : String;
  aHandle : THandle;

begin
  aPath := '\\' + aComputer + '\mailslot\' + aSlotName;
  aHandle := CreateFile(PChar(aPath), GENERIC_WRITE, FILE_SHARE_READ, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  try
    if aHandle = INVALID_HANDLE_VALUE then
      Raise EInOutError.CreateFmt('Cannot create mailslot %s\%s',[aComputer,aSlotName])
    else
      If not WriteFile(aHandle, Pointer(aMessage)^, Length(aMessage), Bytes, nil)
        Then Raise EInOutError.CreateFmt('Cannot write to mailslot %s\%s',[aComputer,aSlotName]);
  finally
    if aHandle <> INVALID_HANDLE_VALUE Then
      CloseHandle(aHandle);
    end;
end;

{ TMailReceiver }

///////////////////////////////////////////////////////////////////////////////
// Object : TMailReceiver //
///////////////////////////////////////////////////////////////////////////////
constructor TMailReceiver.Create(aSlotName : String; aMaxLength : Integer);
Var
  aPath : String;

begin
  Inherited Create (True);
  fSlotName := aSlotName;
  fMaxLength := aMaxLength;
  aPath := '\\.\mailslot\' + aSlotName;
  fHandle := CreateMailSlot(PChar(aPath), 0, MAILSLOT_WAIT_FOREVER, nil);
end;

destructor TMailReceiver.Destroy;
begin
  Terminate;
  CloseHandle (fHandle);
end;

procedure TMailReceiver.DoOnMailReceived;
Var
  s : TStringList;

begin
  if Assigned (fOnMail) And (Length (fMessage)>0 ) Then begin
    s := TStringList.Create;
    Try
      s.Text := fMessage;
      fOnMail (Self, s);
    Finally
      s.free
      end
    End;
end;

procedure TMailReceiver.Execute;
Var
  aSize : DWord;

begin
  While Not Terminated Do Begin
    SetLength (fMessage, fMaxLength);
    if ReadFile(fHandle, PChar(fMessage)^, fMaxLength, aSize, nil) Then
      If not terminated Then
        SetLength (fMessage, aSize);
    if not terminated then
      Synchronize (DoOnMailReceived);
    End
end;

procedure TMailReceiver.Start;
begin
  Resume;
end;

procedure TMailReceiver.Stop;
begin
  Try
    Terminate;
    SetMailslotInfo (fHandle,0);
  Except
    End;
end;

end.
"Wenn ist das Nunstruck git und Slotermeyer? Ja! Beiherhund das Oder die Flipperwaldt gersput!"
(Monty Python "Joke Warefare")
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:21 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz