Imaginecorp
IS-IT--Management
Here is how you do it:
NOTE: Unlike other samples, this requires Multiple (no limit) networked computers. It will not work on a single machine.This is based upon the following assumptions:
Your application has an employee table that resides on a server. All employees are assigned a unique number (we call it “ordinal”) and every time you authenticate a user you set a flag in the employee table to .T. (we call it “Loggedon”), You also capture the users Machine network name in the employee table using the SYS(0) function (we call it machine_user). Also when the user logs off your app, you reset “loggedon” to .F. and replace "machine_user" with Spaces. (Blank)
*******************************************
Create a class library call it “olevcx.vcx”
Add the Winsock ActiveX control 6.0 to this class. (We call it "Reg_winsock") The easiest way to do this is open a form, drag the Winsock onto the form, and select the Winsock then do a Save-as-Class to the olevck.vcx. Close the form without saving it.
Add a container and within the container add "reg_winsock" and save the container as “oWinsock”. Reg_winsock will automatically be renamed to Reg_winsock1.
Now let’s start designing the Instant messaging module:
1.This comprises of a single class
2.A single message form
3.An employee finder form. We use it as I do not like to put more than 15 or so rows in a drop down. If you have only a few employees/users use a combo box on the message form.
Some fundamentals:
This module uses the UDP protocol as opposed to the TCP one
The size of the packet sent / received is dependent upon your network, (safe to limit it to 29KB)
There is supposed to be a limitation on multiple sends – all data has to be sent in one “Send” is what I have read. I do not know what this means. If it means you cannot send multiple message one after the other – that’s just not true as we will see.
This module will allow you to select multiple recipients and send the same message to each of them as well
In your startup program:
Set the class library to Olevcx
Create 2 public variables, name them “oWinsock1” and “instantmsg”
Create the oWinsock1 object:
NOTE: You may cut and paste the following except for the class. But be aware this was designed using our class libraries. I recreated the forms in the VFP standard controls by cutting and pasting for this post. I may have not removed some of our codes. The error routine is not included as it is handled by a special class which will not be posted. Our Version has been tested throughly and there is No reason to beleave this will not work properly...
oWinsock class code is:
The reason for not including Employee.dbf in the DE of the form is its needs to be uptodate on who has logged on/off.
Employee Finder form’s code:
Note: there is a public variable here in the select statement called "user_ordinal". This stores the current users ordinal at start up of our app, This prevents the user from selecting himself to send a message to... You may have to recode.
The INIT() has 2 parameters which our system uses, you may remove them But be sure to change the parameters in the "Message Form reg_button1.Click"
Message Forms code:
Thats it...
NOTE: Unlike other samples, this requires Multiple (no limit) networked computers. It will not work on a single machine.This is based upon the following assumptions:
Your application has an employee table that resides on a server. All employees are assigned a unique number (we call it “ordinal”) and every time you authenticate a user you set a flag in the employee table to .T. (we call it “Loggedon”), You also capture the users Machine network name in the employee table using the SYS(0) function (we call it machine_user). Also when the user logs off your app, you reset “loggedon” to .F. and replace "machine_user" with Spaces. (Blank)
*******************************************
Create a class library call it “olevcx.vcx”
Add the Winsock ActiveX control 6.0 to this class. (We call it "Reg_winsock") The easiest way to do this is open a form, drag the Winsock onto the form, and select the Winsock then do a Save-as-Class to the olevck.vcx. Close the form without saving it.
Add a container and within the container add "reg_winsock" and save the container as “oWinsock”. Reg_winsock will automatically be renamed to Reg_winsock1.
Now let’s start designing the Instant messaging module:
1.This comprises of a single class
2.A single message form
3.An employee finder form. We use it as I do not like to put more than 15 or so rows in a drop down. If you have only a few employees/users use a combo box on the message form.
Some fundamentals:
This module uses the UDP protocol as opposed to the TCP one
The size of the packet sent / received is dependent upon your network, (safe to limit it to 29KB)
There is supposed to be a limitation on multiple sends – all data has to be sent in one “Send” is what I have read. I do not know what this means. If it means you cannot send multiple message one after the other – that’s just not true as we will see.
This module will allow you to select multiple recipients and send the same message to each of them as well
In your startup program:
Set the class library to Olevcx
Create 2 public variables, name them “oWinsock1” and “instantmsg”
Create the oWinsock1 object:
Code:
owinsock1 = newobject(“owinsock”)NOTE: You may cut and paste the following except for the class. But be aware this was designed using our class libraries. I recreated the forms in the VFP standard controls by cutting and pasting for this post. I may have not removed some of our codes. The error routine is not included as it is handled by a special class which will not be posted. Our Version has been tested throughly and there is No reason to beleave this will not work properly...
oWinsock class code is:
Code:
**************************************************
*-- Class: owinsock (c:\intelisys\libraries\olevcx.vcx)
*-- ParentClass: reg_container (c:\intelisys\libraries\reg_controls.vcx)
*-- BaseClass: container
*-- Time Stamp: 05/04/09 11:37:11 AM
*
DEFINE CLASS owinsock AS container
Width = 32
Height = 32
Name = "owinsock"
ADD OBJECT reg_winsock1 AS reg_winsock WITH ;
Top = 1, ;
Left = 1, ;
Height = 100, ;
Width = 100, ;
Name = "Reg_winsock1"
PROCEDURE setremote
Lparameters pRemotehost
**** lets clear the remote host otherwise
**** it throws an error saying invalid arguement. This allows the multiple sends.
**** This is where I was stuck, took me longer to figuire this out, then to write the whole module
This.reg_winsock1.RemoteHost = ""
This.reg_winsock1.remoteport = 0
********** lets reset it again
This.reg_winsock1.RemoteHost = pRemotehost
This.reg_winsock1.remoteport = 5000
ENDPROC
PROCEDURE startform
Lparameters pMessage
If Vartype(instantmsg) = "O"
*** if form is open lets not keep calling the init()
instantmsg.recievemsg(pMessage)
Else
Do Form instant_msg With pMessage
Endif
ENDPROC
PROCEDURE transmitmsg
Lparameters pMessage
This.reg_winsock1.Object.SendData(pMessage)
ENDPROC
PROCEDURE reg_winsock1.DataArrival
*** ActiveX Control Event ***
Lparameters bytestotal
*** lets define the buffer the same size as
*** the message size in bytes
cData = Space(bytestotal)
***************************
This.Object.GetData(@cData)
?? Chr(7)
This.Parent.startform(cData)
ENDPROC
PROCEDURE reg_winsock1.Init
**** lets bind the port so no other service
**** can broadcast on it
This.Bind(5000)
*********************************
ENDPROC
ENDDEFINE
*
*-- EndDefine: owinsock
**************************************************Employee Finder form’s code:
Note: there is a public variable here in the select statement called "user_ordinal". This stores the current users ordinal at start up of our app, This prevents the user from selecting himself to send a message to... You may have to recode.
The INIT() has 2 parameters which our system uses, you may remove them But be sure to change the parameters in the "Message Form reg_button1.Click"
Code:
PUBLIC oempfinder
oempfinder=NEWOBJECT("empfinder")
oempfinder.Show
RETURN
**************************************************
*-- Form: empfinder (c:\intelisys\screens\employee_finder.scx)
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 05/04/09 02:22:13 PM
*
DEFINE CLASS empfinder AS form
Height = 356
Width = 288
DoCreate = .T.
AutoCenter = .T.
BorderStyle = 2
Caption = "Users currently logged on..."
FontName = "MS Sans Serif"
WindowType = 1
returnvalue = .F.
Name = "empfinder"
ADD OBJECT reg_shape2 AS shape WITH ;
Top = 8, ;
Left = 6, ;
Height = 328, ;
Width = 276, ;
BorderStyle = 0, ;
SpecialEffect = 0, ;
BackColor = RGB(255,255,255), ;
Name = "Reg_shape2"
ADD OBJECT reg_shape1 AS shape WITH ;
Top = 18, ;
Left = 16, ;
Height = 22, ;
Width = 255, ;
SpecialEffect = 0, ;
Name = "Reg_shape1"
ADD OBJECT reg_listbox1 AS listbox WITH ;
FontName = "MS Sans Serif", ;
ColumnCount = 3, ;
ColumnWidths = "115,112,0", ;
Height = 289, ;
ColumnLines = .F., ;
Left = 16, ;
Top = 37, ;
Width = 254, ;
BorderColor = RGB(224,223,227), ;
Name = "Reg_listbox1"
ADD OBJECT reg_label1 AS label WITH ;
AutoSize = .T., ;
FontName = "Calibri", ;
BackStyle = 0, ;
Caption = "Full Name", ;
Height = 16, ;
Left = 23, ;
Top = 21, ;
Width = 58, ;
Name = "Reg_label1"
ADD OBJECT reg_label2 AS label WITH ;
AutoSize = .T., ;
FontName = "Calibri", ;
BackStyle = 0, ;
Caption = "Computer Name", ;
Height = 16, ;
Left = 146, ;
Top = 21, ;
Width = 89, ;
Name = "Reg_label2"
ADD OBJECT reg_label4 AS label WITH ;
AutoSize = .T., ;
FontName = "Calibri", ;
BackStyle = 0, ;
Caption = "Double Click to Select", ;
Height = 16, ;
Left = 84, ;
Top = 340, ;
Width = 120, ;
Name = "Reg_label4"
PROCEDURE Unload
Return This.returnvalue
ENDPROC
PROCEDURE Init
Lparameters pwhocalled,pdatasessionid
DoDefault()
With This
.AddProperty("whocalled",pwhocalled)
.DataSessionId = pdatasessionid
Select employee.ordinal,employee.full_name,employee.machine_user ;
FROM required!employee ;
WITH (Buffering = .T. );
WHERE ((employee.loggedon = .T.);
AND employee.ordinal <> user_ordinal ;
AND Not Deleted("employee")) ;
ORDER By employee.full_name ;
INTO Cursor empcursor
Select empcursor
If Reccount("empcursor") < 1
=Messagebox(mappname+" did not find any employees who are logged on at this time."+Chr(13)+;
"Please try again later...",64,its_logo)
Use In employee
Return .F.
Endif
With .reg_listbox1
Scan
.AddItem(empcursor.full_name)
.List(.NewIndex,2) = ;
PROPER(Substr(empcursor.machine_user,1,At("#",empcursor.machine_user)-1))
.List(.NewIndex,3) = empcursor.ordinal
Endscan
.Value = .TopIndex
Endwith
Endwith
If Select("employee") > 0
Use In employee
Endif
ENDPROC
PROCEDURE reg_listbox1.DblClick
Thisform.returnvalue = This.List(This.ListIndex,3)
Thisform.Release
ENDPROC
ENDDEFINE
*
*-- EndDefine: empfinder
**************************************************Message Forms code:
Code:
PUBLIC oinstmsg
oinstmsg=NEWOBJECT("instmsg")
oinstmsg.Show
RETURN
**************************************************
*-- Form: instmsg (c:\intelisys\screens\instant_msg.scx)
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 05/04/09 02:52:05 PM
*
DEFINE CLASS instmsg AS form
DataSession = 2
Height = 400
Width = 371
DoCreate = .T.
AutoCenter = .T.
BorderStyle = 2
Caption = "Instant Messaging Service..."
FontName = "MS Sans Serif"
AlwaysOnTop = .T.
myname = ""
Name = "instmsg"
DIMENSION machinearray[1,4]
ADD OBJECT reg_shape1 AS shape WITH ;
Top = 5, ;
Left = 5, ;
Height = 356, ;
Width = 360, ;
BorderStyle = 0, ;
SpecialEffect = 0, ;
BackColor = RGB(255,255,255), ;
Name = "Reg_shape1"
ADD OBJECT reg_button1 AS commandbutton WITH ;
Top = 26, ;
Left = 14, ;
Height = 23, ;
Width = 89, ;
FontName = "Calibri", ;
Caption = "\<Message To:", ;
Name = "Reg_button1"
ADD OBJECT reg_editbox3 AS editbox WITH ;
FontName = "MS Sans Serif", ;
BorderStyle = 0, ;
Height = 43, ;
Left = 108, ;
ReadOnly = .T., ;
TabStop = .F., ;
Top = 15, ;
Width = 244, ;
Name = "Reg_editbox3"
ADD OBJECT reg_line1 AS line WITH ;
Height = 0, ;
Left = 74, ;
Top = 72, ;
Width = 279, ;
BorderColor = RGB(64,128,128), ;
Name = "Reg_line1"
ADD OBJECT reg_editbox1 AS editbox WITH ;
FontName = "MS Sans Serif", ;
BorderStyle = 0, ;
Height = 186, ;
Left = 18, ;
ReadOnly = .T., ;
SpecialEffect = 1, ;
TabStop = .F., ;
Top = 89, ;
Width = 335, ;
Name = "Reg_editbox1"
ADD OBJECT reg_label4 AS label WITH ;
AutoSize = .T., ;
FontName = "Calibri", ;
BackStyle = 0, ;
Caption = "Type Message here:", ;
Height = 16, ;
Left = 21, ;
Top = 286, ;
Width = 110, ;
Name = "Reg_label4"
ADD OBJECT reg_line2 AS line WITH ;
Height = 0, ;
Left = 138, ;
Top = 294, ;
Width = 215, ;
BorderColor = RGB(64,128,128), ;
Name = "Reg_line2"
ADD OBJECT cmdclose1 AS commandbutton WITH ;
Top = 371, ;
Left = 250, ;
Height = 24, ;
Width = 55, ;
FontName = "MS Sans Serif", ;
Caption = "\<Send", ;
Name = "Cmdclose1"
ADD OBJECT cmdcancel1 AS commandbutton WITH ;
Top = 371, ;
Left = 306, ;
Height = 24, ;
Width = 55, ;
Caption = "Ca\<ncel", ;
Name = "Cmdcancel1"
ADD OBJECT reg_editbox2 AS editbox WITH ;
FontName = "MS Sans Serif", ;
Height = 45, ;
Left = 18, ;
SpecialEffect = 1, ;
Top = 304, ;
Width = 335, ;
BorderColor = RGB(128,128,128), ;
Name = "Reg_editbox2"
PROCEDURE Init
Lparameters pText
DoDefault()
*!* InstantMsg is a public variable declared in its.prg
InstantMsg = This
*!* lets check for winsock1. This is redundant but lets do it anyway
If Vartype(oWinsock1) # "O"
=Messagebox("Communication is disabled at this time...",64,its_logo)
Return .F.
Endif
If Vartype(pText) # "L"
This.recievemsg(pText)
Endif
This.reg_button1.SetFocus()
ENDPROC
PROCEDURE recievemsg
Lparameters pMesg
**** scroll the edit box after adding the message
With This.reg_editbox1
cRText = Alltrim(.Value)
cRText = cRText + Iif(Empty(cRText),"",Chr(13))+pMesg
nRinsertPoint = Len(cRText)+2
.Value = cRText
.SelStart = nRinsertPoint
.SetFocus()
Endwith
*******************************
This.reg_editbox2.SetFocus()
ENDPROC
PROCEDURE reg_button1.Click
Local cEmp
Do Form employee_finder With Thisform,Thisform.DataSessionId To cEmp
If Empty(cEmp)
Return
Endif
Store "" To cName,cPhone,cText3,cMachine
Store 0 To nLen
Select 0
Use required!employee Again Alias employee1
Set Order To Tag ordinal
=Indexseek(user_ordinal,.T.)
Thisform.myname = Alltrim(employee1.full_name)
Go Top
If Indexseek(cEmp,.T.)
With Thisform
cName = Alltrim(employee1.full_name)
cPhone = employee1.phone
cText3 = Alltrim(.reg_editbox3.Value)
cText3 = cText3 + Iif(Empty(cText3),""," ; ")+cName
.reg_editbox3.Value = cText3
cMachine = ;
SUBSTR(employee1.machine_user,1,Atc("#",employee1.machine_user)-1)
nLen = Alen(.machineArray,1)
.machineArray[nlen,1] = Alltrim(cMachine)
.machineArray[nlen,2] = cName
.machineArray[nlen,3] = cEmp
.machineArray[nlen,4] = cPhone
Dimension .machineArray[nlen+1,4]
Endwith
Endif
Use In employee1
ENDPROC
PROCEDURE cmdclose1.Click
With Thisform
If Empty(Alltrim(.reg_editbox3.Value))
=Messagebox("Please select the message Recipient first...",64,its_logo)
.reg_button1.SetFocus()
Return
Endif
If Empty(.reg_editbox2.Value)
=Messagebox("Please type in a message first...",64,its_logo)
.reg_editbox2.SetFocus()
Return
Endif
If Vartype(oWinsock1) # "O"
=Messagebox("Communication seems to be disabled at this time."+Chr(13)+;
"Please try again later...",64,its_logo)
Return
Endif
Select 0
Use required!employee Shared Again Alias employee1
Set Order To Tag ordinal
Store "" To cSendText
cSendText = Alltrim(Thisform.myname)+":--> "+Alltrim(.reg_editbox2.Value)
Store "" To .reg_editbox2.Value
cText = Alltrim(.reg_editbox1.Value)
cText = cText + Iif(Empty(cText),"",Chr(13))+cSendText
**** scroll the edit box
nInsertPoint = Len(cText)+2
With .reg_editbox1
.Value = cText
.SelStart = nInsertPoint
.SetFocus()
Endwith
Select employee1
For x = 1 To Alen(.machinearray,1)
If !Empty(.machinearray[x,1])
**** lets check again if this employee
**** is still logged on
If Indexseek(.machinearray[x,3])
Indexseek(.machinearray[x,3],.T.)
If employee1.loggedon And !Empty(employee1.machine_user)
cRemoteMachine = Alltrim(.machinearray[x,1])
oWinsock1.setremote(cRemoteMachine)
oWinsock1.transmitmsg(cSendText)
Else
cEmpName = .machinearray[x,2]
cEmpPhone = Transform(.machinearray[x,4], "@R (###)###-####")
=Messagebox(cEmpName+" seems to have logged off "+mappname+Chr(13)+;
"Your message cannot be sent"+Chr(13)+;
"Here is "+cEmpName+"'s Telephone # "+cEmpPhone,64,its_logo)
Endif
Endif
Endif
Endfor
.Refresh
.reg_editbox2.SetFocus()
Use In employee1
Endwith
ENDPROC
PROCEDURE cmdcancel1.Click
Store "" To Thisform.reg_editbox2.Value ,;
Thisform.reg_editbox3.Value
Dimension Thisform.machineArray[1,4]
Store .F. To Thisform.machineArray
Thisform.reg_button1.SetFocus()
ENDPROC
ENDDEFINE
*
*-- EndDefine: instmsg
**************************************************Thats it...
