Net sticky code

E Dingsor

Member

Join Date: Nov 1999
Posts: 160

7 Apr 2008, 01:13 PM

Hi,
This is the result of the discussions in thread http://www.powerbasic.com/support/pb...ad.php?t=36666.

I have taken the freedom of expanding the code of Ian Cairns(see: http://www.powerbasic.com/support/pb...ghlight=sticky ) and added a TCP facility. The program now is a TCP server also. Users can write a message on a note and send it to another user and the message will show up as a note on the recipients screen. Invaluable code also shared by Pierre Bellisle, http://www.powerbasic.com/support/pb...ad.php?t=24781. Users can download the nessecary files from Cairns link and replace mrsticky.bas/inc with Net sticky.bas, Sticky_TCP and sticky.ini

Have fun.

Eigil

Code:

'------------ Net Sticky.BAS------------------
' Changes: Dec 6, 2004. Removed accelerator table as unnecessary
' Dec 6, 2004. Alteration to allow Paste to add more text than will show in one screen.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' MrSticky - Copyright Ian Cairns, November 6, 2004; December 6, 2004.
' When invoked, Mr. Sticky sits on the taskbar. Left clicks spawn new notes. Right click for options.
' Creates up to 10 "on top" 'Sticky notes' that can be used to hold bits of information.
' You can do the standard cut/copy/paste functions, sort of like a multiple clipboard.
' Windows are resizeable and moveable (CTRL+LButton Drag).
' You can select default fonts, sizes, placement, colors.
' Have fun with it. Regards, Ian Cairns.
' Post any comments to: <http://www.powerbasic.com/support/forums/Forum4/HTML/011226.html>
'
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
#COMPILE EXE  "NetSticky.exe"
#INCLUDE "WIN32API.INC"
#INCLUDE "COMDLG32.INC"
#INCLUDE "RichEdit.INC"
#INCLUDE "c:\pbwin80\samples\MrSticky.inc"
#RESOURCE "c:\pbwin80\samples\MrSticky.pbr"
#INCLUDE "WS2_32.inc"
#INCLUDE "iphlpapi.inc"
#INCLUDE "c:\pbwin80\samples\WSAGetLastError.inc"
#INCLUDE "c:\pbwin80\samples\Sticky_TCP.bas"

%pb_IDOK = 50
%dlgOptions = 100
%pb_Font = 101
%pb_Color = 102
%lb_Font = 103
%lb_Color = 104
%ed_Text = 300
%MAXNOTES = 15    'Define max # notes
%ID_RICHEDIT = 400 ' Define RichEdit Dialog ID.
'----------------------------
%WM_TRAYICON = %WM_USER + 400
%IDM_OPTIONS = %WM_USER + 401
%IDM_DELETE = %WM_USER + 402
%IDM_ABOUT = %WM_USER + 403
%IDM_EXIT = %WM_USER + 404
%IDM_MENU = %WM_USER + 410
%IDM_HELP = %WM_USER + 411
%IDM_DSIZE = %WM_USER + 420
%IDM_DPOS = %WM_USER + 421
%IDM_CLOSE = %WM_USER + 422
%IDM_SENDTO = %WM_USER + 423
%IDM_SAVESETTINGS =%WM_USER + 450
%IDM_HIDEWINDOWS =%WM_USER + 460
%IDM_SHOWWINDOWS =%WM_USER + 470
%SET_FRAMECONTENT = %WM_USER + 430 ' For Painting demo color
%ID_RestoreWindows = %WM_USER + 431 ' For restoring any previous sticky notes
'----------------------------
TYPE StickyDefaultTYPE ' gStickyDefs - For All Sticky Notes
    sLogFont AS LOGFONT ' Selected Font
    sFontKolor AS LONG ' and text color
    sFontSize AS LONG ' Point size (for display only)
    sBkgKolor AS LONG ' Sticky Note Background Color
    sDskPos AS POINTAPI ' Default desktop row,col position of upper-left window
    sWinSize AS POINTAPI ' Default: Width, height of Sticky Note
END TYPE
TYPE StickyOpsTYPE ' gStickyOps(1:%MAXNOTES) - For each individual Sticky Note
    hWnd AS DWORD ' Window Handle
    hEdit AS DWORD ' Edit Control handle
    sDskPos AS POINTAPI ' Desktop row,col position of upper-left window
    sWinSize AS POINTAPI ' Width, height of Sticky Note
    lRecvWindow AS LONG  'True if note is a recieve note i.e have different background color
END TYPE

TYPE NoteInfoTYPE ' For saving info to file
    NoteLen AS LONG ' length of text being saved/restored
    sDskPos AS POINTAPI ' Desktop row,col position of upper-left window
    sWinSize AS POINTAPI ' Width, height of Sticky Note
END TYPE

GLOBAL gHinst AS DWORD, gStickyOps AS StickyOpsTYPE, _
gStickyDefs AS StickyDefaultTYPE, g_hFontEd AS DWORD, gDeskTop AS RECT, _
g_BkgBrush AS LONG, gNoNotes AS LONG, gOldEditProc AS DWORD,gStickyREcv AS StickyDefaultTYPE
'For richEdit
GLOBAL gREpos AS LONG, gREptr AS LONG, gREtxt AS STRING,Ghwnd AS LONG
DECLARE CALLBACK FUNCTION HelpBoxProc
DECLARE FUNCTION FindEditHandleFromWndHandle(hWnd AS DWORD, i AS LONG) AS DWORD
DECLARE FUNCTION FindWindowHandleFromEditHandle(hEdit AS DWORD) AS DWORD
DECLARE FUNCTION RestoreStickyNotes(szSavePath AS ASCIIZ, hWnd AS DWORD) AS LONG
DECLARE FUNCTION SaveStickyNotes(szSavePath AS ASCIIZ) AS LONG
DECLARE FUNCTION ReadDefaults(szDefPath AS ASCIIZ) AS LONG
DECLARE FUNCTION WriteDefaults(szDefPath AS ASCIIZ) AS LONG
DECLARE FUNCTION ReCreateEditWindows() AS LONG
DECLARE SUB HideWindows( lBool AS LONG)
'-------------------------------
'###############################
' ------------------------------
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL lpCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG
LOCAL hWnd AS DWORD, _
Msg AS TAGMSG, _
wc AS WNDCLASSEX, _
szString AS ASCIIZ * 30
szString = "MrSticky"
IF FindWindow(szString, "") <> 0 THEN EXIT FUNCTION 'Prevent duplicate instances
gHinst = hInstance 'store instance handle in global variable for later use
wc.cbSize = SIZEOF(wc)
wc.style = %NULL
wc.lpfnWndProc = CODEPTR(WndProc)
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = gHinst
wc.hIcon = LoadIcon( gHinst, "STICKY")
wc.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wc.hbrBackground = %COLOR_APPWORKSPACE + 1
wc.lpszMenuName = %NULL
wc.lpszClassName = VARPTR(szString)
wc.hIconSm = LoadIcon( gHinst, "STICKY")
RegisterClassEx wc


'Create a main window On Taskbar
hWnd = CreateWindowEx(%WS_EX_TOOLWINDOW, szString, $Programname, %NULL, _
0, 0, 0, 0, 0, 0, gHinst, BYVAL 0&)
Ghwnd =  hWnd 'Save the handle in a global variable


'Owned Windows need their own Window Handler
szString = "StNote"
wc.lpfnWndProc = CODEPTR(StickyProc)
wc.hbrBackground = GetStockObject(%WHITE_BRUSH)
wc.lpszClassName = VARPTR(szString)
RegisterClassEx wc



WHILE GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
WEND
END FUNCTION
'-------------------------------
'###############################
' ------------------------------
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL retCode AS LONG, _
pt AS POINTAPI, _
hMenu AS DWORD, _
rectA AS RECT, _
szString AS ASCIIZ * 30
STATIC ti AS NOTIFYICONDATA, _
hLib AS DWORD, _
szSavePath AS ASCIIZ * %MAX_PATH, _
szDefPath AS ASCIIZ * %MAX_PATH
DIM gStickyOps(1 TO %MAXNOTES) AS GLOBAL StickyOpsTYPE
'----------For TCP traffic----------------
STATIC fRecv       AS DWORD
 STATIC fMyPort     AS DWORD
 STATIC MyIp        AS DWORD
 STATIC dwIpRemote  AS DWORD
 STATIC MyPort      AS DWORD
 STATIC RemotePort  AS DWORD
 STATIC fRemotePort AS DWORD
LOCAL sBuffer,sBigBuffer AS STRING

'------------------------------------------
SELECT CASE wMsg
CASE %WM_CREATE 'sent by CreateWindowEx, when Main window is created
'-----TCP STUFF---------------
CALL InitiateVariables
'Start TCP Server
fMyPort = FREEFILE
MyPort =g_lTCPPort
RemotePort =g_lTCPPort
  TCP OPEN SERVER PORT MyPort AS fMyPort TIMEOUT %TIMEOUT
       IF ERR THEN
             MSGBOX "Error D: Choose another local port, " & ERROR$(ERR) & " on" & STR$(MyPort)
             TCP CLOSE fMyPort
             fMyPort = %INVALID_SOCKET
           ELSE
            TCP NOTIFY fMyPort, ACCEPT TO hwnd AS %TCP_ACCEPT
           END IF
'-----------END TCP --------------
' 1~~~~~~~~~~~~~~
' Load RichEdit's dll
hLib = LoadLibrary("RICHED32.DLL")
ti.cbSize = SIZEOF(ti) 'fill structure with proper data
ti.hWnd = hWnd
ti.uID = gHinst
ti.uFlags = %NIF_ICON OR %NIF_MESSAGE OR %NIF_TIP
ti.uCallbackMessage = %WM_TRAYICON
ti.hIcon = LoadIcon( gHinst, "STICKY")
ti.szTip = " Net Sticky "
Shell_NotifyIcon %NIM_ADD, ti 'add icon to Tray
' Set Defaults
gNoNotes = 0
CALL GetModuleFileName(0,szSavePath,%MAX_PATH)
szSavePath = LEFT$(szSavePath, INSTR(-1,szSavePath, ANY "\:") )
szDefPath = szSavePath + "NetSticky.def" ' Holds Overall Defaults
szSavePath = szSavePath + "NetSticky.sav" ' Contents of StickyNotes on exit
CALL ReadDefaults(szDefPath)
g_hFontEd = CreateFontIndirect(gStickyDefs.sLogFont)
g_BkgBrush = CreateSolidBrush(gStickyDefs.sBkgKolor)
SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(gDeskTop), 0
IF gStickyDefs.sDskPos.x < 0 THEN ' forces default to upper right side of desktop
    gStickyDefs.sDskPos.x = gDesktop.nRight - gStickyDefs.sWinSize.x
    gStickyDefs.sDskPos.y = 0
END IF
PostMessage hWnd, %ID_RestoreWindows, 0, 0 ' Display any saved notes
FUNCTION = 0 : EXIT FUNCTION

CASE %ID_RestoreWindows


' 1~~~~~~~~~~~~~~~~~~~~~~
' If desktop impinges on Sticky Window, adjust defaults.
CALL RestoreStickyNotes(szSavePath, hWnd)


CASE %WM_TRAYICON
' 1~~~~~~~~~~~~~~~~
SELECT CASE LOWRD(lParam)

CASE %WM_LBUTTONUP ' Spawn New Sticky Note
' 2~~~~~~~~~~~~~~~~~
IF gNoNotes < %MAXNOTES THEN
    szString = "StNote"
    CreateWindowEx %WS_EX_TOOLWINDOW OR %WS_EX_TOPMOST, _
    szString, "", %WS_POPUP OR %WS_SIZEBOX, _
    gStickyDefs.sDskPos.x, gStickyDefs.sDskPos.y, _
    gStickyDefs.sWinSize.x, gStickyDefs.sWinSize.y, _
    hWnd, BYVAL %NULL, gHinst, BYVAL 0&
END IF


CASE %WM_RBUTTONDOWN 'create and show popup menu
' 2~~~~~~~~~~~~~~~~~~~
GetCursorPos pt
SetForegroundWindow hWnd
rectA.nTop = pt.y : rectA.nLeft = pt.x : rectA.nBottom = pt.y + 10 : rectA.nRight = pt.x +10
hmenu = CreatePopupMenu
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_OPTIONS, "&Options"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_DELETE, "&Delete All Notes"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_ABOUT, "&About Net Sticky"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_HELP, "&Help"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_SHOWWINDOWS, "&Show Notes"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_HIDEWINDOWS, "&Hide Notes"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_SAVESETTINGS, "&Save"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_EXIT, "&Exit"

TrackPopupMenu hMenu, %TPM_CENTERALIGN, pt.x, pt.y, 0, hWnd, BYVAL %NULL ' rectA '%NULL
Postmessage hWnd, %WM_NULL, 0, 0
DestroyMenu hMenu
END SELECT


CASE %WM_COMMAND
' 1~~~~~~~~~~~~~~~
SELECT CASE LOWRD(wParam)
    CASE %IDM_OPTIONS
    ' 2~~~~~~~~~~~~~~~~
    retCode = DialogBox (ghInst, BYVAL(CDWD(%dlgOptions)), hWnd, CODEPTR(StickyOpsProc))
    IF retCode >0 THEN ' Save altered defaults to file
    ' Delete and recreate Font/Background Info
    IF retCode = 2 THEN
    IF g_hFontEd > 0 THEN DeleteObject g_hFontEd
        g_hFontEd = CreateFontIndirect(gStickyDefs.sLogFont)
        ReCreateEditWindows
    END IF
    IF g_BkgBrush > 0 THEN DeleteObject g_BkgBrush
    g_BkgBrush = CreateSolidBrush(gStickyDefs.sBkgKolor)
    CALL WriteDefaults(szDefPath)
    FOR retCode = 1 TO gNoNotes
        invalidateRect gStickyOps(retCode).hWnd, BYVAL %NULL, %TRUE
    NEXT i
    END IF

    CASE %IDM_DELETE
    ' 2~~~~~~~~~~~~~~~
    IF gNoNotes > 0 THEN ' Destroys Notes starting at the bottom of the stack
    DO
        DestroyWindow gStickyOps(1).hWnd
        IF gNoNotes = 0 OR gStickyOps(1).hWnd = 0 THEN EXIT DO
    LOOP
    END IF
    CASE %IDM_ABOUT
    ' 2~~~~~~~~~~~~~~
    CALL HelpBoxMaker(BYVAL hWnd, BYVAL -1, BYVAL -1, _
    BYVAL 360, BYVAL 140, "About", "RTFABOUT" )

    CASE %IDM_SAVESETTINGS
        ' Save any existing Notes
    CALL SaveStickyNotes(szSavePath)

    CASE %IDM_HIDEWINDOWS

    CALL HideWindows(%TRUE)

    CASE %IDM_SHOWWINDOWS
       CALL HideWindows(%FALSE)
    CASE %IDM_HELP
    ' 2~~~~~~~~~~~~~~
    CALL HelpBoxMaker(BYVAL hWnd, BYVAL -1, BYVAL -1, _
    BYVAL 360, BYVAL 280, "Help", "RTFHELP" )
    '---------------- TCP SEND LOGIC-----------------------
    CASE %TCP_SEND_MESSAGE
          LOCAL sREmote AS STRING
          sRemote = TRIM$(g_RemoteUser.sWs)


               sRemote = ipHostNameToDottedIp( sRemote)     'Can use WS number or IP address
                 dwIpRemote = ipDottedIpToDwordIP(sRemote)

             IF fRemotePort <> %INVALID_SOCKET THEN
                 TCP CLOSE fRemotePort
                 fRemotePort = %INVALID_SOCKET
                ' MSGBOX "Port" & STR$(RemotePort) & " is closed"
               END IF

               RemotePort = g_lTCPPort

               fRemotePort = FREEFILE

               ERRCLEAR
               TCP OPEN PORT RemotePort AT sREmote AS #fRemotePort TIMEOUT %TIMEOUT
               IF ERR THEN
                 MSGBOX "Error G : " & ERROR$(ERR) & ", " & WSAGetLastErrorMsg(ERR)
              
               END IF
             'send message
              TCP SEND fRemotePort, g_TextToSend

            

    'CBWPARAM        = (FreeFile)
       'HIWRD(CBLPARAM) = Error code
       'LOWRD(CBLPARAM) = Event code
       '  1 = %FD_READ    Data is available to be read from the socket.
       '  2 = %FD_WRITE   The socket is ready for data to be written.
       '  8 = %FD_ACCEPT  The socket is able to accept a new connection.
       ' 16 = %FD_CONNECT The connection has been established.
       ' 32 = %FD_CLOSE   The socket has been closed.


CASE %IDM_EXIT 'user selected Exit from menu

CALL LogOff
'------------ TCP STUFF--------------
IF fRecv       <> %INVALID_SOCKET THEN TCP CLOSE fRecv
IF fMyPort     <> %INVALID_SOCKET THEN TCP CLOSE fMyPort
IF fRemotePort <> %INVALID_SOCKET THEN TCP CLOSE fRemotePort
'------------------------------------------
' 2~~~~~~~~~~~~~
' Save any existing Notes before exiting
CALL SaveStickyNotes(szSavePath)
SendMessage hWnd, %WM_CLOSE, 0, 0

FUNCTION = 0 : EXIT FUNCTION


END SELECT
CASE %TCP_ACCEPT ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     SELECT CASE LOWRD(LPARAM) 'or LO(WORD, CBLPARAM)

       CASE %FD_ACCEPT
         
         IF fRecv <> %INVALID_SOCKET THEN
           TCP CLOSE fRecv
           fRecv = %INVALID_SOCKET
          
         END IF
         fRecv = FREEFILE
         TCP ACCEPT fMyPort AS fRecv
         TCP NOTIFY fRecv, RECV CLOSE TO Ghwnd AS %TCP_RECV
        
     END SELECT
     FUNCTION = 1

   'CBWPARAM        = (FreeFile)
   'HIWRD(CBLPARAM) = Error code
   'LOWRD(CBLPARAM) = Event code
   '  1 = %FD_READ    Data is available to be read from the socket.
   '  2 = %FD_WRITE   The socket is ready for data to be written.
   '  8 = %FD_ACCEPT  The socket is able to accept a new connection.
   ' 16 = %FD_CONNECT The connection has been established.
   ' 32 = %FD_CLOSE   The socket has been closed.

 CASE %TCP_RECV ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    
     SELECT CASE LOWRD(LPARAM) 'or LO(WORD, CBLPARAM)

       CASE %FD_READ ' 1 - Data is available to be read from the socket.
         IF fRecv <> %INVALID_SOCKET THEN

           sBuffer = ""
           sBigBuffer = ""

           DO
             TCP RECV fRecv, 1024, sBuffer
             sBigBuffer = sBigBuffer & sBuffer
           LOOP UNTIL sBuffer = "" OR ISTRUE EOF(fRecv) OR ISTRUE ERR
       
         IF gNoNotes < %MAXNOTES THEN
             'check if screen position and size is submitted
           IF LEFT$(sBuffer,4) <> "<PO>" THEN
            g_x =gStickyDefs.sDskPos.x
            g_y =  gStickyDefs.sDskPos.y
            g_W =gStickyDefs.sWinSize.x
            g_H =gStickyDefs.sWinSize.y
            ELSE

            g_x = CLNG(VAL(MID$(sbuffer,5,15)))
            g_y = CLNG(VAL(MID$(sbuffer,16,15)))
            g_w = CLNG(VAL(MID$(sbuffer,31,15)))
            g_h = CLNG(VAL(MID$(sbuffer,46,15)))
           END IF
           'remove position info
           sBuffer = RIGHT$(sBuffer,LEN(sBuffer)-64)
             LOCAL hwndRecv,hEditRecv AS DWORD, i AS LONG
                szString = "StNote"
                hwndRecv =CreateWindowEx( %WS_EX_TOOLWINDOW OR %WS_EX_TOPMOST, _
                szString, "", %WS_POPUP OR %WS_SIZEBOX, _
                g_x, g_y, _
                g_w, g_h, _
                hWnd, BYVAL %NULL, gHinst, BYVAL 0&  )
                hEditRecv =FindEditHandleFromWndHandle(hwndRecv, i)
                gStickyOps(i).lRecvWindow = %TRUE    'this note will get bacground as defined in ini file
                g_RecvEdit =  hEditRecv
                gREtxt=sBigBuffer
                SendMessage hEditRecv, %WM_SETTEXT, 0, STRPTR(sBuffer) 'send text to note

          END IF
      END IF

       CASE %FD_WRITE   ' 2 - The socket is ready for data to be written.
       
       CASE %FD_CONNECT '16 - The connection has been established.
        
       CASE %FD_CLOSE   '32 - The socket has been closed.
      
         TCP CLOSE fRecv
         fRecv = %INVALID_SOCKET
        

     END SELECT
     FUNCTION = 1
CASE %WM_DESTROY 'clean up at exit
    CALL LogOff  'clean up TCP stuff
' 1~~~~~~~~~~~~~~~
Shell_NotifyIcon %NIM_DELETE, ti 'remove icon from Tray
DestroyIcon ti.hIcon ' And destroy it
IF g_hFontEd > 0 THEN DeleteObject g_hFontEd ' And Font
IF g_BkgBrush > 0 THEN DeleteObject g_BkgBrush ' And Brush
IF gNoNotes > 0 THEN
DO
DestroyWindow gStickyOps(1).hWnd
IF gNoNotes = 0 OR gStickyOps(1).hWnd = 0 THEN EXIT DO
LOOP
END IF
PostQuitMessage 0
END SELECT

FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
'-------------------------------
'###############################
' ------------------------------
FUNCTION SaveStickyNotes(szSavePath AS ASCIIZ) AS LONG
' returns %FALSE for no errors, %TRUE for unable to write file
LOCAL fhandle AS LONG, _
i AS LONG, _
txtLen AS LONG, _
tString AS STRING, _
nString AS STRING, _
NoteInfo AS NoteInfoTYPE
' Allow for existence of file/write-protected disk/Permission denied first! Exit routine if found.
ON ERROR GOTO SaveNotesError
' Delete any existing file first
IF DIR$(szSavePath) <> "" THEN
KILL szSavePath
END IF
' Exit if nothing to save
IF gNoNotes < 1 THEN
FUNCTION = 0
EXIT FUNCTION
END IF
' Start Save Operation
fhandle = FREEFILE
OPEN szSavePath FOR BINARY AS # fhandle
PUT #fhandle, , gNoNotes
nString = SPACE$(LEN(NoteInfo)) ' String for moving UDT in/out of file
FOR i = 1 TO gNoNotes
NoteInfo.sDskPos = gStickyOps(i).sDskPos
NoteInfo.sWinSize = gStickyOps(i).sWinSize
' Get Text length, create a string buffer and fill it with text
txtLen = SendMessage( gStickyOps(i).hEdit, %WM_GETTEXTLENGTH, 0, 0)
NoteInfo.NoteLen = txtLen
IF txtLen > 0 THEN
NoteInfo.NoteLen = txtLen+1
tString = SPACE$(txtLen + 1)
SendMessage gStickyOps(i).hEdit, %WM_GETTEXT, txtLen + 1, STRPTR(tString)
ELSE
tString = ""
END IF
LSET nString = NoteInfo
PUT$ # fhandle, nString
IF NoteInfo.NoteLen > 0 THEN
PUT$ # fhandle, tString
END IF
NEXT i
CLOSE #fhandle
ON ERROR GOTO 0
FUNCTION = 0 : EXIT FUNCTION
SaveNotesError:
'~~~~~~~~~~~~~~
fhandle = ERRCLEAR
FUNCTION = 1
END FUNCTION
'-------------------------------
'###############################
' ------------------------------
FUNCTION RestoreStickyNotes(szSavePath AS ASCIIZ, hWnd AS DWORD) AS LONG
' Returns 0 for success, 1 for no file/failure
LOCAL fhandle AS LONG, _
tmpNoNotes AS LONG, _
i AS LONG, _
tString AS STRING, _
nString AS STRING, _
NoteInfo AS NoteInfoTYPE
ON ERROR GOTO RestoreNotesError
gNoNotes = 0
IF DIR$(szSavePath) = "" THEN
FUNCTION = 1
EXIT FUNCTION
END IF
fhandle = FREEFILE
OPEN szSavePath FOR BINARY AS # fhandle
' Note: You cannot fill gNoNotes with a value. This happens on window creation!
GET #fhandle, ,tmpNoNotes
IF tmpNoNotes = 0 OR tmpNoNotes > %MAXNOTES THEN
CLOSE # fhandle
KILL szSavePath
FUNCTION = 1
EXIT FUNCTION
END IF
FOR i = 1 TO tmpNoNotes
    GET$ #fhandle,LEN(NoteInfo), nString
    LSET NoteInfo = nString
    gStickyOps(i).sDskPos = NoteInfo.sDskPos
    gStickyOps(i).sWinSize = NoteInfo.sWinSize
    IF NoteInfo.NoteLen > 0 THEN
    GET$ # fhandle, NoteInfo.NoteLen, tString
    END IF
    CreateWindowEx %WS_EX_TOOLWINDOW, "stNote", "", %WS_POPUP OR %WS_SIZEBOX, _
    gStickyOps(i).sDskPos.x, gStickyOps(i).sDskPos.y, _
    gStickyOps(i).sWinSize.x, gStickyOps(i).sWinSize.y, _
    hWnd, BYVAL %NULL, gHinst, BYVAL 0&
    SLEEP 0 ' Allow time for Edit Window creation
    IF NoteInfo.NoteLen > 0 THEN
    SendMessage gStickyOps(i).hEdit, %WM_SETTEXT, 0, STRPTR(tString)
    END IF
NEXT i
CLOSE #fhandle
ON ERROR GOTO 0
FUNCTION = 0 : EXIT FUNCTION
RestoreNotesError:
'~~~~~~~~~~~~~~~~~
fhandle = ERRCLEAR
FUNCTION = 1
END FUNCTION
'-------------------------------
'###############################
' ------------------------------
FUNCTION ReCreateEditWindows() AS LONG
' Save Window text to a buffer, destroy the Edit window, recreate the window and re-insert the text
LOCAL i AS LONG, _
hEdit AS DWORD, _
hWnd AS DWORD, _
txtLen AS LONG, _
tString AS STRING, _
rectC AS RECT
FOR i = 1 TO gNoNotes
hWnd = gStickyOps(i).hWnd
hEdit = gStickyOps(i).hEdit
' Get Text length, create a string buffer and fill it with current text (if any)
txtLen = SendMessage( hEdit, %WM_GETTEXTLENGTH, 0, 0)
IF txtLen > 0 THEN
tString = SPACE$(txtLen + 1)
SendMessage gStickyOps(i).hEdit, %WM_GETTEXT, txtLen + 1, STRPTR(tString)
ELSE
tString = ""
END IF
' Remove Subclass reference and destroy the current edit window
IF gOldEditProc > 0 THEN
CALL SetWindowLong(hEdit, %GWL_WNDPROC, gOldEditProc)
END IF
DestroyWindow hEdit
' Now recreate the window
CALL GetClientRect(gStickyOps(i).hWnd, rectC)
hEdit = CreateWindow("EDIT", "", %WS_CHILD OR %WS_VISIBLE OR _
%ES_MULTILINE OR %ES_LEFT, _ ' or %WS_VSCROLL, _
0,0,rectC.nRight, rectC.nBottom, _
hWnd, %ed_Text, gHinst, BYVAL %NULL)
gStickyOps(i).hEdit = hEdit
SendMessage hEdit, %WM_SETFONT, g_hFontEd, 0
' Subclass the Edit Control for dragging and Menu
gOldEditProc = SetWindowLong(hEdit, %GWL_WNDPROC, CODEPTR(EditSubClassProc))
' Put the text pack into the edit window
IF txtLen > 0 THEN
SendMessage hEdit, %WM_SETTEXT, 0, STRPTR(tString)
END IF
NEXT i
END FUNCTION
'-------------------------------
'###############################
' ------------------------------
FUNCTION StickyProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL hEdit AS LONG, _
hMenu AS DWORD, _
i AS LONG, _
pt AS POINTAPI, _
rectC AS RECT
SELECT CASE wMsg
CASE %WM_CREATE
' 1~~~~~~~~~~~~~~
INCR gNoNotes
gStickyOps(gNoNotes).hWnd = hWnd ' Save Window Handle
IF gStickyOps(gNoNotes).sWinSize.y = 0 THEN ' Creating a new note (not restoring)
gStickyOps(gNoNotes).sDskPos = gStickyDefs.sDskPos
gStickyOps(gNoNotes).sWinSize = gStickyDefs.sWinSize
END IF
SetWindowPos hWnd, %HWND_TOPMOST, 0,0,0,0, %SWP_NOMOVE OR %SWP_NOSIZE
ShowWindow hWnd, %SW_SHOW
UpdateWindow hWnd
' Now give it a writing surface: Text control
CALL GetClientRect(hWnd, rectC)
hEdit = CreateWindow("EDIT", "", %WS_CHILD OR %WS_VISIBLE OR _
%ES_MULTILINE OR %ES_LEFT, _
0,0,rectC.nRight, rectC.nBottom, _
hWnd, %ed_Text, gHinst, BYVAL %NULL)
gStickyOps(gNoNotes).hEdit = hEdit
SendMessage hEdit, %WM_SETFONT, g_hFontEd, 0
' Subclass the Edit Control for dragging and Menu
gOldEditProc = SetWindowLong(hEdit, %GWL_WNDPROC, CODEPTR(EditSubClassProc))
' Get a caret on our new window, get ready for text entry
SetForegroundWindow hEdit
CASE %WM_LBUTTONDOWN ' Message relayed from Edit Window allows dragging note
' 1~~~~~~~~~~~~~~~~~~~
CALL SendMessage(hWnd, %WM_NCLBUTTONDOWN, %HTCAPTION, BYVAL %NULL)
FUNCTION = 0 : EXIT FUNCTION
CASE %IDM_MENU ' Menu - Delete (or Escape),
' 1~~~~~~~~~~~~~ Set Size as default, Set Position as default, On Top checked/unchecked
GetCursorPos pt
SetForegroundWindow hWnd
CALL FindEditHandleFromWndHandle(hWnd, i)

hmenu = CreatePopupMenu
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_DSIZE, "Set &Size as Default"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_DPOS, "Set &Position as Default"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_HELP, "&Help"
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_CLOSE, "&Close Note"
AppendMenu hMenu, %MF_SEPARATOR    ,BYVAL %NULL ,  ""
AppendMenu hMenu, %MF_STRING OR %MF_ENABLED, %IDM_SENDTO, "&Send Note to"
TrackPopupMenu hMenu, %TPM_CENTERALIGN, pt.x, pt.y, 0, hWnd, BYVAL %NULL
Postmessage hWnd, %WM_NULL, 0, 0
DestroyMenu hMenu
CASE %WM_CTLCOLOREDIT

    hEdit = FindEditHandleFromWndHandle(hWnd, i)

  IF gStickyOps(i).lRecvWindow = %TRUE  THEN 'recvWindow
         SetBkColor wParam, g_RecvColor
        SetBkMode wParam,%OPAQUE
             FUNCTION = g_RecvBrush
             EXIT FUNCTION
        ELSE
           ' 1~~~~~~~~~~~~~~~~~~~~
        SetBkColor wParam, gStickyDefs.sBkgKolor
        SetTextColor wParam, gStickyDefs.sFontKolor
        SetBkMode wParam,%OPAQUE

        FUNCTION = g_BkgBrush
         EXIT FUNCTION
END IF



CASE %WM_EXITSIZEMOVE ' Adjust Edit window size
' 1~~~~~~~~~~~~~~~~~~~~
CALL GetClientRect (hWnd, RectC) ' get current size of Client Area
IF RectC.nBottom <20 OR RectC.nRight < 20 THEN
' Resize Window to minimums
GetWindowRect hWnd, rectC
IF rectC.nRight - rectC.nLeft < 20 THEN rectC.nRight = rectC.nLeft + 20
IF rectC.nBottom - rectC.nTop < 20 THEN rectC.nBottom = rectC.nTop + 20
MoveWindow hWnd,rectC.nLeft, rectC.nTop, rectC.nRight-rectC.nLeft,_
rectC.nBottom-rectC.nTop, %TRUE
GetClientRect hWnd, rectC
END IF
hEdit = FindEditHandleFromWndHandle(hWnd, i) ' Find associated Edit window
IF hEdit > 0 THEN
MoveWindow hEdit, rectC.nLeft, rectC.nTop, rectC.nRight, rectC.nBottom, %TRUE
CALL GetWindowRect(hWnd, rectC)
gStickyOps(i).sWinSize.x = rectC.nRight - rectC.nLeft
gStickyOps(i).sWinSize.y = rectC.nBottom - rectC.nTop
gStickyOps(i).sDskPos.x = rectC.nLeft
gStickyOps(i).sDskPos.y = rectC.nTop
END IF
FUNCTION = 0
CASE %WM_COMMAND
' 1~~~~~~~~~~~~~~~
SELECT CASE LOWRD(wParam)
    CASE %IDM_DSIZE ' set size as default
    ' 2~~~~~~~~~~~~~~
    CALL GetWindowRect(hWnd, rectC)
    gStickyDefs.sWinSize.x = rectC.nRight - rectC.nLeft
    gStickyDefs.sWinSize.y = rectC.nBottom - rectC.nTop
    CASE %IDM_DPOS ' set desktop position as default
    ' 2~~~~~~~~~~~~~~
    CALL GetWindowRect(hWnd, rectC)
    gStickyDefs.sDskPos.x = rectC.nLeft
    gStickyDefs.sDskPos.y = rectC.nTop
    CASE %IDM_HELP
    ' 2~~~~~~~~~~~~~~
    CALL HelpBoxMaker(BYVAL hWnd, BYVAL -1, BYVAL -1, _
    BYVAL 360, BYVAL 280, "Help", "RTFHELP" )
    CASE %IDM_CLOSE ' Close this note
    ' 2~~~~~~~~~~~~~~
    SendMessage hWnd, %WM_CLOSE, 0, 0

    CASE %IDM_SENDTO ' Send this note to nUSER via TCP
        'Grab text in Note
        LOCAL sNotetext,sReturninfo AS STRING,mUSER AS USERINFO
        mUSER =g_Iam
        hEdit = FindEditHandleFromWndHandle(hWnd, i)
        CALL GetClientRect (hWnd, RectC) ' get current size of Client Area
        LOCAL sPos AS STRING
        DIM aPos(1 TO 4) AS STRING*15
        GetWindowRect hWnd, rectC
        g_x =rectC.nLeft
        g_Y = rectC.nTop
        g_w = rectC.nRight-rectC.nLeft
        g_h=rectC.nBottom-rectC.nTop
        aPOS(1) = STR$(g_x)
        aPOS(2) = STR$(g_y)
        aPOS(3) = STR$(g_w)
        aPOS(4) = STR$(g_h)
        sPos ="<PO>" & aPOS(1) & aPOS(2)& aPOS(3)& aPOS(4)
        sNotetext= GetRichEditText(BYVAL hEdit)
        IF LEN(sNotetext) = 0 THEN
            MSGBOX "Nothing to send",,$ProgramName
            EXIT FUNCTION
        ELSE
         CALL CheckBeforeSend(mUSER,sReturninfo)

          g_RemoteUSER = mUSER
         IF sReturninfo = "STOP" THEN EXIT FUNCTION
         'notify main windproc to send message in global buffer
           g_TextToSend = "Sent from:" &  TRIM$(g_Iam.sName) & "," & TRIM$(g_Iam.sWS) & $CRLF &  DATE$ & ", " & TIME$ & $CRLF & $CRLF & sNotetext
            g_TextToSend  = sPos & g_TextToSend
           SendMessage ghwnd,%WM_COMMAND,%TCP_SEND_MESSAGE,0
        END IF
END SELECT
CASE %WM_DESTROY 'clean up at exit
' 1~~~~~~~~~~~~~~~
hEdit = FindEditHandleFromWndHandle(hWnd, i)
IF hEdit > 0 THEN
IF gOldEditProc > 0 THEN
CALL SetWindowLong(hEdit, %GWL_WNDPROC, gOldEditProc)
END IF
DestroyWindow hEdit
' now remove reference to this Window
ARRAY DELETE gStickyOps(i)
DECR gNoNotes
END IF
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
'-------------------------------
'###############################
'-------------------------------
FUNCTION FindEditHandleFromWndHandle(hWnd AS DWORD, i AS LONG) AS DWORD
' returns Edit handle associated with Window handle
' or 0 for not found
LOCAL counter AS LONG
FUNCTION = 0
FOR counter = 1 TO gNoNotes
IF gStickyOps(counter).hWnd = hWnd THEN
FUNCTION = gStickyOps(counter).hEdit
EXIT FOR
END IF
NEXT counter
i = counter
END FUNCTION
'-------------------------------
'###############################
'-------------------------------
FUNCTION FindWindowHandleFromEditHandle(hEdit AS DWORD) AS DWORD
' returns Window handle associated with Edit handle
' or 0 for not found
LOCAL counter AS LONG
FUNCTION = 0
FOR counter = 1 TO gNoNotes
IF gStickyOps(counter).hEdit = hEdit THEN
FUNCTION = gStickyOps(counter).hWnd
EXIT FOR
END IF
NEXT counter
END FUNCTION
'-------------------------------
'###############################
'-------------------------------
FUNCTION StickyOpsProc (BYVAL hDlg AS DWORD, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
STATIC ColorStruc AS CHOOSECOLORAPI, _
cf AS CHOOSEFONTAPI, _
tStickyDefs AS StickyDefaultTYPE
LOCAL hDC AS LONG, _
hBrush AS LONG, _
hBrushOld AS LONG, _
ps AS PAINTSTRUCT,_
cHandle AS LONG, _
rectA AS RECT, _
i AS LONG, _
tString AS STRING
DIM CustColors(0 : 15) AS STATIC DWORD
SELECT CASE wMsg
CASE %WM_INITDIALOG
' 1~~~~~~~~~~~~~~~~~~
tStickyDefs = gStickyDefs
' Setup Color Structure
FOR i = 0 TO 15
CustColors(i) = 0
NEXT i
ColorStruc.lStructSize = SIZEOF(ColorStruc)
ColorStruc.hwndOwner = hDlg
ColorStruc.hInstance = %NULL
ColorStruc.rgbResult = %NULL
ColorStruc.lpCustColors = VARPTR(CustColors(0))
ColorStruc.Flags = %CC_RGBINIT OR %CC_FULLOPEN
ColorStruc.lCustData = 0
ColorStruc.lpfnHook = %NULL
ColorStruc.lpTemplateName = %NULL
' Setup Font Structures
cf.lStructSize = SIZEOF(cf)
cf.hWndOwner = hDlg
cf.hDC = %NULL
cf.lpLogFont = VARPTR(tStickyDefs.sLogFont)
cf.iPointSize = 0
cf.Flags = %CF_INITTOLOGFONTSTRUCT OR %CF_EFFECTS OR %CF_SCREENFONTS _
OR %CF_TTONLY OR %CF_SCRIPTSONLY
cf.rgbColors = tStickyDefs.sFontKolor
cf.lCustData = 0
cf.lpfnHook = %NULL
cf.lpTemplateName = %NULL
cf.hInstance = %NULL
cf.lpszStyle = %NULL
cf.nFontType = 0
cf.nSizeMin = 0
cf.nSizeMax = 0
' Paint Font Name
hdc = GetDC (hDlg)
CALL SelectObject (hdc, CreateFontIndirect(tStickyDefs.sLogFont))
CALL ReleaseDC (hDlg, hdc)
tString = LTRIM$(tStickyDefs.sLogFont.lfFaceName) + ": " + FORMAT$(tStickyDefs.sFontSize) + " point"
SetWindowText GetDlgItem(hDlg, %lb_Font), BYCOPY tString
FUNCTION = 1
CASE %WM_PAINT
' 1~~~~~~~~~~~~~
CALL BeginPaint (hDlg, ps)
CALL EndPaint (hDlg, ps)
'Paint Display Frame
CALL PostMessage(hDlg, %SET_FRAMECONTENT, 0, 0)
FUNCTION = 1
CASE %SET_FRAMECONTENT ' Paint contents of the display frame
' 1~~~~~~~~~~~~~~~~~~~~~
cHandle = GetDlgItem(hDlg, %lb_Color)
hDC = GetDC (cHandle)
' Get Area in which to draw
CALL GetClientRect (cHandle, rectA) ' Allow for edge of control.
INCR rectA.nTop : INCR rectA.nLeft : DECR rectA.nBottom : DECR rectA.nRight
' Draw Background
hBrush = CreateSolidBrush(tStickyDefs.sBkgKolor)
hBrushOld = SelectObject(hDC, hBrush)
CALL FillRect(hdc, rectA, hBrush)
' Delete GDI objects
CALL SelectObject (hDC, hBrushOld)
CALL DeleteObject (hBrush)
CALL ReleaseDC(cHandle, hdc)
FUNCTION = 1
CASE %WM_COMMAND
' 1~~~~~~~~~~~~~~~
SELECT CASE LOWRD(wParam)
CASE %pb_Color
' 2~~~~~~~~~~~~~
ColorStruc.rgbResult = tStickyDefs.sBkgKolor
IF ChooseColor ( ColorStruc ) > 0 THEN
tStickyDefs.sBkgKolor = ColorStruc.rgbResult
' Paint Dialog
CALL PostMessage(hDlg, %SET_FRAMECONTENT, 0, 0)
END IF
FUNCTION = 1
CASE %pb_Font
' 2~~~~~~~~~~~~
IF ChooseFont (cf) THEN
tStickyDefs.sFontKolor = cf.rgbColors
tStickyDefs.sFontSize = cf.iPointSize/10
hdc = GetDC (hDlg)
CALL SelectObject (hdc, CreateFontIndirect(tStickyDefs.sLogFont))
CALL ReleaseDC (hDlg, hdc)
tString = LTRIM$(tStickyDefs.sLogFont.lfFaceName) + ": " _
+ FORMAT$(tStickyDefs.sFontSize) + " point"
SetWindowText GetDlgItem(hDlg, %lb_Font), BYCOPY tString
END IF
FUNCTION = 1
CASE %pb_IDOK
' 2~~~~~~~~~~~~
IF gStickyDefs.sLogFont <> tStickyDefs.sLogfont THEN
i = 2
ELSE
i = 1
END IF
gStickyDefs = tStickyDefs
EndDialog hDlg, i
FUNCTION = 1
CASE %IDCANCEL
' 2~~~~~~~~~~~~~
EndDialog hDlg, 0
FUNCTION = 1
END SELECT
END SELECT
END FUNCTION
'-------------------------------
'###############################
'-------------------------------
FUNCTION ReadDefaults(szDefPath AS ASCIIZ) AS LONG
LOCAL fhandle AS DWORD, _
tString AS STRING
ON ERROR GOTO ReadDefaultsError
IF DIR$(szDefPath) = "" THEN
GOTO makeDefaults
END IF
fhandle = FREEFILE
OPEN szDefPath FOR BINARY AS # fhandle
GET$ #fhandle, LEN(gStickyDefs), tString
LSET gStickyDefs = tString
CLOSE #fhandle
  gStickyRecv = gStickyDefs 'assign defaults   to incoming Note size etc
ON ERROR GOTO 0
FUNCTION = 0 : EXIT FUNCTION
makeDefaults:
'~~~~~~~~~~~~
' Defaults
' Default Font 10 point Verdana
gStickyDefs.sLogFont.lfFaceName = "Verdana"
gStickyDefs.sLogFont.lfPitchAndFamily = 34
gStickyDefs.sLogFont.lfWeight = 400
gStickyDefs.sLogFont.lfHeight = -13
gStickyDefs.sLogFont.lfItalic = 0
gStickyDefs.sBkgKolor = RGB(255, 255, 130) 'Pale Yellow  RGB(204, 255, 255) ' pale blue
gStickyDefs.sFontKolor = &H0 ' Black
gStickyDefs.sFontSize = 10
gStickyDefs.sDskPos.x = -1 ' forces on upper right side of desktop
gStickyDefs.sDskPos.y = -1
gStickyDefs.sWinSize.x = 150
gStickyDefs.sWinSize.y = 300
CALL WriteDefaults(szDefPath)
 gStickyRecv = gStickyDefs 'assign defaults   to incoming Note size etc
ON ERROR GOTO 0
FUNCTION = 0 : EXIT FUNCTION
ReadDefaultsError:
'~~~~~~~~~~~~~~~~~
fhandle = ERRCLEAR
FUNCTION = 1
END FUNCTION
'-------------------------------
'###############################
'-------------------------------
FUNCTION WriteDefaults(szDefPath AS ASCIIZ) AS LONG
' returns %FALSE for no errors, %TRUE for unable to write file
LOCAL fhandle AS LONG
' Allow for existence of file/write-protected disk/Permission denied first! Exit routine if found.
ON ERROR GOTO WriteDefaultsError
fhandle = FREEFILE
OPEN szDefPath FOR BINARY AS # fhandle
PUT$ #fhandle, gStickyDefs
CLOSE #fhandle
ON ERROR GOTO 0
FUNCTION = 0 : EXIT FUNCTION
WriteDefaultsError:
'~~~~~~~~~~~~~~~~~
fhandle = ERRCLEAR
FUNCTION = 1
END FUNCTION
'-------------------------------
'###############################
'-------------------------------
' Function updated to reflect proper use of Clipboard handling.
FUNCTION EditSubClassProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
LOCAL xWnd AS DWORD, _
startPos AS LONG, _
endPos AS LONG, _
tVal AS LONG, _
oldString AS STRING, _
tString AS STRING, _
hMem AS DWORD, _
pszClipText AS ASCIIZ PTR
SELECT CASE wMsg&
CASE %WM_RBUTTONDOWN 'create and show popup menu
' ~~~~~~~~~~~~~~~~~~~~
IF ISTRUE (%MK_CONTROL AND wParam) THEN
xWnd = FindWindowHandleFromEditHandle(hWnd)
IF xWnd > 0 THEN
PostMessage xWnd, %IDM_MENU, 0, 0
END IF
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %WM_LBUTTONDOWN ' Allow dragging note
' ~~~~~~~~~~~~~~~~~~~~
IF ISTRUE (%MK_CONTROL AND wParam) THEN
xWnd = FindWindowHandleFromEditHandle(hWnd)
IF xWnd > 0 THEN
PostMessage xWnd, %WM_LBUTTONDOWN, BYVAL wParam, BYVAL lParam
END IF
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %WM_PASTE
' ~~~~~~~~~~~~~~
' Get text, if any from the clipboard
IF OpenClipboard(%NULL) = 0 THEN FUNCTION = 1 : EXIT FUNCTION
hMem = GetClipboardData (%CF_TEXT) ' get handle
pszClipText = GlobalLock (hMem) ' get pointer to the data in that handle
tString = @pszClipText ' move data to local variable
GlobalUnlock hMem ' unlock the handle
CloseClipboard ' relinquish clipboard
IF LEN(tString) < 1 THEN FUNCTION = 1 : EXIT FUNCTION
' Get Old Text length, create a string buffer and fill it with current text (if any)
tVal = SendMessage( hWnd, %WM_GETTEXTLENGTH, 0, 0)
IF tVal > 0 THEN
oldString = SPACE$(tVal + 1)
SendMessage hWnd, %WM_GETTEXT, tVal + 1, STRPTR(oldString)
' Get the position of the caret and/or selection
tVal = SendMessage( hWnd, %EM_GETSEL, 0, 0 )
startPos = LOWRD(tVal) : endPos = HIWRD(tVal) ' 0 based position of the caret and/or selection
tString = LEFT$(oldString, startPos) + tString + MID$(oldString, endPos+1)
END IF
' Paste altered text into control now.
SendMessage hWnd, %WM_SETTEXT, 0, STRPTR(tString)
FUNCTION = 1
EXIT FUNCTION
END SELECT
' Fall through to old event handler
FUNCTION = CallWindowProc(gOldEditProc,hWnd, wMsg, wParam, lParam)
END FUNCTION
'-------------------------------
'###############################
'-------------------------------
SUB RichEditSetString (BYVAL hRichEdit AS DWORD)
LOCAL eStream AS EDITSTREAM

' Insert a formatted RTF string into Rich Edit
gREpos = 1 'position in text to start from
gREptr = STRPTR(gREtxt) 'pointer to global text buffer
eStream.pfnCallback = CODEPTR(RichEditStreamInString) 'pointer to RichEdit callback procedure
SendMessage hRichEdit, %EM_STREAMIN, %SF_RTF, VARPTR(eStream) 'stream in text
END SUB
'-------------------------------
'###############################
'-------------------------------
FUNCTION RichEditStreamInString (BYVAL dwCookie AS DWORD, BYVAL pbBuff AS BYTE PTR, _
BYVAL cb AS LONG, pcb AS LONG) AS DWORD
' Rich Edit stream in callback - for streaming in string contents
pcb = cb 'number of bytes to copy
IF pcb > 0 THEN 'copy block from global string directly into Richedit's buffer.
CopyMemory pbBuff, (gREptr + gREpos - 1), pcb
gREpos = gREpos + pcb 'incr pos for next callback position.
END IF
END FUNCTION
'-------------------------------
'###############################
'-------------------------------
SUB HelpBoxMaker(BYVAL hParent AS DWORD, BYVAL xPos AS LONG, BYVAL yPos AS LONG, _
BYVAL xWidth AS LONG, BYVAL yHeight AS LONG, BYVAL inTitle AS STRING, _
BYVAL inText AS STRING)
LOCAL hDlg AS DWORD, _
lRes AS DWORD, _
lRes2 AS DWORD, _
lRes3 AS DWORD
STATIC hModInst AS DWORD
hModInst = GetModuleHandle("") 'Get Module Handle
lRes = FindResource(hModInst, BYCOPY inText, BYVAL %RT_RCDATA)'look for RTF text in resource
IF lRes THEN lRes2 = LoadResource(hModInst, lRes) 'Load it
IF lRes2 THEN lRes3 = LockResource(lRes2) 'Lock it
IF lRes3 THEN gREtxt = PEEK$(lRes3, SizeofResource(hModInst, lRes)) 'Put RTF into a global string
DIALOG NEW hParent, inTitle, xPos, yPos, xWidth, yHeight, _
%WS_CAPTION OR %WS_SYSMENU, 0 TO hDlg
CONTROL ADD "RichEdit", hDlg, %ID_RICHEDIT, "", 5, 5, xWidth - 9, yHeight - 32, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR _
%ES_AUTOVSCROLL OR %ES_MULTILINE OR %ES_NOHIDESEL OR _
%ES_READONLY OR %ES_SAVESEL, %WS_EX_CLIENTEDGE
IF LEN(gREtxt) THEN RichEditSetString GetDlgItem(hDlg, %ID_RICHEDIT)
CONTROL ADD BUTTON, hDlg, %IDCANCEL, "&Close", xWidth - 56, yHeight - 20, 50, 14
DIALOG SHOW MODAL hDlg, CALL HelpBoxProc
END SUB
'-------------------------------
'###############################
'-------------------------------
CALLBACK FUNCTION HelpBoxProc
SELECT CASE CBMSG
CASE %WM_INITDIALOG
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %IDCANCEL 'respond to ESC key (or button with %IDCANCEL id)
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN DIALOG END CBHNDL
END SELECT
END SELECT
END FUNCTION
'-------------------------------
'###############################
'-------------------------------

'-------------------------------
'Hides or shows notes on desktop
'-----------------------------------
SUB HideWindows( lBool AS LONG)
     DIM i AS LONG
    IF gNoNotes > 0 THEN ' Destroys Notes starting at the bottom of the stack
        FOR i = 1 TO gNoNotes
            IF  gStickyOps(i).hWnd = 0 THEN EXIT FOR
            IF lBool =  %TRUE  THEN
                ShowWindow gStickyOps(i).hWnd, %SW_HIDE
                ShowWindow gStickyOps(i).hEdit, %SW_HIDE
                ELSE
            ShowWindow gStickyOps(i).hWnd, %SW_SHOW
            ShowWindow gStickyOps(i).hEdit, %SW_SHOW
            END IF
         NEXT
    END IF
END SUB

'------------Sticky_TCP.bas-----------------

Code:

%SIGNIN = 110
%SIGNOUT = 120
%FINDUSER = 130
%FileSuccess = 100
%USER_NOTFOUND = 110
%USER_INACTIVE = 120
%TCP_ACCEPT           = %WM_USER + 500
%TCP_RECV             = %WM_USER + 501
%TCP_SEND_MESSAGE     = %WM_USER + 502
%TIMEOUT              = 5000 'Five second, increase if necessary

TYPE USERINFO
sname AS STRING*7
sWS AS STRING*15    'IP address/WS number

END TYPE

 '-----------------------------------------------------
$STICKYINIFILE = "STICKY.INI"
$PROGRAMNAME = "Net Sticky"
GLOBAL g_DataBAsePath AS STRING
GLOBAL g_lTCPPort AS LONG
GLOBAL g_Iam AS USERINFO 'Info from local PC
GLOBAL g_RemoteUser AS USERINFO   'Info about remote PC
GLOBAL g_exePath AS STRING
GLOBAL g_TextToSend AS STRING
GLOBAL g_RecvColor AS LONG
GLOBAL g_RecvEdit AS LONG
GLOBAL g_RecvBrush  AS LONG
GLOBAL g_x AS LONG
GLOBAL g_y AS LONG
GLOBAL g_h AS LONG
GLOBAL g_w AS LONG


FUNCTION GetExePath AS STRING
LOCAL zLpFilename AS ASCIIZ*1024
LOCAL sOutString AS STRING
LOCAL lpos AS LONG
ON ERROR GOTO feil
  GetModuleFileName  BYVAL %NULL,zLpFilename, SIZEOF(zLpFilename)
       sOutString =   zLpFilename
   'now remove the exe fiule name from string
   'search from right
   lPos = INSTR(-1,sOutString,"\")

FUNCTION = LEFT$(sOutString,lpos-1) 'don't output the last \
EXIT FUNCTION
FEil:

ERRCLEAR
RESUME NEXT
END FUNCTION

FUNCTION INI_GetKey (BYVAL IniFile AS STRING, BYVAL lSection AS STRING, BYVAL lKey AS STRING, BYVAL lDefault AS STRING) AS STRING
    DIM zText AS ASCIIZ * 512 * 2

    GetPrivateProfileString BYCOPY lSection, BYCOPY lKey, BYCOPY lDefault, zText, SIZEOF(zText), BYCOPY IniFile
    FUNCTION = zText
END FUNCTION

'Finds IP address at local machine, Assumes first found is the correct one
FUNCTION MyIPAddress() AS STRING
   LOCAL iCount   AS LONG
   LOCAL iSize    AS LONG
   LOCAL pIPADD   AS MIB_IPADDRTABLE PTR
   LOCAL sBuffer  AS STRING
   LOCAL pMask    AS BYTE PTR
   LOCAL pAddr    AS BYTE PTR
   LOCAL IpMask   AS DWORD
   LOCAL IpAddr   AS DWORD

   'First, get the size result in Ret
   IF GetIpAddrTable (BYVAL 0, iSize, 0) = %ERROR_INSUFFICIENT_BUFFER THEN
      sBuffer = SPACE$(iSize)
      IF GetIpAddrTable (BYVAL STRPTR(sBuffer), iSize, 0) = %NO_ERROR THEN
         pIPADD = STRPTR(sBuffer)
         FOR iCount = 0 TO 0' @pIPADD.dwNumEntries - 1
            IpAddr = @pIPADD.table(iCount).dwAddr

            pAddr = VARPTR(IpAddr)
            FUNCTION = USING$("#_.#_.#_.#", @pAddr[0], @pAddr[1], @pAddr[2], @pAddr[3])
         NEXT
    END IF
END IF

END FUNCTION
'Finds USERNAME and IP address name at localhost
FUNCTION Iam() AS DWORD
LOCAL p AS USERINFO
LOCAL myip AS LONG
LOCAL sbuffer AS STRING
    ' HOST ADDR  TO MyIp
    ' HOST NAME MyIp TO sBuffer
    sBuffer = MyIPaddress()     'Use IP address
     IF LEN (sbuffer) > 0 THEN
         p.sWS= sbuffer
     ELSE
      p.sWS= "ERROR"
     END IF
     sbuffer= UCASE$(ENVIRON$("USERNAME")) 'user name
     p.sname = sbuffer
     FUNCTION = VARPTR(p)
END FUNCTION

'-----------------------------------------------------------------------------
'This function performs various action on datafile accoding to lFileactionFlag
'Flags:SignIn ; File is opend and traversed for Username. If found, ws/IP number is appended to record
'if not found username and wsnumber/IP record is added
'Signout: File is traversed and ws number linked to Username is deleted
'FindUser: File is traversed and wsnumber retrieved
'-----------------------------------------------------------------------------
FUNCTION AccessDataFile(dType AS USERINFO,sFileAndpath AS STRING, lFileAction AS LONG) AS LONG
 LOCAL lFnum, lrecords,i  AS LONG ,lStatus AS LONG
 LOCAL sTemp AS STRING
 LOCAL uTemp AS userinfo
 ON ERROR GOTO AccessError
 ' Load our data file (if it exists)
    lFnum = FREEFILE
    lStatus = %FALSE
    OPEN sFileAndpath FOR RANDOM AS #lFnum  LEN = SIZEOF(dType)

    lrecords = LOF(lFnum) \ SIZEOF(dType)
    IF lrecords THEN

        ' Get the data
        FOR i = 1 TO lrecords
            GET #lFnum, i, utemp
            'Now perform action dependent on   lFileAction

            SELECT CASE lFileAction
                CASE %SignIn   '
                  IF utemp.sname = dType.sname THEN
                      PUT #lFnum, i, dType   'make sure to update with latest ws/IP number
                      lStatus = %TRUE 'we're done
                      EXIT FOR

                  END IF
             CASE %SignOut
                 IF utemp.sname = dType.sname THEN
                      utemp.sws = ""
                      PUT #lFnum, i, utemp
                      lStatus = %TRUE 'we're done
                      EXIT FOR
                 END IF
             CASE %FindUser
                  IF utemp.sname = dType.sname THEN
                     dType.sws= TRIM$(utemp.sws)
                     stemp=TRIM$(dType.sws)
                      IF LEN(stemp) = 0 THEN
                         lStatus =  %USER_INACTIVE
                         ELSE
                       lStatus = %TRUE 'we're done
                        END IF
                   EXIT FOR
                   ELSE
                     lStatus = %FALSE
                  END IF
              END SELECT
        NEXT



    IF lFileAction = %SignIn  AND  lStatus = %FALSE THEN  PUT #lFnum, , dType   'add new user and ws number
    CLOSE #lFnum

    ELSE
        'no data then add first item
      IF lFileAction = %SignIn THEN   PUT #lFnum, , dType
       ' Function = %FALSE 'no data in file
        CLOSE #lFnum
       END IF

'logic for functon value
SELECT CASE lFileAction
    CASE  %FindUser
        IF lStatus = %FALSE THEN FUNCTION= %USER_NOTFOUND
        IF  lStatus = %USER_INACTIVE  THEN  FUNCTION= %USER_INACTIVE
    CASE ELSE
    'should be true
    FUNCTION = %TRUE
END SELECT
EXIT FUNCTION
AccessError:
 CLOSE #lFnum
FUNCTION = %FALSE
END FUNCTION
'---------------------------------
'
'---------------------------------
FUNCTION ipHostNameToDottedIp(sHostName AS STRING) AS STRING
 LOCAL HostentPtr AS HostEntStru PTR
 LOCAL zPtr       AS ASCIIZ PTR
 LOCAL iaAddr     AS In_Addr
 LOCAL wdData     AS WSAData
 LOCAL Retval     AS LONG

 Retval = WSAStartup(&H101, wdData)
 HostentPtr = GetHostByName(BYVAL STRPTR(sHostName))
 IF HostentPtr = 0 THEN
   Retval = WSAGetLastError
  
   FUNCTION =  "Error A:" & STR$(Retval)& ", " & WSAGetLastErrorMsg(Retval)
 ELSE
   iaAddr.s_Addr = @[email protected]@h_addr_list
   zPtr = inet_ntoa(iaAddr.s_addr)
   WSACleanup
   FUNCTION = @zPtr
 END IF

END FUNCTION
'______________________________________________________________________________

FUNCTION ipDottedIpToHostName(sIP AS STRING) AS STRING
 LOCAL HostentPtr AS HostEntStru PTR
 LOCAL iaAddr     AS In_Addr
 LOCAL wdData     AS WSAData
 LOCAL Retval     AS LONG

 Retval = WSAStartup(&H101, wdData)
 iaAddr.s_Addr = Inet_Addr(BYVAL STRPTR(sIP))
 HostentPtr = GetHostByAddr(iaAddr.s_Addr, 4, %PF_INET)
 IF HostentPtr = 0 THEN
   Retval = WSAGetLastError
 
   FUNCTION = "Error B:" & STR$(Retval)& ", " & WSAGetLastErrorMsg(Retval)
 ELSE
   FUNCTION = @[email protected]_name
   WSACleanup
 END IF

END FUNCTION
'______________________________________________________________________________

FUNCTION ipDottedIpToDwordIP(BYVAL IpString AS STRING) AS DWORD
 LOCAL BytePtr AS BYTE PTR
 LOCAL IP      AS DWORD
 LOCAL Counter AS LONG

 BytePtr = VARPTR(IP)
 FOR Counter = 0 TO PARSECOUNT(IpString, ".") - 1
   @BytePtr[Counter] = VAL(PARSE$(IpString, ".", Counter + 1))
 NEXT Counter
 FUNCTION = IP

END FUNCTION
'______________________________________________________________________________

FUNCTION ipDwordIPToDottedIp(BYVAL IP AS DWORD) AS STRING
 LOCAL BytePtr AS BYTE PTR

 BytePtr = VARPTR(IP)
 FUNCTION = FORMAT$(@BytePtr[0]) & "." & FORMAT$(@BytePtr[1]) & "." & _
            FORMAT$(@BytePtr[2]) & "." & FORMAT$(@BytePtr[3])

END FUNCTION
'______________________________________________________________________________

FUNCTION GetRemotePort(BYVAL fFileNumber AS DWORD) AS DWORD
 LOCAL WinsockSocketHandle AS DWORD
 LOCAL SocketAddress       AS SockAddr_in

 WinsockSocketHandle = FILEATTR(fFileNumber, 2)
 'Use GetSockName() for local and GetPeerName() for remote
 IF GetPeerName(WinsockSocketHandle, BYVAL VARPTR(SocketAddress), SIZEOF(SocketAddress)) = 0 THEN
   FUNCTION = HTONS(SocketAddress.sin_port)
 END IF

END FUNCTION
'______________________________________________________________________________

FUNCTION ipGetRemoteDwordIP(BYVAL fFileNumber AS DWORD) AS DWORD
 LOCAL WinsockSocketHandle AS DWORD
 LOCAL SocketAddress       AS SockAddr_in

 WinsockSocketHandle = FILEATTR(fFileNumber, 2)
 'Use GetSockName() for local and GetPeerName() for remote
 IF GetPeerName(WinsockSocketHandle, BYVAL VARPTR(SocketAddress), SIZEOF(SocketAddress)) = 0 THEN
   FUNCTION = SocketAddress.sin_addr.s_addr
 END IF

END FUNCTION



'This file reads and initiates variables at program startup

SUB InitiateVariables
    LOCAL sRGB AS STRING
    DIM udtptr AS USERINFO PTR
   'read inisettings
   g_exePath = GetExePath
   'Get databasepath and filename
 g_DataBAsePath= INI_GetKey (g_exePath & "\" & $STICKYINIFILE, "SETTINGS","DATABASE", "STICKYBASE.DAT")

 'get recv& send port
 g_lTCPPort =   CLNG(VAL(INI_GetKey (g_exePath & "\" & $STICKYINIFILE, "SETTINGS","Port", "18000")))
 'get incoming note bck color
  sRGB= INI_GetKey (g_exePath & "\" & $STICKYINIFILE, "SETTINGS","RecvColor", "255,170,50")
 g_RecvColor = RGB(CBYT(VAL(PARSE$(sRGB,",",1))),CBYT(VAL(PARSE$(sRGB,",",2))),CBYT(VAL(PARSE$(sRGB,",",3))))
g_RecvBrush = CreateSolidBrush(g_RecvColor)
 'Get username and ws number
  udtptr = Iam()
  g_Iam = @udtptr 'initate global variabel
  'Sign in
  CALL AccessDataFile(g_Iam,g_DataBAsePath,%SignIN)
END SUB

SUB LogOff
  'Sign out
  CALL AccessDataFile(g_Iam,g_DataBAsePath,%SignOut)
END SUB

'-----------------------------------
'Gets text from a sticky Note
'-----------------------------------
FUNCTION GetRichEditText(BYVAL hEdit AS DWORD) AS STRING
' Save Window text to a buffer, destroy the Edit window, recreate the window and re-insert the text
LOCAL txtLen AS LONG,tString AS STRING
' Get Text length, create a string buffer and fill it with current text (if any)
txtLen = SendMessage( hEdit, %WM_GETTEXTLENGTH, 0, 0)
IF txtLen > 0 THEN
    tString = SPACE$(txtLen + 1)
    SendMessage hEdit, %WM_GETTEXT, txtLen + 1, STRPTR(tString)
    ELSE
    tString = ""
END IF


FUNCTION =  tString
END FUNCTION

'---------------------------------------------
'Do some checking
'----------------------------------------------------
SUB CheckBeforeSend(uUser AS USERINFO, sReturninfo AS STRING)
LOCAL sret,sbuffer AS STRING, lret AS LONG
'assumes that uUser contains username of current user
sbuffer = UCASE$(TRIM$(uUser.sname))
sret=INPUTBOX$("Recipients" & $CRLF & "username here","Send Note",sbuffer)
 sret =UCASE$(TRIM$(sret))
IF LEN(sret) = 0 THEN
 MSGBOX "No username entered",, $ProgramName
 sReturninfo = "STOP"
 EXIT SUB
END IF
'no get username and ws number/ip address
uUser.sname = sret
uUser.sWs = ""
lret = AccessDatafile(uUser,g_DataBAsePath,%FINDUSER)
 SELECT CASE lret
     CASE %USER_NOTFOUND
        MSGBOX "User not found" & $CRLF & "(May not have the program innstalled)",%MB_ICONINFORMATION + %MB_TASKMODAL +%MB_SYSTEMMODAL, $ProgramName
        sReturninfo = "STOP"
        EXIT SUB
        CASE   %USER_INACTIVE
        MSGBOX "User not logged in",%MB_ICONINFORMATION + %MB_TASKMODAL +%MB_SYSTEMMODAL, $ProgramName
        sReturninfo = "STOP"
        EXIT SUB
     CASE ELSE
          sReturninfo = "START"
 END SELECT

END SUB

------------Sticky.ini --------------

Code:

;Net Sticky ini file


[SETTINGS]
;
Database= C:\dept\STICKYBASE.DAT
;Define Port to recieve/send
Port=18000
;Choose RGB color for incoming Notes
RecvColor=255,170,50

Tags: None

Ian Cairns

Member

Join Date: Oct 1998

Posts: 823
- Share
- Tweet
#2

7 Apr 2008, 03:04 PM

Long live Mr. Sticky

Sorry, wrong area.
Please delete

Last edited by Ian Cairns; 7 Apr 2008, 03:07 PM.

:) IRC :)
Comment

Previous template Next

Announcement

Forum Guidelines

Net sticky code

Net sticky code

Comment