• Welcome, Guest. Please login.
 
August 20, 2019, 05:25:23 am

News:

Welcome to the SQLitening support forums!


Send/Receive TCP Messages between PC's An A LAN

Started by Fredrick Ughimi, September 01, 2017, 07:19:10 pm

Previous topic - Next topic

Fredrick Ughimi

Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

Fredrick Ughimi

Thanks CJ, for responding and the links.

I am thinking of rolling out something in that direction.
I guess it would be fun and a learning process.

Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

Fredrick Ughimi

Wow! Would take a closer look later today. Thanks CJ.
Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

Fredrick Ughimi

CJ,

Quote
What kind of dialog will be used?


A Textbox would be suitable.
Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

Fredrick Ughimi

CJ,

I am creating a GUI version of this.

Best regards,
Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

cj

September 05, 2017, 06:33:01 am #5 Last Edit: September 05, 2017, 11:30:32 am by cj
Added  room for menu items instead of buttons, minimize dialog added other small enhancements 9:00 AM 9/5/17

#PBFORMS CREATED V2.01
#COMPILE EXE
#DIM ALL
$MessageDatabase  = "message.db3"
$MessageTable     = "messagetable"
$Host             = "" 'computer name, host name or "" for local

$SQL = "select * from "+$messageTable + " order by rowid desc" ' limit xxx"
'$SQL = "select * from " + $messageTable '%Autoscroll suggested with this

%ReadDuration        = 3000  'read speed in milliseconds
%WriteDuration       = 1000  'write speed in milliseonds
%AutoScroll          = 0     'good viewing forward,  descending want top records
%DropTable           = 0     'while testing or perhaps at end of day/week, etc ...
%WriteTestRecords    = 1     'only while testing
%BeepIfNewMessage    = 0     'annoying while testing
%CreateReceiverIndex = 0     'faster writes without index

GLOBAL gEndThreads,ghDlg AS DWORD, gsReadArray() AS STRING

#PBFORMS BEGIN INCLUDES
#INCLUDE ONCE "WIN32API.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------
#INCLUDE "sqlitening.inc"

#PBFORMS BEGIN CONSTANTS
%TEXT_UPPER  = 4000
%IDD_DIALOG1 =   -1
%IDR_MENU1   =  101
%IDM_One     =    0
%IDM_TWO     = 5005
%IDM_THREE   = 5006
%IDM_FOUR    = 5007
%IDM_FIVE    = 5008
%IDM_SIX     = 5009
%IDM_SEVEN   = 5010
%IDM_EIGHT   = 5011
%IDM_NINE    = 5012
#PBFORMS END CONSTANTS
DECLARE FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
#PBFORMS DECLARATIONS

FUNCTION PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
DO:SLEEP 1000:LOOP UNTIL THREADCOUNT = 1
END FUNCTION

CALLBACK FUNCTION ShowDIALOG1Proc()

  SELECT CASE AS LONG CB.MSG
    CASE %WM_INITDIALOG
      ghDlg = CB.HNDL
      StartThreads

    CASE %WM_NCACTIVATE
      STATIC hWndSaveFocus AS DWORD
      IF ISFALSE CB.WPARAM THEN
        hWndSaveFocus = GetFocus()
      ELSEIF hWndSaveFocus THEN
        SetFocus(hWndSaveFocus)
        hWndSaveFocus = 0
      END IF

    CASE %WM_COMMAND
      SELECT CASE AS LONG CB.CTL

        CASE %TEXT_UPPER
        CASE %IDM_One
        CASE %IDM_TWO
        CASE %IDM_THREE
        CASE %IDM_FOUR   :DIALOG END CB.HNDL
        CASE %IDM_FIVE
        CASE %IDM_SIX
        CASE %IDM_SEVEN
        CASE %IDM_EIGHT
        CASE %IDM_NINE

      END SELECT
  END SELECT
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
  LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->%IDR_MENU1->
  LOCAL hDlg   AS DWORD
  LOCAL hFont1 AS DWORD

  DIALOG NEW hParent, "Messages 0", 4, 3, 1098, 228, %WS_POPUP OR %WS_CAPTION _
    OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_VISIBLE OR %DS_MODALFRAME OR _
    %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR _
    %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
  CONTROL ADD TEXTBOX, hDlg, %TEXT_UPPER, "", 4, 0, 1081, 200, %WS_CHILD OR _
    %WS_VISIBLE OR %WS_HSCROLL OR %WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE _
    OR %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR %ES_WANTRETURN, %WS_EX_LEFT OR _
    %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR

  FONT NEW "Courier New", 16, 0, %ANSI_CHARSET TO hFont1

  CONTROL SET FONT hDlg, %TEXT_UPPER, hFont1

  AttachMENU1 hDlg
#PBFORMS END DIALOG

DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
  FONT END hFont1
#PBFORMS END CLEANUP
  gEndThreads = 1
  FUNCTION = lRslt
END FUNCTION

FUNCTION StartThreads AS LONG
LOCAL hReader,hWriter AS LONG
IF %WriteTestRecords THEN
  THREAD CREATE WriterTest(0) TO hWriter
  THREAD CLOSE  hWriter TO hWriter
END IF
THREAD CREATE Reader(0) TO hReader
THREAD CLOSE hReader TO hReader
END FUNCTION

FUNCTION StartHere AS LONG
IF LEN($Host) THEN slConnect $Host
IF slGetErrorNumber THEN EXIT FUNCTION
slOpen $MessageDatabase,"C"
IF slGetErrorNumber THEN ? slGetError:EXIT FUNCTION

slexe "begin exclusive"  'other thread could do same thing so do all or none
IF %DropTable THEN slexe "drop table if exists " + $MessageTable
slexe "CREATE TABLE if not exists " + $MessageTable + "(Row integer primary key autoincrement,TimeSent,Sender,Receiver,Message)
IF %CreateReceiverIndex THEN slexe "CREATE INDEX if not exists Receiver_IDX on " + $messagetable + "(Receiver)"
slexe "end"
END FUNCTION

THREAD FUNCTION Reader(BYVAL x AS LONG) AS LONG
LOCAL sMsg,sPrevMsg,sql AS STRING
IF StartHere THEN ? slGetError,,"ReceiveLoop":EXIT FUNCTION
DO
  REDIM gsReadArray(0)
  'sql = "select * from "+$messageTable + " order by rowid desc limit 20"
  slexe "begin exclusive"
  DisplaySql $SQL 'allows easy changing at top of program
  slexe "end"
  IF gEndThreads THEN EXIT DO 'exit before going to sleep
  SLEEP %ReadDuration
LOOP UNTIL gEndThreads
slDisconnect
END FUNCTION

THREAD FUNCTION WriterTest(BYVAL x AS LONG) AS LONG
DO
  Writer "CJ","Fredrick",USING$("The time is &",TIME$)
  IF gEndThreads THEN EXIT DO
  SLEEP %WriteDuration
LOOP UNTIL gEndThreads
END FUNCTION

FUNCTION Writer(sSender AS STRING,sReceiver AS STRING,sMessage AS STRING) AS LONG
LOCAL sql AS STRING
IF LEN($host) THEN slConnect $Host
slOpen $MessageDatabase
sql = "insert into " + $messagetable + " values(null,#TimeSent#,'#Sender#','#Receiver#','#Message#')"
REPLACE "#TimeSent#" WITH "datetime('now','localtime')" IN sql
REPLACE "#Sender#"   WITH sSender   IN sql
REPLACE "#Receiver#" WITH sReceiver IN sql
REPLACE "#Message#"  WITH sMessage  IN sql
slexe sql
FUNCTION = slGetChangeCount  'should check if 1
slDisconnect
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
#PBFORMS BEGIN MENU %IDR_MENU1->%IDD_DIALOG1
  LOCAL hMenu   AS DWORD

  MENU NEW BAR TO hMenu
  MENU ADD STRING, hMenu, "One", %IDM_One, %MF_ENABLED
  MENU ADD STRING, hMenu, "Two", %IDM_TWO, %MF_ENABLED
  MENU ADD STRING, hMenu, "Three", %IDM_THREE, %MF_ENABLED
  MENU ADD STRING, hMenu, "End", %IDM_FOUR, %MF_ENABLED
  MENU ADD STRING, hMenu, "Five", %IDM_FIVE, %MF_ENABLED
  MENU ADD STRING, hMenu, "Six", %IDM_SIX, %MF_ENABLED
  MENU ADD STRING, hMenu, "Seven", %IDM_SEVEN, %MF_ENABLED
  MENU ADD STRING, hMenu, "Eight", %IDM_EIGHT, %MF_ENABLED
  MENU ADD STRING, hMenu, "Nine", %IDM_NINE, %MF_ENABLED

  MENU ATTACH hMenu, hDlg
#PBFORMS END MENU
  FUNCTION = hMenu
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION DisplaySQL(sql AS STRING) AS STRING

  STATIC sPrevious AS STRING

  'if %lockwindows = 1 control results only display when all SQL statement finished
  LOCAL s,sArray() AS STRING
  LOCAL result,cols,rows,COL,ROW,LowRow AS LONG
  LOCAL sb AS ISTRINGBUILDERA
  sb = CLASS "StringBuilderA"

  result = slSelAry(sql,sArray())           '2 dimensions, with column names
  'result = slSelAry(sql,sArray(),"c")      '2 dimensions, without column names

  IF result THEN  slCloseSet:EXIT FUNCTION  '3/21/14  set was not looped though so be sure set closed

  Rows = UBOUND(sArray(2))
  Cols = UBOUND(sArray(1))

  IF cols = 0 THEN EXIT FUNCTION

  'check if same data
  s = JOIN$(sArray(),$CR)                 'recordset to string
  IF s = sPrevious THEN EXIT FUNCTION     'same data, exit
  sPrevious = s                           'put into sPrevious

  IF %BeepIfNewMessage THEN BEEP          'too much while testing

  lowrow = LBOUND(sArray(),2)     'column names exist if first row=0
  IF lowrow = 0 THEN
   FOR COL = 1 TO cols
    sb.add sArray(COL,0)
    sb.add $TAB
    IF COL = 2 THEN sb.add $TAB    'heading3 extra tab to the right
   NEXT                            'because column2 data too long
   sb.delete(sb.len,1)             'get rid of trailing tab
   sb.add $CRLF                    'end of column name line
   sb.add $CRLF                    'add a blank line
  END IF

  FOR ROW = 1 TO rows              'data begins with row 1
    FOR COL = 1 TO cols
      sb.add sArray(COL,ROW)
      sb.add $TAB
    NEXT
    sb.add $CRLF
  NEXT
  s= sb.string                     's$ from stringbuilder object
  CONTROL SET TEXT ghDlg, %TEXT_UPPER, s 'add to textbox

  IF %AutoScroll THEN              'scroll to bottom of textbox
   'autoscroll to bottom (do not want when scrolling backward
   CONTROL SEND ghDlg,%TEXT_UPPER,%WM_VSCROLL,%SB_BOTTOM,0
   'CONTROL REDRAW ghDlg, %TEXT_UPPER
  END IF
  DIALOG SET TEXT ghDlg,USING$("Messages #",rows) 'change dialog title
END FUNCTION

Fredrick Ughimi

CJ, Wow! wow!! So nice. From different angles.

Been thinking. Would the Name in the Receiver field identify the computer the message is being sent to? I guess not. Are you using the computer name in the receiver field?
Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

cj

September 05, 2017, 12:06:58 pm #7 Last Edit: September 05, 2017, 12:20:58 pm by cj
No.  I was going to do it that way to automatically send from the current computer name, but after
thinking about it, I thought it would be better to send to people not machines.
Added number of messages to dialog title so it could be minimized and you see if there are new messages.
Note, it is fast enough to scroll all the way back to message 1 even with thousands of messages.
I left lots of open menu items at top to add stuff in the future like maybe clear message, scroll range.
Could even add an option to let users enter some of their own searches.

One of  those menu items could be send message.

I was reading one of the SQLite experts on nabble, Slavik, say since SQLite is an embedded database
so mixing functions from other languages is not bad form.  I am going to take that advice.  I have been
trying to be a purist to learn SQLite, but at times it is just easier and better to use native language functions.

This program simply adds messages to a table and users from any machine can poll for there messages or all messages.

A computer name could be a receiver and any computer on a network could search for just there computer name.
select * from message table where receiver = '#computername#'  order by rowid desc limit xxxx.
There is no setup file, at least not yet, and each machine could lookup there computer name and automatically use it.

One of the most powerful and probably dangerous things that could be done is to poll for a message and based upon
that action shell to anything you want on the local machine.  Control devices or other programs using this technique.
If all machines agree to certain  messages  playing sounds on other machines is a very small example.  Ring a bell.
This ability might be in a new column not displayed to users or polling another table.



Fredrick Ughimi

Hello,

Quote
This program simply adds messages to a table and users from any machine can poll for there messages or all messages.


Great idea. That means everybody sees everybody's messages.

I was initially thinking of a situation where messages are private. 

Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

cj

Messages can be private if you don't allow sql statements without a where clause.
Example: select * from messagetable where receiver = 'fredrick' and sender = 'cj' order by rowid desc"

Fredrick Ughimi

Quote
Messages can be private if you don't allow sql statements without a where clause.
Example: select * from messagetable where receiver = 'fredrick' and sender = 'cj' order by rowid desc"


I guess 'if you allow...' Is what you wanted to say.
Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

Fredrick Ughimi

CJ,

Quote
I left lots of open menu items at top to add stuff in the future like maybe clear message, scroll range.
Could even add an option to let users enter some of their own searches.

One of  those menu items could be send message.


Interesting! Really nice.

My approach was a little different. I started the with send message Dialog. I think I would just build on what you have already done.

Thanks.

Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

cj

I think it is a good structure and I let it run for hours creating hundreds of thousand of messages.
This was done with 1 program running local mode, 1 program running server on local ip address
and 1 program running over the internet.

The only time it had a problem was when the database was deleted and the writer was started before the reader.
The code I posted should have started the Reader thread, delayed a second then start Writer thread.
The Reader thread creates the table.

Messages can be sent when receiver's computer is off.
Messages can be deleted when read or saved for any length of time.
Messages to or from anyone can be grouped by users, time or even the message.
Whitelist could be created to allow users to send or receive  from certain users.
Blacklist could be created to disallow users to send or receive for certain users.
Messages could be text or binary with a small change


This statement used 2 negatives so was confusing "Private if don't allow without WHERE clause" could be said "Private if WHERE clause"
select * from messagetable where receiver = 'fredrick' and sender = 'cj' order by rowid desc"

Now that I know it works well the WriterTest loop thread can be deleted and sending single messages will be easy.


Fredrick Ughimi

Hello CJ,

Quote
I think it is a good structure and I let it run for hours creating hundreds of thousand of messages.
This was done with 1 program running local mode, 1 program running server on local ip address
and 1 program running over the internet.


Sure. Beautiful template I would say. I have already started filling out the menus. Working on the send message module.
Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet

Fredrick Ughimi

Hello CJ,

I just changed things around abit. I used a Listview for the message view instead. I liked the way you used the THREAD function to achieve the auto display.
I tried using it without success. So I created a Refresh Message View menu to achieve that. Definetely needs some improvement I guess.


#PBFORMS CREATED V2.01
#COMPILE EXE
#DIM ALL
$MessageDatabase  = "message.db3"
$MessageTable     = "messagetable"
$Host             = "" 'computer name, host name or "" for local

$SQL = "select * from " +$messageTable + " order by rowid desc" 'limit xxx"
'$SQL = "select * from " + $messageTable '%Autoscroll suggested with this

%ReadDuration        = 3000  'read speed in milliseconds
%WriteDuration       = 1000  'write speed in milliseonds
%AutoScroll          = 0     'good viewing forward,  descending want top records
%DropTable           = 0     'while testing or perhaps at end of day/week, etc ...
%WriteTestRecords    = 1     'only while testing
%BeepIfNewMessage    = 0     'annoying while testing
%CreateReceiverIndex = 0     'faster writes without index



GLOBAL gEndThreads,ghDlg AS DWORD, gsReadArray() AS STRING
GLOBAL lZStr AS ASCIIZ * 128
'LET lZStr = "dd-MM-yyyy"

#PBFORMS BEGIN INCLUDES
#RESOURCE "CJGUISendReceiveMessages.pbr"
%USEMACROS = 1
#INCLUDE ONCE "WIN32API.INC"
#INCLUDE ONCE "COMMCTRL.INC"
#INCLUDE ONCE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------
#INCLUDE "sqlitening.inc"

#PBFORMS BEGIN CONSTANTS
%IDM_SEND_SENDBROADCASTMESSAGE  = 5013
%IDM_PROGRAM_LOGIN              = 5027
%IDM_SEND_SENDPRIVATEMESSAGE    = 5030
%IDM_SENDMESSAGE                = 5013
%TEXT_UPPER                     = 4000
%IDD_DIALOG1                    =   -1
%IDR_MENU1                      =  101
%IDM_One                        =    0  '*
%IDM_TWO                        = 5005  '*
%IDM_THREE                      = 5006
%IDM_FOUR                       = 5007
%IDM_FIVE                       = 5008
%IDM_SIX                        = 5009
%IDM_SEVEN                      = 5010
%IDM_EIGHT                      = 5011
%IDM_NINE                       = 5012
%IDM_Send                       = 5029
%IDD_SendMessage                =  102
%IDC_STATUSBAR1                 = 5014
%IDC_LABEL1                     = 5015  '*
%IDC_LABEL2                     = 5016
%IDC_LABEL3                     = 5017
%IDC_LABEL4                     = 5018
%IDC_TimeSent                   = 5019  '*
%IDC_Message                    = 5022
%IDC_Sender                     = 5020
%IDC_Receiver                   = 5021
%IDC_SYSIPADDRESS32_1           = 5025  '*
%IDC_MessageListview            = 5026
%IDC_btnSend                    = 5024
%IDC_btnClose                   = 5025
%IDM_PROGRAM_EXIT               = 5028
%IDM_PROGRAM_SENDPRIVATEMESSAGE = 5030  '*
%IDM_SENDBROADCASTMESSAGE       = 5013  '*
%IDM_SEND_REFRESHMESSAGEVIEW    = 5031
#PBFORMS END CONSTANTS
DECLARE FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
DECLARE CALLBACK FUNCTION ShowDIALOG2Proc()
DECLARE FUNCTION ShowDIALOG2(BYVAL hDlg AS DWORD) AS LONG
DECLARE FUNCTION ClearMessage(BYVAL hDlg AS LONG) AS LONG
DECLARE FUNCTION MessageHeader(BYVAL hDlg AS LONG) AS LONG
DECLARE FUNCTION BrowseMessageRecords(BYVAL hDlg AS LONG) AS LONG
DECLARE  FUNCTION RefreshMessages(BYVAL hDlg AS LONG) AS LONG

#PBFORMS DECLARATIONS

FUNCTION PBMAIN()
    PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR %ICC_INTERNET_CLASSES)

ShowDIALOG1 %HWND_DESKTOP
DO:SLEEP 1000:LOOP UNTIL THREADCOUNT = 1
END FUNCTION

CALLBACK FUNCTION ShowDIALOG1Proc()

  SELECT CASE AS LONG CB.MSG
    CASE %WM_INITDIALOG
      ghDlg = CB.HNDL
      'StartThreads
      MessageHeader CB.HNDL
      BrowseMessageRecords CB.HNDL

    CASE %WM_NCACTIVATE
      STATIC hWndSaveFocus AS DWORD
      IF ISFALSE CB.WPARAM THEN
        hWndSaveFocus = GetFocus()
      ELSEIF hWndSaveFocus THEN
        SetFocus(hWndSaveFocus)
        hWndSaveFocus = 0
      END IF

    CASE %WM_COMMAND
      SELECT CASE AS LONG CB.CTL
                ' /* Inserted by PB/Forms 09-09-2017 20:47:23
                CASE %IDM_SEND_REFRESHMESSAGEVIEW
                     RefreshMessages CB.HNDL

                ' /* Inserted by PB/Forms 09-08-2017 21:52:17
                CASE %IDM_FOUR
                    MSGBOX "%IDM_FOUR=" + FORMAT$(%IDM_FOUR), %MB_TASKMODAL
                ' */

                ' /* Inserted by PB/Forms 09-07-2017 22:32:58
                CASE %IDM_PROGRAM_LOGIN
                    MSGBOX "%IDM_PROGRAM_LOGIN=" + _
                        FORMAT$(%IDM_PROGRAM_LOGIN), %MB_TASKMODAL

                CASE %IDM_PROGRAM_EXIT
                    DIALOG END CB.HNDL

                CASE %IDM_SEND_SENDPRIVATEMESSAGE
                    ShowSendMessage CB.HNDL

                CASE %IDM_SEND_SENDBROADCASTMESSAGE
                    MSGBOX "%IDM_SEND_SENDBROADCASTMESSAGE=" + _
                        FORMAT$(%IDM_SEND_SENDBROADCASTMESSAGE), _
                        %MB_TASKMODAL
             
         CASE %IDM_THREE

        CASE %IDM_FIVE
        CASE %IDM_SIX
        CASE %IDM_SEVEN
        CASE %IDM_EIGHT
        CASE %IDM_NINE

      END SELECT
  END SELECT
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
  LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->%IDR_MENU1->
    LOCAL hDlg   AS DWORD
    LOCAL hFont1 AS DWORD
    LOCAL hFont2 AS DWORD

    DIALOG NEW hParent, "message3", 27, 37, 910, 372, %WS_POPUP OR _
        %WS_CAPTION OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_VISIBLE OR _
        %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
        %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR, TO hDlg
    CONTROL ADD TEXTBOX,  hDlg, %TEXT_UPPER, "", 575, 250, 45, 35, %WS_CHILD _
        OR %WS_VISIBLE OR %WS_HSCROLL OR %WS_VSCROLL OR %ES_LEFT OR _
        %ES_MULTILINE OR %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR _
        %ES_WANTRETURN, %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR
    CONTROL ADD LISTVIEW, hDlg, %IDC_MessageListview, "Listview1", 5, 0, 900, _
        165, %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER OR %WS_TABSTOP OR _
        %LVS_REPORT OR %LVS_SHOWSELALWAYS, %WS_EX_LEFT

    FONT NEW "Courier New", 16, 0, %ANSI_CHARSET TO hFont1
    FONT NEW "MS Sans Serif", 12, 0, %ANSI_CHARSET TO hFont2

    CONTROL SET FONT hDlg, %TEXT_UPPER, hFont1
    CONTROL SET FONT hDlg, %IDC_MessageListview, hFont2

    AttachMENU1 hDlg
#PBFORMS END DIALOG
LISTVIEW SET STYLEXX hDlg, %IDC_MessageListview, %LVS_EX_GRIDLINES OR %LVS_EX_FULLROWSELECT
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
    FONT END hFont1
    FONT END hFont2
#PBFORMS END CLEANUP
  gEndThreads = 1
  FUNCTION = lRslt
END FUNCTION

FUNCTION StartHere AS LONG
IF LEN($Host) THEN slConnect $Host
IF slGetErrorNumber THEN EXIT FUNCTION
slOpen $MessageDatabase,"C"
IF slGetErrorNumber THEN ? slGetError:EXIT FUNCTION

slexe "begin exclusive"  'other thread could do same thing so do all or none
IF %DropTable THEN slexe "drop table if exists " + $MessageTable
slexe "CREATE TABLE if not exists " + $MessageTable + "(Row integer primary key autoincrement,TimeSent,Sender,Receiver,Message)
IF %CreateReceiverIndex THEN slexe "CREATE INDEX if not exists Receiver_IDX on " + $messagetable + "(Receiver)"
slexe "end"
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
#PBFORMS BEGIN MENU %IDR_MENU1->%IDD_DIALOG1
    LOCAL hMenu   AS DWORD
    LOCAL hPopUp1 AS DWORD

    MENU NEW BAR TO hMenu
    MENU NEW POPUP TO hPopUp1
    MENU ADD POPUP, hMenu, "Program", hPopUp1, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "Login", %IDM_PROGRAM_LOGIN, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "-", 0, 0
        MENU ADD STRING, hPopUp1, "Exit", %IDM_PROGRAM_EXIT, %MF_ENABLED
    MENU NEW POPUP TO hPopUp1
    MENU ADD POPUP, hMenu, "Send", hPopUp1, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "Send Private Message", _
            %IDM_SEND_SENDPRIVATEMESSAGE, %MF_ENABLED
    MENU ADD STRING, hMenu, "-", 0, 0
        MENU ADD STRING, hPopUp1, "Send Broadcast Message", _
            %IDM_SEND_SENDBROADCASTMESSAGE, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "Refresh Message View", _
            %IDM_SEND_REFRESHMESSAGEVIEW, %MF_ENABLED
    MENU ADD STRING, hMenu, "-", 0, 0
    MENU ADD STRING, hMenu, "Three", %IDM_THREE, %MF_ENABLED
    MENU ADD STRING, hMenu, "End", %IDM_FOUR, %MF_ENABLED
    MENU ADD STRING, hMenu, "Five", %IDM_FIVE, %MF_ENABLED
    MENU ADD STRING, hMenu, "Six", %IDM_SIX, %MF_ENABLED
    MENU ADD STRING, hMenu, "Seven", %IDM_SEVEN, %MF_ENABLED
    MENU ADD STRING, hMenu, "Eight", %IDM_EIGHT, %MF_ENABLED
    MENU ADD STRING, hMenu, "Nine", %IDM_NINE, %MF_ENABLED

    MENU ATTACH hMenu, hDlg
#PBFORMS END MENU
  FUNCTION = hMenu
END FUNCTION
'------------------------------------------------------------------------------


'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowSendMessageProc()

    SELECT CASE AS LONG CB.MSG
        CASE %WM_INITDIALOG
            ' Initialization handler

        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CB.WPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CB.CTL
                ' /* Inserted by PB/Forms 09-07-2017 12:12:29
                CASE %IDC_btnSend
                    IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                       SaveMessage CB.HNDL
                    END IF


                CASE %IDC_btnClose
                    IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                        DIALOG END CB.HNDL
                    END IF

            END SELECT
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
FUNCTION ShowSendMessage(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_SendMessage->->
    LOCAL hDlg  AS DWORD

    DIALOG NEW hParent, "Send Message", 232, 82, 307, 183, TO hDlg
    CONTROL ADD TEXTBOX,   hDlg, %IDC_Sender, "", 65, 5, 110, 15
    CONTROL ADD TEXTBOX,   hDlg, %IDC_Receiver, "", 65, 25, 110, 15
    CONTROL ADD TEXTBOX,   hDlg, %IDC_Message, "", 65, 45, 230, 70, %WS_CHILD _
        OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_LEFT OR %ES_MULTILINE OR _
        %ES_AUTOHSCROLL OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT _
        OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
    CONTROL ADD BUTTON,    hDlg, %IDC_btnSend, "&Send", 250, 145, 50, 20
    CONTROL ADD STATUSBAR, hDlg, %IDC_STATUSBAR1, "", 5, 195, 90, 15
    CONTROL ADD LABEL,     hDlg, %IDC_LABEL2, "Sender", 5, 10, 35, 10
    CONTROL ADD LABEL,     hDlg, %IDC_LABEL3, "Receiver", 5, 30, 35, 10
    CONTROL ADD LABEL,     hDlg, %IDC_LABEL4, "Message", 5, 65, 40, 15
    CONTROL ADD BUTTON,    hDlg, %IDC_btnClose, "&Close", 5, 140, 55, 20
#PBFORMS END DIALOG

    DIALOG SHOW MODAL hDlg, CALL ShowSendMessageProc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_SendMessage
#PBFORMS END CLEANUP

    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------

FUNCTION SaveMessage(BYVAL hDlg AS LONG) AS LONG
     LOCAL sTimeSent, sSender, sReceiver, sMessage, sInsert AS STRING
     LOCAL Errorcode, SaveAns, lRow, iItem AS LONG
     LOCAL LastRowID AS LONG

     CONTROL GET TEXT hDlg, %IDC_Sender  TO sSender
     IF TRIM$(sSender) = "" THEN
          MSGBOX "Please, Enter Sender", %MB_TASKMODAL OR %MB_ICONINFORMATION, EXE.NAME$
          CONTROL SET FOCUS hDlg, %IDC_Sender
          EXIT FUNCTION
     END IF

     CONTROL GET TEXT hDlg, %IDC_Receiver TO sReceiver
     IF TRIM$(sReceiver) = "" THEN
          MSGBOX "Please, Enter Receiver", %MB_TASKMODAL OR %MB_ICONINFORMATION, EXE.NAME$
          CONTROL SET FOCUS hDlg, %IDC_Receiver
          EXIT FUNCTION
     END IF

     CONTROL GET TEXT hDlg, %IDC_Message TO sMessage
     IF TRIM$(sMessage) = "" THEN
          MSGBOX "Please, Enter Message", %MB_TASKMODAL OR %MB_ICONINFORMATION, EXE.NAME$
          CONTROL SET FOCUS hDlg, %IDC_Message
          EXIT FUNCTION
     END IF

     slOpen $MessageDatabase
     slExe "Begin"
       
  slexe "insert into MessageTable (TimeSent, Sender, Receiver, Message) values (datetime('now','localtime'), '"+ sSender +"', '"+ sReceiver +"', '"+ sMessage + "');"

     slExe "End"

    IF slGetChangeCount = 0 THEN

        ? "Record Not Saved!", %MB_TASKMODAL OR %MB_ICONINFORMATION, EXE.NAME$

        EXIT FUNCTION

    ELSE

        LastRowID = slGetInsertID
        LISTVIEW GET COUNT hDlg, %IDC_MessageListview TO lRow
        INCR lRow
        LISTVIEW INSERT ITEM hDlg, %IDC_MessageListview, iItem, 0, FORMAT$(LastRowID)
        LISTVIEW SET TEXT hDlg, %IDC_MessageListview, iItem, 1, FORMAT$(lRow)
        LISTVIEW SET TEXT hDlg, %IDC_MessageListview, iItem, 2, sTimeSent
        LISTVIEW SET TEXT hDlg, %IDC_MessageListview, iItem, 3, sSender
        LISTVIEW SET TEXT hDlg, %IDC_MessageListview, iItem, 4, sReceiver
        LISTVIEW SET TEXT hDlg, %IDC_MessageListview, iItem, 5, sMessage

        LISTVIEW VISIBLE hDlg, %IDC_MessageListview, lRow


         SaveAns& = MSGBOX("Record Saved:" & $CRLF & "Add another record?", %MB_YESNO OR %MB_ICONQUESTION OR %MB_TASKMODAL, EXE.NAME$)

         IF SaveAns = %IDYES THEN
                ClearMessage(hDlg)
'                LISTVIEW RESET hDlg, %IDC_MessageListview
                BrowseMessageRecords(hDlg)
         ELSEIF SaveAns = %IDNO THEN
                DIALOG END hDlg
         END IF

   END IF
END FUNCTION

FUNCTION ClearMessage(BYVAL hDlg AS LONG) AS LONG


     CONTROL SET TEXT hDlg, %IDC_Sender, ""
     CONTROL SET TEXT hDlg, %IDC_Receiver, ""
     CONTROL SET TEXT hDlg, %IDC_Message, ""

     CONTROL SET FOCUS hDlg, %IDC_Sender

END FUNCTION

FUNCTION MessageHeader(BYVAL hDlg AS LONG) AS LONG

        LISTVIEW INSERT COLUMN hDlg, %IDC_MessageListview, 1, "RecNo", 0, 0
        LISTVIEW INSERT COLUMN hDlg, %IDC_MessageListview, 2, "Row", 50, 0
        LISTVIEW INSERT COLUMN hDlg, %IDC_MessageListview, 3, "Time Sent", 150, 0
        LISTVIEW INSERT COLUMN hDlg, %IDC_MessageListview, 4, "Sender", 100, 0
        LISTVIEW INSERT COLUMN hDlg, %IDC_MessageListview, 5, "Receiver", 100, 0
        LISTVIEW INSERT COLUMN hDlg, %IDC_MessageListview, 6, "Message", 400, 0

END FUNCTION

FUNCTION BrowseMessageRecords(BYVAL hDlg AS LONG) AS LONG
        LOCAL iItem&
        LOCAL SNo AS LONG
        LOCAL j     AS LONG    ' Row counter variable
        LOCAL ROW AS DWORD, COL AS LONG, ColumnCount AS LONG
        LOCAL x AS LONG
        LISTVIEW RESET hDlg, %IDC_MessageListview

        slOpen $MessageDatabase
        slSEL "SELECT RowID as RecordNo, * from " +$MessageTable + " order by rowid desc"

        ColumnCount = slGetColumnCount
        DO WHILE slGetRow
        INCR ROW
        INCR SNo
        LISTVIEW INSERT ITEM hDlg, %IDC_MessageListview,ROW, 0 , slFN("RecordNo") 'Insert row, 0=no image
        FOR COL = 1 TO ColumnCount                               'add text into columns
          LISTVIEW SET TEXT hDlg, %IDC_MessageListview, ROW, COL,slF(COL)
        NEXT

        IF ROW =30 THEN
          CONTROL REDRAW hDlg, %IDC_MessageListview
        ELSEIF ROW MOD 1000 = 0  THEN          'refresh screen every so often
          'Message hDlg, "Reading row" + STR$(ROW)
          'DOEVENTS4
        END IF
      LOOP
END FUNCTION

   FUNCTION RefreshMessages(BYVAL hDlg AS LONG) AS LONG

        LISTVIEW RESET hDlg, %IDC_MessageListview
        BrowseMessageRecords(hDlg)

   END FUNCTION

Fredrick O. Ughimi<br /><br />fughimi@gmail.com<br />- Freedom lies in being bold -- Robert Frost, Poet