Announcement

Collapse
1 of 2 < >

New Sub-Forum

In an effort to help make sure there are appropriate categories for topics of discussion that are happening, there is now a sub-forum for databases and database programming under Special Interest groups. Please direct questions, etc., about this topic to that sub-forum moving forward. Thank you.
2 of 2 < >

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

New Forum - Clipboard Listener - Source Code Copy...

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

  • New Forum - Clipboard Listener - Source Code Copy...

    This code is designed based off of webclip by Pierre Belisle: http://www.powerbasic.com/support/pb...ad.php?t=24475

    (There is also source code there too that will create an icon and resource for you).

    This code listens for a copy, and if HTML data is available, will attempt to extract the code segments from that HTML (and replace any HTML sequences with appropriate ASCII characters). I have tested some, but not certain how well it works overall. There are already a few threads in regard to this subject, so I will post on one of them a link to this.

    All you have to do is Select All, and press Ctrl+C. This program will split as many code segments as are available into separate items for viewing, and combined write to the clipboard. If there is only one code segment, it will go ahead and extract it and re-write to clipboard in text format.

    EDIT: Have already made 2 edits, 1 for a bug in view last copy, and another for an apparent difference in IE that I didn't check for (I'm a firefox user that didn't think to test IE), that the pre command appears as this in Firefox:

    Code:
    <PRE CLASS="ALT2"
    and this in IE:

    Code:
    <PRE CLASS=ALT2
    So, hopefully this is fully functional now...

    Code:
    #PBFORMS CREATED V1.51
    '------------------------------------------------------------------------------
    ' The first line in this file is a PB/Forms metastatement.
    ' It should ALWAYS be the first line of the file. Other
    ' PB/Forms metastatements are placed at the beginning and
    ' end of "Named Blocks" of code that should be edited
    ' with PBForms only. Do not manually edit or delete these
    ' metastatements or PB/Forms will not be able to reread
    ' the file correctly.  See the PB/Forms documentation for
    ' more information.
    ' Named blocks begin like this:    #PBFORMS BEGIN ...
    ' Named blocks end like this:      #PBFORMS END ...
    ' Other PB/Forms metastatements such as:
    '     #PBFORMS DECLARATIONS
    ' are used by PB/Forms to insert additional code.
    ' Feel free to make changes anywhere else in the file.
    '------------------------------------------------------------------------------
    
    #COMPILE EXE
    #DIM ALL
    
    '------------------------------------------------------------------------------
    '   ** Includes **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN INCLUDES
    #IF NOT %DEF(%WINAPI)
        #INCLUDE "WIN32API.INC"
    #ENDIF
    #INCLUDE "PBForms.INC"
    #PBFORMS END INCLUDES
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Constants **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN CONSTANTS
    %IDD_DIALOG_EXTRACTSOURCE =  101
    %IDC_LABEL_CS             = 1002
    %IDC_LISTBOX_CS           = 1001
    %IDC_TEXTBOX_CODE         = 1003
    %IDC_LABEL_CODE           = 1004
    %IDC_BUTTON_CONTINUE      = 1006
    %IDC_BUTTON_CANCEL        = 1005
    #PBFORMS END CONSTANTS
    '------------------------------------------------------------------------------
    
    #RESOURCE "ICON.PBR"
    
    GLOBAL hInst    AS DWORD
    
    %WM_TRAYICON    = %WM_USER + 2048
    %WM_INITCODE    = %WM_USER + 2049    ' Custom Message to view code
    %WM_VIEWLAST    = %WM_USER + 2050
    
    %IDM_VIEWLASTCOPY = 2001
    %IDM_EXIT         = 2002
    
    GLOBAL FoundWithQuotes  AS LONG
    
    '------------------------------------------------------------------------------
    '   ** Declarations **
    '------------------------------------------------------------------------------
    DECLARE CALLBACK FUNCTION ShowDIALOG_EXTRACTSOURCEProc()
    DECLARE FUNCTION ShowDIALOG_EXTRACTSOURCE(BYVAL hParent AS DWORD) AS LONG
    #PBFORMS DECLARATIONS
    '------------------------------------------------------------------------------
    
    DECLARE SUB      WriteToClipBoard(BYVAL Buffer AS STRING)
    DECLARE FUNCTION GetHTMLData() AS STRING
    DECLARE FUNCTION CheckClipboardData(Buffer AS STRING) AS LONG
    DECLARE FUNCTION ExtractCodeSegment(Buffer AS STRING, SegmentIndex AS LONG) AS STRING
    
    '------------------------------------------------------------------------------
    '   ** Main Application Entry Point **
    '------------------------------------------------------------------------------
    FUNCTION WINMAIN(BYVAL hInstance AS DWORD, BYVAL  hPrevInst AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
    
        hInst = hInstance
    
        ShowDIALOG_EXTRACTSOURCE %HWND_DESKTOP
    
    END FUNCTION
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** CallBacks **
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowDIALOG_EXTRACTSOURCEProc()
    
        LOCAL pt            AS POINTAPI
        LOCAL hPopup        AS DWORD
        LOCAL lRet          AS LONG
        LOCAL CBBuffer      AS STRING
        LOCAL x             AS LONG
        LOCAL hWndLB        AS DWORD
        LOCAL LBSel         AS LONG
        LOCAL LBItemCount   AS LONG
        LOCAL LBSelState    AS LONG
    
        DIM CSData()        AS STATIC STRING
    
        STATIC CodeSegments AS LONG
        STATIC HTMLBuffer   AS STRING
        STATIC hIcon        AS DWORD
        STATIC nfIconData   AS NOTIFYICONDATA
        STATIC hCBChain     AS DWORD
    
        SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
                hCBChain                    = SetClipboardViewer(CBHNDL)
                hIcon                       = LoadIcon(hInst, "CLIPICON")
                nfIconData.hwnd             = CBHNDL
                nfIconData.uID              = hInst
                nfIconData.uFlags           = %NIF_ICON OR %NIF_MESSAGE OR %NIF_TIP
                nfIconData.uCallbackMessage = %WM_TRAYICON
                nfIconData.hIcon            = hIcon
                nfIconData.szTip            = "PB Forum - Extract Source"
                nfIconData.cbSize           = SIZEOF(nfIconData)
                Shell_NotifyIcon %NIM_ADD, nfIconData
    
            CASE %WM_TRAYICON
                SELECT CASE LO(WORD, CBLPARAM)
                    CASE %WM_LBUTTONUP, %WM_RBUTTONUP
                        GetCursorPos pt
                        SetForegroundWindow CBHNDL
                        hPopup = CreatePopupMenu()
                        InsertMenu hPopup, 1, IIF&(UBOUND(CSData) > 0, %MF_ENABLED, %MF_GRAYED) OR %MF_BYCOMMAND, %IDM_VIEWLASTCOPY, "View Last Copied Data"
                        InsertMenu hPopup, 2, %MF_SEPARATOR, 2, "-"
                        InsertMenu hPopup, 3, %MF_ENABLED OR %MF_BYCOMMAND, %IDM_EXIT, "Exit"
                        lRet = TrackPopupMenu(hPopup, %TPM_BOTTOMALIGN OR %TPM_RIGHTALIGN OR %TPM_RIGHTBUTTON, pt.x, pt.y, 0, CBHNDL, BYVAL %NULL)
                        DestroyMenu hPopup
                END SELECT
    
            CASE %WM_DESTROY
                Shell_NotifyIcon %NIM_DELETE, nfIconData
                ChangeClipboardChain CBHNDL, hCBChain
    
            CASE %WM_SYSCOMMAND
                IF (CBWPARAM AND &HFFF0)=%SC_MINIMIZE OR (CBWPARAM AND &HFFF0)=%SC_CLOSE THEN
                    DIALOG SHOW STATE CBHNDL, %SW_HIDE
                    FUNCTION = 1
                    EXIT FUNCTION
                END IF
    
            CASE %WM_VIEWLAST
                CodeSegments = UBOUND(CSData)
                IF CodeSegments = 0 THEN
                    EXIT FUNCTION
                END IF
                IF GetForegroundWindow() <> CBHNDL THEN
                    SetForegroundWindow CBHNDL
                END IF
                LISTBOX RESET CBHNDL, %IDC_LISTBOX_CS
                FOR x = 1 TO CodeSegments
                    LISTBOX ADD CBHNDL, %IDC_LISTBOX_CS, "Segment "+FORMAT$(x)
                NEXT
                LISTBOX SELECT CBHNDL, %IDC_LISTBOX_CS, 1
                CONTROL SET FOCUS CBHNDL, %IDC_LISTBOX_CS
                CONTROL SET TEXT CBHNDL, %IDC_TEXTBOX_CODE, CSData(1)
    
            CASE %WM_INITCODE
                IF GetForegroundWindow() <> CBHNDL THEN
                    SetForegroundWindow CBHNDL
                END IF
                LISTBOX RESET CBHNDL, %IDC_LISTBOX_CS
                REDIM CSData(1 TO CodeSegments) AS STATIC STRING
                FOR x = 1 TO CodeSegments
                    CSData(x) = ExtractCodeSegment(HTMLBuffer, x)
                    LISTBOX ADD CBHNDL, %IDC_LISTBOX_CS, "Segment "+FORMAT$(x)
                NEXT
                LISTBOX SELECT CBHNDL, %IDC_LISTBOX_CS, 1
                CONTROL SET FOCUS CBHNDL, %IDC_LISTBOX_CS
                CONTROL SET TEXT CBHNDL, %IDC_TEXTBOX_CODE, CSData(1)
    
            CASE %WM_DRAWCLIPBOARD
                HTMLBuffer = GetHTMLData()
                CodeSegments = CheckClipboardData(HTMLBuffer)
                IF CodeSegments > 1 THEN
                    DIALOG SHOW STATE CBHNDL, %SW_SHOW
                    PostMessage CBHNDL, %WM_INITCODE, 0, 0
                ELSEIF CodeSegments = 1 THEN
                    CBBuffer = ExtractCodeSegment(HTMLBuffer, 1)
                    REDIM CSData(1 TO 1) AS STATIC STRING
                    CSData(1) = CBBuffer
                    WriteToClipboard CBBuffer
                END IF
                SendMessage hCBChain, CBMSG, CBWPARAM, CBLPARAM
    
            CASE %WM_COMMAND
                SELECT CASE AS LONG CBCTL
                    CASE %IDM_VIEWLASTCOPY
                        DIALOG SHOW STATE CBHNDL, %SW_SHOW
                        PostMessage CBHNDL, %WM_VIEWLAST, 0, 0
    
                    CASE %IDM_EXIT
                        PostQuitMessage 0
                        DIALOG END CBHNDL
    
                    CASE %IDC_LISTBOX_CS
                        IF CBCTLMSG = %LBN_SELCHANGE THEN
                            hWndLB = GetDlgItem(CBHNDL, CBCTL)
                            LBSel = SendMessage(hWndLB, %LB_GETCURSEL, 0, 0)
                            IF LBSel <> %LB_ERR THEN
                                INCR LBSel
                                CONTROL SET TEXT CBHNDL, %IDC_TEXTBOX_CODE, CSData(LBSel)
                            END IF
                        END IF
    
                    CASE %IDC_LABEL_CS
    
                    CASE %IDC_TEXTBOX_CODE
    
                    CASE %IDC_LABEL_CODE
    
                    CASE %IDCANCEL
                        PostMessage CBHNDL, %WM_COMMAND, MAK(LONG, %IDC_BUTTON_CANCEL, %BN_CLICKED), 0
    
                    CASE %IDC_BUTTON_CANCEL
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            DIALOG SHOW STATE CBHNDL, %SW_HIDE
                        END IF
    
                    CASE %IDC_BUTTON_CONTINUE
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            hWndLB = GetDlgItem(CBHNDL, %IDC_LISTBOX_CS)
                            LBItemCount = SendMessage(hWndLB, %LB_GETCOUNT, 0, 0)
                            IF LBItemCount <> %LB_ERR THEN
                                FOR x = 0 TO LBItemCount - 1
                                    LBSelState = SendMessage(hWndLB, %LB_GETSEL, 0, 0)
                                    IF LBSelState > 0 THEN
                                        CBBuffer = CBBuffer + CSData(x + 1) + $CRLF + $CRLF
                                    END IF
                                NEXT
                                WriteToClipboard CBBuffer
                                PostMessage CBHNDL, %WM_SYSCOMMAND, %SC_MINIMIZE, 0
                            ELSE
                                MSGBOX "No Code Segment Selected.", %MB_ICONERROR OR %MB_TASKMODAL, "PB Forums - Extract Source Code from HTML"
                            END IF
                        END IF
    
                END SELECT
        END SELECT
    END FUNCTION
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Dialogs **
    '------------------------------------------------------------------------------
    FUNCTION ShowDIALOG_EXTRACTSOURCE(BYVAL hParent AS DWORD) AS LONG
        LOCAL lRslt  AS LONG
    
    #PBFORMS BEGIN DIALOG %IDD_DIALOG_EXTRACTSOURCE->->
        LOCAL hDlg   AS DWORD
        LOCAL hFont1 AS DWORD
    
        DIALOG NEW hParent, "PB Forums - Extract Source Code from HTML", 94, 70, _
            513, 308, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
            %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
            OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
            %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
            %WS_EX_RIGHTSCROLLBAR, TO hDlg
        CONTROL ADD LISTBOX, hDlg, %IDC_LISTBOX_CS, , 5, 15, 110, 290, %WS_CHILD _
            OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR %LBS_EXTENDEDSEL OR _
            %LBS_NOTIFY, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING _
            OR %WS_EX_RIGHTSCROLLBAR
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL_CS, "Select Code Segment To Copy:", _
            5, 5, 105, 10
        CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX_CODE, "TextBox1", 120, 15, 390, _
            270, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR _
            %WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOHSCROLL OR _
            %ES_AUTOVSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
            %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL_CODE, "Code:", 120, 5, 100, 10
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON_CANCEL, "C&ancel", 460, 290, 50, _
            15
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON_CONTINUE, "&Continue", 405, 290, _
            50, 15
    
        hFont1 = PBFormsMakeFont("Courier New", 9, 400, %FALSE, %FALSE, %FALSE, _
            %ANSI_CHARSET)
    
        CONTROL SEND hDlg, %IDC_LISTBOX_CS, %WM_SETFONT, hFont1, 0
        CONTROL SEND hDlg, %IDC_TEXTBOX_CODE, %WM_SETFONT, hFont1, 0
    #PBFORMS END DIALOG
    
        DIALOG SHOW STATE hDlg, %SW_HIDE
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG_EXTRACTSOURCEProc TO lRslt
    
    #PBFORMS BEGIN CLEANUP %IDD_DIALOG_EXTRACTSOURCE
        DeleteObject hFont1
    #PBFORMS END CLEANUP
    
        FUNCTION = lRslt
    END FUNCTION
    '------------------------------------------------------------------------------
    FUNCTION CheckClipboardData(Buffer AS STRING) AS LONG
    
        LOCAL lRet  AS LONG
    
        IF LEN(Buffer) <> 0 THEN
            IF INSTR(UCASE$(Buffer), "<PRE CLASS=""ALT2") <> 0 THEN
                FoundWithQuotes = %TRUE
            ELSE
                FoundWithQuotes = %FALSE
            END IF
        END IF
    
        IF LEN(Buffer) <> 0 THEN
            lRet = TALLY(UCASE$(Buffer), "<PRE CLASS=" + IIF$(FoundWithQuotes = %TRUE, $DQ, "") + "ALT2")
        END IF
    
        FUNCTION = lRet
    
    END FUNCTION
    '------------------------------------------------------------------------------
    FUNCTION GetHTMLData() AS STRING
    
        LOCAL CBFormat      AS LONG
        LOCAL hBuffer       AS ASCIIZ PTR
        LOCAL Buffer        AS STRING
        LOCAL lRet          AS LONG
        LOCAL hMem          AS LONG
    
        STATIC HTMLFormat   AS LONG
    
        OpenClipboard 0
        IF HTMLFormat = 0 THEN
            HTMLFormat = RegisterClipboardFormat("HTML Format")
        END IF
    
        DO
            CBFormat = EnumClipboardFormats(CBFormat)
            IF CBFormat = 0 THEN EXIT DO
            IF CBFormat = HTMLFormat THEN
                hMem = GetClipboardData(HTMLFormat)
                hBuffer = GlobalLock(hMem)
                IF hBuffer THEN
                    Buffer = @hBuffer
                    GlobalUnlock hMem
                    EXIT DO
                END IF
            END IF
        LOOP
    
        CloseClipboard
    
        FUNCTION = Buffer
    
    END FUNCTION
    '------------------------------------------------------------------------------
    SUB WriteToClipBoard(BYVAL Buffer AS STRING)
    
        LOCAL MemPointer    AS ASCIIZ PTR
        LOCAL hMem          AS DWORD
    
        hMem = GlobalAlloc(%GHND, LEN(Buffer) + 1)
        MemPointer = GlobalLock(hMem)
        @MemPointer = Buffer
        GlobalUnlock hMem
        OpenClipboard 0
        EmptyClipboard
        SetClipboardData %CF_TEXT, hMem
        CloseClipboard
        GlobalFree(hMem)
    
    END SUB
    '------------------------------------------------------------------------------
    FUNCTION ExtractCodeSegment(Buffer AS STRING, SegmentIndex AS LONG) AS STRING
    
        LOCAL tmpBuffer AS STRING
        LOCAL sRet      AS STRING
        LOCAL x1        AS LONG
        LOCAL x2        AS LONG
        LOCAL tmpIndex  AS LONG
    
        tmpBuffer = UCASE$(Buffer)
    
        x1 = INSTR(tmpBuffer, "<PRE CLASS=" + IIF$(FoundWithQuotes = %TRUE, $DQ, "") + "ALT2")
        tmpIndex = 1
        IF SegmentIndex > 1 THEN
            WHILE tmpIndex < SegmentIndex AND x1 > 0
                x2 = INSTR(x1, tmpBuffer, ">")
                x1 = INSTR(x2, tmpBuffer, "<PRE CLASS=" + IIF$(FoundWithQuotes = %TRUE, $DQ, "") + "ALT2")
                INCR tmpIndex
            WEND
        END IF
    
        IF x1 > 0 THEN
            x2 = INSTR(x1, tmpBuffer, ">")
            x1 = x2 + 1
            x2 = INSTR(x1, tmpBuffer, "</PRE>")
            sRet = MID$(Buffer, x1, x2 - x1)
            REPLACE "&gt;" WITH ">" IN sRet
            REPLACE "&lt;" WITH "<" IN sRet
            REPLACE "&quot;" WITH $DQ IN sRet
            REPLACE "&amp;" WITH "&" IN sRet
        END IF
    
        FUNCTION = sRet
    
    END FUNCTION
    '------------------------------------------------------------------------------
    Last edited by Adam J. Drake; 25 Dec 2007, 03:16 PM. Reason: Bug fixes
    Adam Drake
    Drake Software

  • #2
    Ok, just realized I never pasted a couple of the bug fixes I actually made inside the program, plus another MCM pointed out to me with memory handling inside of GetHTMLData. If you have already made use of this, re-copy the code above, and it should function better.
    Adam Drake
    Drake Software

    Comment

    Working...
    X