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:
and this in IE:
So, hopefully this is fully functional now...
(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"
Code:
<PRE CLASS=ALT2
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 ">" WITH ">" IN sRet
REPLACE "<" WITH "<" IN sRet
REPLACE """ WITH $DQ IN sRet
REPLACE "&" WITH "&" IN sRet
END IF
FUNCTION = sRet
END FUNCTION
'------------------------------------------------------------------------------
Comment