Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Net sticky code

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Net sticky code

    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

  • #2
    Long live Mr. Sticky

    Sorry, wrong area.
    Please delete
    Last edited by Ian Cairns; 7 Apr 2008, 04:07 PM.
    :) IRC :)

    Comment

    Working...
    X