Thema: Delphi Net Send ohne Absender

Einzelnen Beitrag anzeigen

Delphi Star

Registriert seit: 4. Apr 2004
432 Beiträge
 
Delphi 2005 Personal
 
#41

Re: Net Send ohne Absender

  Alt 5. Apr 2004, 09:24
Es funzt immer noch nicht, also ich habe einen neuen Button erstellt, dann habe ich meinen Code durch den von Matze ersetzt, danach hab ich dann im Objektinspektor des Buttons bei OnClick Button1Click aus der Liste ausgewählt.

So sieht mein Source bis jetzt aus:

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

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('10.0.0.70', 'Ist eh egal', 'DerAbsender', 'Die Nachricht');
end;

end.


[edit=Sharky]Code-Tags durch Delphi-Tags ersetzt. Mfg, Sharky[/edit]
Real programmers code in binary
SwapIt: Punkte
  Mit Zitat antworten Zitat