Форум: "WinAPI";
Текущий архив: 2004.03.14;
Скачать: [xml.tar.bz2];

Вниз

Mailslot   Найти похожие ветки 

← →
TURKDL   (2004-01-07 19:43) [0]

Добрый вечер!!
помогите пожалуйства с считыванием из Mailslot"a !

---

← →
closer   (2004-01-07 23:14) [1]

Можно например так (используя потоки):


unit MailSlot;

{$DEFINE MAILSLOT_DEBUG}

interface
uses
Windows, Messages;

type
TMessageArray = array[0..424] of Byte;

TNewMessageEvent = procedure(const aData:TMessageArray; ReadBytes:Integer) of object;

TMailSlot = class
private
FMailSlotName: String;
FHandle:THandle;
FThreadHandle:THandle;
FOnNewMessage:TNewMessageEvent;

procedure ThreadFunc;
procedure SetMailSlotName(const Value: String);
public
destructor Destroy; override;

function WriteString(const aRemoteHost, aMailSlotName:String; aString: String):Boolean;
function WriteData(const aRemoteHost, aMailSlotName:String; const aData; aDataSize:Word):Boolean;
function OpenMailslot:Boolean;
procedure CloseMailslot;

property MailSlotName:String read FMailSlotName write SetMailSlotName;
property OnNewMessage:TNewMessageEvent read FOnNewMessage write FOnNewMessage;
end;

implementation

{$IFDEF MAILSLOT_DEBUG}
var
ModuleName:String;
{$ENDIF}

function ThreadFunc(aParam:Pointer):Integer;
begin
TMailSlot(aParam).ThreadFunc;
Result:=0;
end;

{ TMailSlot }

destructor TMailSlot.Destroy;
begin
CloseMailslot;
inherited;
end;

procedure TMailSlot.ThreadFunc;
var
LocalBuffer:TMessageArray;
ReadBytes:Cardinal;
begin
while True do
begin
if ReadFile(FHandle, LocalBuffer, SizeOf(LocalBuffer), ReadBytes, nil) then
if Assigned(FOnNewMessage) then
FOnNewMessage(LocalBuffer, ReadBytes);
end;
end;

function TMailSlot.OpenMailslot;
var
ThreadId:Cardinal;
begin
Result:=False;
if FHandle=0 then
begin
FHandle:=CreateMailslot(PChar("\\.\mailslot\"+FMailSlotName), 0, 100{MAILSLOT_WAIT_FOREVER}, nil);
if FHandle<>INVALID_HANDLE_VALUE then
begin
FThreadHandle:=BeginThread(nil, 0, @MailSlot.ThreadFunc, Pointer(Self), 0, ThreadId);
if FThreadHandle<>0 then
Result:=True;
{$IFDEF MAILSLOT_DEBUG}
if FThreadHandle=0 then
MessageBox(0,"Ошибка при создании потока для MailSlot...",PChar("Ошибка в "+ModuleName),MB_OK);
{$ENDIF}

end;
{$IFDEF MAILSLOT_DEBUG}
if FHandle=INVALID_HANDLE_VALUE then
MessageBox(0,"Ошибка при открытии MailSlot...",PChar("Ошибка в "+ModuleName),MB_OK);
{$ENDIF}
end;
end;

procedure TMailSlot.CloseMailslot;
begin
if FHandle<>0 then
begin
CloseHandle(FHandle);
FHandle:=0;
end;
if FThreadHandle<>0 then
begin
CloseHandle(FThreadHandle);
FThreadHandle:=0;
end;
end;

procedure TMailSlot.SetMailSlotName;
begin
FMailSlotName:=Value;
if FHandle<>0 then
begin
CloseMailslot;
OpenMailslot;
end;
end;

function TMailSlot.WriteString;
var
h_slot:THandle;
BytesWritten:Cardinal;
begin
Result:=False;
h_slot:=CreateFile(PChar("\\"+aRemoteHost+"\mailslot\"+aMailSlotName),
GENERIC_WRITE,
FILE_SHARE_READ,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);

if h_slot<>INVALID_HANDLE_VALUE then
begin
BytesWritten:=0;
aString:=aString+#0;
if WriteFile(h_slot, PChar(aString)^, Length(aString), BytesWritten, nil) and
(LongInt(BytesWritten)=Length(aString)) then Result:=True;
{$IFDEF MAILSLOT_DEBUG}
if BytesWritten=0 then
MessageBox(0,"Ошибка при записи комманды в MailSlot...",PChar("Ошибка в "+ModuleName),MB_OK);
{$ENDIF}
CloseHandle(h_slot);
end;
{$IFDEF MAILSLOT_DEBUG}
if h_slot=INVALID_HANDLE_VALUE then
MessageBox(0,"Ошибка при отправки комманды на MailSlot...",PChar("Ошибка в "+ModuleName),MB_OK);
{$ENDIF}
end;

function TMailSlot.WriteData;
var
h_slot:THandle;
BytesWritten:Cardinal;
begin
Result:=False;
h_slot:=CreateFile(PChar("\\"+aRemoteHost+"\mailslot\"+aMailSlotName),
GENERIC_WRITE,
FILE_SHARE_READ,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);

if h_slot<>INVALID_HANDLE_VALUE then
begin
BytesWritten:=0;
if WriteFile(h_slot, aData, aDataSize, BytesWritten, nil) and
(LongInt(BytesWritten)=aDataSize) then Result:=True;
{$IFDEF MAILSLOT_DEBUG}
if BytesWritten=0 then
MessageBox(0,"Ошибка при записи комманды в MailSlot...",PChar("Ошибка в "+ModuleName),MB_OK);
{$ENDIF}
CloseHandle(h_slot);
end;
{$IFDEF MAILSLOT_DEBUG}
if h_slot=INVALID_HANDLE_VALUE then
MessageBox(0,"Ошибка при отправки комманды на MailSlot...",PChar("Ошибка в "+ModuleName),MB_OK);
{$ENDIF}
end;

{$IFDEF MAILSLOT_DEBUG}
var
S:array[0..255] of Char;

initialization
GetModuleFileName(HInstance,S,SizeOf(S));
ModuleName:=S;
finalization
{$ENDIF}

end.


================================================================

или так (используя таймер), перед использованием MailSlot вызываешь OpenCmdSlot, а после использования CloseCmdSlot:


procedure NewMessage(const aData:TMessageArray);
begin
// Здесь что нить делаешь со получеными данными
end;

////////////////////////////////////////////////////////////////////////////////

var
CmdSlotHandle:THandle=0;
TimerHandle:THandle=0;

procedure ReadMessage(Handle:THandle; Msg:Cardinal; IdEvent:Cardinal; Time:DWord); cdecl;
var
LocalBuffer:TMessageArray;
ReadBytes:Cardinal;
NextSize:Cardinal;
begin
if GetMailslotInfo(CmdSlotHandle, nil, NextSize, nil, nil) and (NextSize<>MAILSLOT_NO_MESSAGE) then
if ReadFile(CmdSlotHandle, LocalBuffer, SizeOf(LocalBuffer), ReadBytes, nil) then
NewMessage(LocalBuffer);
end;

function OpenCmdSlot;
begin
LocalCmdSlot:=SlotName;
Result:=False;
if CmdSlotHandle=0 then
begin
CmdSlotHandle:=CreateMailslot(PChar("\\.\mailslot\"+SlotName), 0, 1, nil);
if CmdSlotHandle<>INVALID_HANDLE_VALUE then
begin
TimerHandle:=SetTimer(0,0,100,@ReadMessage);
if TimerHandle<>0 then
Result:=True;
end;
end;
end;

procedure CloseCmdSlot;
begin
if CmdSlotHandle<>0 then
begin
KillTimer(0, TimerHandle);

// Ждём пока закроется таймер
WaitForSingleObject(TimerHandle,INFINITE);

CloseHandle(CmdSlotHandle);
CmdSlotHandle:=0;
end;
end;



================================================================

P.S.
Кажется на www.torry.net есть компонент который работаем с MailSlot, можешь посмотреть его.

---

Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.03.14;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.01 c