Thema: Delphi Net Send ohne Absender

Einzelnen Beitrag anzeigen

Benutzerbild von Matze
Matze
(Co-Admin)

Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.929 Beiträge
 
Turbo Delphi für Win32
 
#40

Re: Net Send ohne Absender

  Alt 4. Apr 2004, 20:22
Löschen kannst du deine Beiträge nicht, wo kämen wir denn dahin!

Es wäre sinnvill, wenn du in Zukunft den Code posten könntest, denn du bereits selber zusammengestellt hast (mit den Delphi-Tags).

Heute bin ich mal nicht so, so geht's:

Delphi-Quellcode:
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    function NetMessageBufferSendSubstA(ServerName, MsgName, FromName, Msg: AnsiString): Boolean;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.NetMessageBufferSendSubstA(ServerName, MsgName, FromName, Msg: AnsiString): Boolean;
{.$DEFINE SYNCHRONOUS}
const
  szService = '\mailslot\messngr';
  MaxBufLen = $700;
var
  hFile: THandle;
  WrittenBytes: DWORD;
{$IFNDEF SYNCHRONOUS} 
  ovs: OVERLAPPED;
  EventName:String;
{$ENDIF} 
begin
  Result := False;
  if Length(Msg) > MaxBufLen then
    SetLength(Msg, MaxBufLen);
{$IFNDEF SYNCHRONOUS} 
  EventName:='NetSendEvent_'+ServerName;
{$ENDIF} 
  ServerName := '\\' + Servername + szService;
  hFile := CreateFileA(
    @ServerName[1], GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL or FILE_FLAG_NO_BUFFERING or FILE_FLAG_OVERLAPPED, 0);
  if hFile <> INVALID_HANDLE_VALUE then
  try
    Msg := FromName + #0 + MsgName + #0 + Msg;
{$IFNDEF SYNCHRONOUS} 
    ovs.hEvent := CreateEventA(nil, True, False, @EventName[1]);
    WriteFile(hFile, Pointer(Msg)^, Length(Msg), WrittenBytes, @ovs);
{$ELSE}
    WriteFile(hFile, Pointer(Msg)^, Length(Msg), WrittenBytes, nil);
{$ENDIF} 
    Result := GetLastError = ERROR_IO_PENDING;
  finally
{$IFNDEF SYNCHRONOUS}
    if WaitForSingleObject(ovs.hEvent, INFINITE) <> WAIT_TIMEOUT then
{$ENDIF}
      CloseHandle(hFile);
  end;
end;

//Aufruf:
procedure TForm1.Button1Click(Sender: TObject);
begin
  NetMessageBufferSendSubstA(...);
end;
  Mit Zitat antworten Zitat