sendmsgunit.pas

该程序用D5编译

unit SendMsgUnit;

interface
uses Windows, SysUtils, Classes, ComCtrls, Dialogs;

{
ERROR_ACCESS_DENIED             The user does not have access to the requested information.
ERROR_INVALID_PARAMETER         The specified parameter is invalid.
ERROR_NOT_SUPPORTED             This network request is not supported.
NERR_NameNotFound               The user name could not be found.
NERR_NetworkError               A general failure occurred in the network hardware
}
//defnied in error.h
const ERROR_ACCESS_DENIED = 5;
const ERROR_INVALID_PARAMETER = 87;
const ERROR_NOT_SUPPORTED = 50;

//defnied in LMERR.H
const NERR_Success = 0;
const NERR_BASE = 2100;
const NERR_NameNotFound = (NERR_BASE+173); // The message alias could not be found on the network.
const NERR_NetworkError = (NERR_BASE+36);  // A general network error occurred.

//------------------------------------------------
type

  TSendMsgThread=class(TThread)
  private
    SendRet: DWORD;
    ErrMsg: string;
  protected
    procedure Execute; override;
    procedure ReturnResult;

    function SendMsg(Toh,From,Msg:string): DWORD;
    procedure ShowError;
  public
    ToHost, From, Msg: string;
    MyListItem: TListItem;
    OnResultEvent: TNotifyEvent;
  end;
//------------------------------------------------

function ToUnicode(str:string;dest:PWideChar):integer;
//function SendMsg(Toh,From,Msg:string):DWORD;

{
function NetMessageBufferSend(servername: LPCWSTR; msgname: LPCWSTR;
  fromname: LPCWSTR; buf: Pointer; buflen: DWORD): DWORD; stdcall;
}
                              
implementation

function ToUnicode(str:string;dest:PWideChar):integer;
var
  len:integer;
begin
  StringToWideChar(str,dest,len);
  Result:=len;
end;


//function NetMessageBufferSend; external 'netapi32.dll' name 'NetMessageBufferSend';

procedure TSendMsgThread.ShowError;
begin
  ShowMessage(ErrMsg);
end;

function TSendMsgThread.SendMsg(Toh,From,Msg:string): DWORD;
var
  ToName :array [0..64] of WideChar;
  WMsgText:array [0..1000] of WideChar;
  MsgLen, i:integer;

  DllHandle : HInst;
  SendFunc:  function(servername: LPCWSTR; msgname: LPCWSTR;
                fromname: LPCWSTR; buf: Pointer; buflen: DWORD): DWORD; stdcall;
begin
  for i := 0 to 64 do ToName[i] := #0;
  ToUnicode(Toh,ToName);
  for i := 0 to 1000 do WMsgText[i] := #0;
  ToUnicode(Msg,WMsgText);
  //Result:=NetMessageBufferSend(nil,ToName,nil,@WMsgText,MsgLen);

  // --采用动态加载的目的是为了在Win9x下程序启动时不报错。---------------
  DllHandle := LoadLibrary('netapi32.dll');
  if DllHandle = 0 then
  begin
    ErrMsg := '装载动态链接库(netapi32.dll)时出错，可能是因为您使用的是Win9x系统。';
    Synchronize(ShowError);
    Result := 0;
    Exit;
  end;
  @SendFunc := GetProcAddress(DllHandle, PChar('NetMessageBufferSend'));
  if (@SendFunc=nil) then
  begin
    ErrMsg := 'Get proc address error: NetMessageBufferSend';
    Synchronize(ShowError);
    FreeLibrary(DllHandle);
    Result := 0;
    Exit;
  end;
  Result := SendFunc(nil,ToName,nil,@WMsgText,MsgLen);
  // --------------------------------------------------------------------

end;

//--------------------------Thread-----------------
//var SendRet: DWORD;

procedure TSendMsgThread.ReturnResult;
var
  str: string;
begin

  //CopyMemory(@w,@SendRet,SizeOf(w));
  case SendRet of
    NERR_Success:               str := '成功';
    ERROR_ACCESS_DENIED:        str := '失败:The user does not have access to the requested information.';
    ERROR_INVALID_PARAMETER:    str := '失败:The specified parameter is invalid.';
    ERROR_NOT_SUPPORTED:        str := '失败:This network request is not supported.';
    NERR_NameNotFound:          str := '失败:The message alias could not be found on the network.';
    NERR_NetworkError:          str := '失败:A general failure occurred in the network hardware';
    else str := '失败';
  end; // end of case
  MyListItem.SubItems[1] := str;
  if assigned(OnResultEvent) then OnResultEvent(TObject(str));

end;

procedure TSendMsgThread.Execute;
begin
  SendRet := SendMsg(ToHost,From,Msg);
  Synchronize(ReturnResult);
end;

end.