*
* Простецкий сетевой чат
*
* Запускаем его на кадой машине 
* Метод - SendMsg - форма для отправки сообщения
* указывается имя компьютера без \\ 
* длина сообщения не более 425 - ограницение mailslot
* для пытливых умов - пожалуйста msdn
* 
* При получении сообщения окно само выпрыгивает
*
* Ввиду своей тупости - сообщения уходят даже на несуществуюцие
* компьютеры
* 
* Остальное - острые края обработать напильником


#define MYSLOT		"\myslot"


#Define GENERIC_READ                     (0x80000000)
#Define GENERIC_WRITE                    (0x40000000)

#Define FILE_SHARE_READ                 0x00000001
#Define FILE_SHARE_WRITE                0x00000002
#Define FILE_SHARE_DELETE               0x00000004

#Define FILE_ATTRIBUTE_NORMAL           0x00000080

#Define MAILSLOT_NO_MESSAGE             0xFFFFFFFF
#Define MAILSLOT_WAIT_FOREVER           0xFFFFFFFF

#Define OPEN_EXISTING       3

Public goPager
goPager=CreateObject("MailSlot")
gopager.Wait()


Define Class Mailslot As Custom
	hMailSlot=-1

	Add Object Timer as Timer  with interval=200

	Procedure Read
	* Чтение сообщения из слота
	* Возвращает строку сообщения 
	* При ошибке - возвращает пустую строку

	With this
		If .hMailSlot > 0 && Слот создан
			Local nSize
			nSize=0
			If .GetInfo(@nSize) > 0
				Local buffer, read, h
				read=0
				buffer=Replicate(Chr(0),nSize)
				h=ReadFile(.hMailSlot,@buffer,Len(buffer),@read,0)
				If h = 0
	*				=MessageBox("Ошибка при чтении сообщения",64,_screen.Caption)
					Return ""
				Else
					Return Left(buffer,read)
				EndIf			
			EndIf			
		EndIf
		Return ""
	EndWith


	Procedure Send(m.cComputerName, m.cMsg)
	* Отправка сообщения m.cMsg на компьютер m.cComputerName
	* Возвращает кол-во отправленных байт
	* При ошибке - возвращает 0
	With this
		if Len(m.cMsg)> 425
			=MessageBox("Размер сообщение слишком велик",64,_screen.Caption)
			Return 0
		EndIf

		Local h, buffer, written, ret

		h=CreateFile;
			('\\'+m.cComputerName+'\mailslot'+MYSLOT;
			,GENERIC_WRITE;
			,FILE_SHARE_READ;
			,0;
			,OPEN_EXISTING;
			,FILE_ATTRIBUTE_NORMAL;
			,0)

		If h < 0
			=MessageBox("Не могу отправить сообщение.",64,_Screen.Caption)
			Return 0
		EndIf

		buffer=m.cMsg
		written=0

		ret=WriteFile(h,@buffer,Len(buffer),@written,0)
		CloseHandle(h)
		If ret = 0
			=MessageBox("Ошибка при отправке сообщения",64,_screen.Caption)

			Return 0
		EndIf
		Return written
	EndWith

	
	Procedure GetInfo(nMsgSize)
	* Провека наличия сообщения в почтовом ящике
	* Возвращает кол-во сообшений
	* Параметр nMsgSize - передается по ссылке и возвращает
	* размер первого непрочитанного сообщения
	With this
		If .hMailSlot > 0	&& Если слот создан
			Local h, nSizeNextMsg, nMsgCount
			nSizeNextMsg=0
			nMsgCount=0

			h=GetMailslotInfo;
				(.hMailSlot;
				,0;
				,@nSizeNextMsg;
				,@nMsgCount;
				,0)

			If h=0
				=MessageBox("Ошибка при получении информации о полученных сообщениях",64,_screen.Caption)
				Return 0
			EndIf
			If nMsgCount=0
				* Сообщений нет
				Return 0
			EndIf	
			nMsgSize=nSizeNextMsg
			Return nMsgCount
		Else
			Return 0
		EndIf
	EndWith

	Procedure Wait
	* Цикл ожидания сообщения
	With this
		If .GetInfo() > 0
			Local x, s
			s=.Read()
			If not Empty(s)
				PlaySound("MailBeep",0,1)
				x=CreateObject("ShowMsgForm")
				x.text.value=s
				x.show(1)
			EndIf
		EndIf
	EndWith	

	Procedure SendMsg
	With this
		Local x
		Private m.comp, m.msg
		m.comp=''
		m.msg=''
		
		x=CreateObject('SendMsgForm')
		With x
			.txtComp.ControlSource='m.comp'
			.edtMsg.ControlSource='m.msg'
			.show(1)
			If .Tag='OK'
				This.Send(Alltrim(m.Comp),Alltrim(m.msg))
			EndIf
		EndWith
	EndWith

	
	Procedure Timer.Timer
	this.Parent.wait

	Procedure Init
	With this
		.DeclareApi()
		.Create()
	EndWith

	Procedure Create
	* Процедура - вынесена из Init для моих целей
	With this
		.hMailSlot=CreateMailSlot('\\.\mailslot'+MYSLOT,0,0,0)
		If .hMailSlot > 0
			* Слот сзодан - можно читать
		Else
			=MessageBox("Не могу создать почтовый ящик",64,_Screen.Caption)
			Return .F.
		EndIf	
	EndWith

	Procedure Destroy
	With this
		CloseHandle(.hMailSlot)
	EndWith

	Procedure DeclareApi

	Declare Integer CreateMailslot In win32api ;
		string SlotName,;
		integer MaxSize,;
		integer Timeout,;
		string Sec


	Declare Integer WriteFile In kernel32 ;
		INTEGER hFile,;
		string lpBuffer,;
		INTEGER nBt2Write,;
		INTEGER @ lpBtWritten,;
		INTEGER lpOverlapped


	Declare Integer ReadFile In kernel32 ;
		INTEGER   hFile,;
		STRING    lpBuffer,;
		INTEGER   nNumberOfBytesToRead,;
		INTEGER @ lpNumberOfBytesRead,;
		STRING  @ lpOverlapped

	Declare Integer CloseHandle In win32api Integer
	Declare Long GetLastError In win32api

	Declare Integer GetMailslotInfo In win32api ;
		integer hMailSlot,;
		integer @ MaxSize,;
		integer @ NextSize,;
		integer @ MessageCount,;
		integer @ Timeout

	Declare Integer CreateFile In kernel32.Dll;
		STRING  lpFileName,;
		INTEGER dwDesiredAccess,;
		INTEGER dwShareMode,;
		INTEGER lpSecurityAttributes,;
		INTEGER dwCreationDistribution,;
		INTEGER dwFlagsAndAttributes,;
		INTEGER hTemplateFile

	Declare integer PlaySound in winmm.dll string, integer, integer

Enddefine

Define Class SendMsgForm AS Form
	Caption='Отправка сообщения'
	AutoCenter=.T.
	BorderStyle=2
	Width=375
	Height=375
	Icon=_Screen.Icon
	MinButton=.F.
	MaxButton=.F.
	WindowType=1

	Add Object lblComp as Label with ;
		Top=12,;
		Left=10,;
		Width=80,;
		FontName='Arial',;
		FontSize=8,;
		AutoSize=.T.,;
		Caption='Компьютер'
		
	Add Object txtComp as TextBox with ;
		Top=10,;
		Left=100,;
		Width=250,;
		Height=20,;
		Margin=1,;
		FontName='Arial',;
		FontSize=8


	Add Object lblMsg as Label with ;
		Top=42,;
		Left=10,;
		Width=80,;
		FontName='Arial',;
		FontSize=8,;
		AutoSize=.T.,;
		Caption='Сообщение'

	Add Object edtMsg as EditBox with ;
		Top=60,;
		Left=10,;
		Width=355,;
		Height=270,;
		FontName='Arial',;
		FontSize=8
	
	Add Object cmdOk as CommandButton with ;
		Default=.T.,;
		FontName='Arial',;
		FontSize=8,;
		Caption='Готово',;
		Top=375-24-5,;
		Left=375-5-80-5-80,;
		Width=80,;
		Height=24

	Add Object cmdCancel as CommandButton with ;
		Cancel=.T.,;
		FontName='Arial',;
		FontSize=8,;
		Caption='Отмена',;
		Top=375-24-5,;
		Left=375-5-80,;
		Width=80,;
		Height=24

	Procedure UnLoad
	Return This.Tag='OK'
	EndProc

	Procedure CmdOk.Click
	With thisform
		.Tag='OK'
		.Hide()
		.Release()
	EndWith

	Procedure CmdCancel.Click
	With thisform
		.Hide()
		.Release()
	EndWith

EndDefine

Define Class ShowMSGForm AS Form
	Caption='Получено сообщение'
	AutoCenter=.T.
	BorderStyle=2
	Width=375
	Height=375
	Icon=_Screen.Icon
	MinButton=.F.
	MaxButton=.F.
*	WindowType=1

	Add Object Text as EditBox with ;
		Top=10,;
		Left=10,;
		Width=355,;
		Height=325,;
		FontName='Arial',;
		FontSize=8,;
		ReadOnly=.T.

	Add Object cmdCancel as CommandButton with ;
		Cancel=.T.,;
		FontName='Arial',;
		FontSize=8,;
		Caption='Отмена',;
		Top=375-24-5,;
		Left=375-5-80,;
		Width=80,;
		Height=24

	Procedure UnLoad
	Return This.Tag='OK'
	EndProc

	Procedure CmdCancel.Click
	With thisform
		.Hide()
		.Release()
	EndWith

EndDefine