How To Get/Put HTML Code to the Clipboard

Just starting out? Need help? Post your questions and find answers here.
Post Reply
User avatar
oryaaaaa
Addict
Addict
Posts: 825
Joined: Mon Jan 12, 2004 11:40 pm
Location: Okazaki, JAPAN

How To Get/Put HTML Code to the Clipboard

Post by oryaaaaa »

HTML Clipboard Format (Internet Explorer - DHTML)
http://msdn.microsoft.com/workshop/netw ... frame=true

ActiveBasic Code GetBrowserClipboard

Code: Select all

    Declare Function MultiByteToWideChar Lib "kernel32" (CodePage As DWord,dwFlags As DWord,lpMultiByteStr As String,cchMultiByte As Long,lpWideCharStr As String,cchWideChar As Long)As Long
    Declare Function WideCharToMultiByte Lib "kernel32" (CodePage As DWord,dwFlags As DWord,lpWideByteStr As VoidPtr,cchWideByte As Long,lpMultiCharStr As String,cchMultiChar As Long,pDefaultChar As BytePtr,pUsedDefaultChar As DWordPtr)As Long

    Function GetBrowserClipboardData() As String
    Dim hData As DWord,pData As VoidPtr
    Dim Buf As String,Buf2 As String,dwSize As DWord
    Dim Ret1 As DWord,Ret2 As DWord
        OpenClipboard(0)

        hData=GetClipboardData(&HC0F9)
        If hData Then
            pData=GlobalLock(hData)
            If GetByte(pData) Then
                dwSize=MultiByteToWideChar(65001,0,pData,-1,0,0)
                Buf=ZeroString(dwSize*2)
                MultiByteToWideChar(65001,0,pData,-1,Buf,dwSize)

                dwSize=WideCharToMultiByte(0,0,Buf,-1,0,0,0,0)
                Buf2=ZeroString(dwSize)
                WideCharToMultiByte(0,0,Buf,-1,Buf2,dwSize,0,0)

                Ret1=InStr(1,Buf2,"<!--StartFragment")
                Ret1=InStr(Ret1,Buf2,">")+1
                If Buf2[Ret1-1]=&H0D Then Ret1=Ret1+2
                Ret2=InStr(Ret1,Buf2,"<!--EndFragment")
                GetBrowserClipboardData=Mid$(Buf2,Ret1,Ret2-Ret1)
            End If
            GlobalUnlock(hData)
        Else
            GetBrowserClipboardData=""
        End If

        CloseClipboard()
    End Function
ActiveBasic Code SetBrowserClipboard

Code: Select all

Declare Function MultiByteToWideChar Lib "kernel32" (CodePage As DWord,dwFlags As DWord,lpMultiByteStr As String,cchMultiByte As Long,lpWideCharStr As String,cchWideChar As Long)As Long
Declare Function WideCharToMultiByte Lib "kernel32" (CodePage As DWord,dwFlags As DWord,lpWideByteStr As VoidPtr,cchWideByte As Long,lpMultiCharStr As String,cchMultiChar As Long,pDefaultChar As BytePtr,pUsedDefaultChar As DWordPtr)As Long

Sub SetBrowserClipboardData(szString As String)
Dim hData As DWord,pData As BytePtr
Dim Buf As String,Buf2 As String,dwSize As DWord
    OpenClipboard(0)
    EmptyClipboard()

    dwSize=MultiByteToWideChar(0,0,szString,-1,0,0)
    Buf=ZeroString(dwSize*2)
    MultiByteToWideChar(0,0,szString,-1,Buf,dwSize)
    dwSize=WideCharToMultiByte(65001,0,Buf,-1,0,0,0,0)
    Buf2=ZeroString(dwSize*2)
    WideCharToMultiByte(65001,0,Buf,-1,Buf2,dwSize,0,0)

    hData=GlobalAlloc(GHND,173+dwSize)
    pData=GlobalLock(hData)
    wsprintf(pData,Ex"Version:0.9\r\nStartHTML:00000097\r\nEndHTML:%08u\r\nStartFragment:00000113\r\nEndFragment:%08u\r\n<html>\r\n<body>\r\n<!--StartFragment-->%s<!--EndFragment-->\r\n</body>\r\n</html>",169+dwSize,132+dwSize,Buf2)
    GlobalUnlock(hData)
    SetClipboardData(&HC0F9,hData)

    CloseClipboard()
End Sub
How should I describe it in PureBasic?
Challnge My PB Code

Code: Select all

;   Procedure.s GetBrowserClipboardData()
OpenClipboard_(0)

hData=GetClipboardData($C0F9)
;hData=GetClipboardData(#CF_TEXT)
If hData
        *pData=GlobalLock_(hData)
        If PeekB(hData)
          dwSize=MultiByteToWideChar_(65001,0,*pData,-1,0,0)
          Buf.s=Space(dwSize*2)
          MultiByteToWideChar_(65001,0,*pData,-1,@Buf,dwSize)
          dwSize=WideCharToMultiByte_(0,0,@Buf,-1,0,0,0,0)
          Buf2.s=Space(dwSize)
          WideCharToMultiByte_(0,0,@Buf,-1,@Buf2,dwSize,0,0)
          Debug Buf2
          Ret1=FindString(Buf2,"<!--StartFragment",0)
          Ret1=FindString(Buf2,">",Ret1)+1
          If PeekB(@Buf2+Ret1-1)=$0D
            Ret1=Ret1+2
          EndIf
          Ret2=FindString(Buf2,"<!--EndFragment",Ret1)
          GetBClipboardData.s=Mid(Buf2,Ret1,Ret2-Ret1)
        EndIf
        GlobalUnlock_(hData)
      Else
        GetBClipboardData.s=""
      EndIf
      CloseClipboard_() 
      Debug GetBClipboardData
    End
#CP_UTF8=65001

Please teach a good code.

Thanks
Last edited by oryaaaaa on Mon Jan 17, 2005 10:20 am, edited 1 time in total.
Top
User avatar
oryaaaaa
Addict
Addict
Posts: 825
Joined: Mon Jan 12, 2004 11:40 pm
Location: Okazaki, JAPAN

Post by oryaaaaa »

VB Set BrowserClipboard CODE (MSDN)

Code: Select all

Option Explicit
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) _
   As Long
Private Declare Function GlobalAlloc Lib "kernel32" ( _
   ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function SetClipboardData Lib "user32" ( _
   ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias _
   "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Private Declare Function GlobalUnlock Lib "kernel32" ( _
   ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
   pDest As Any, pSource As Any, ByVal cbLength As Long)
Private Declare Function GetClipboardData Lib "user32" ( _
   ByVal wFormat As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" ( _
   ByVal lpData As Long) As Long
Private Const m_sDescription = _
                  "Version:1.0" & vbCrLf & _
                  "StartHTML:aaaaaaaaaa" & vbCrLf & _
                  "EndHTML:bbbbbbbbbb" & vbCrLf & _
                  "StartFragment:cccccccccc" & vbCrLf & _
                  "EndFragment:dddddddddd" & vbCrLf

Private m_cfHTMLClipFormat As Long
Function RegisterCF() As Long
   'Register the HTML clipboard format
   If (m_cfHTMLClipFormat = 0) Then
      m_cfHTMLClipFormat = RegisterClipboardFormat("HTML Format")
   End If
   RegisterCF = m_cfHTMLClipFormat

End Function
Public Sub PutHTMLClipboard(sHtmlFragment As String, _
   Optional sContextStart As String = "<HTML><BODY>", _
   Optional sContextEnd As String = "</BODY></HTML>")

   Dim sData As String

   If RegisterCF = 0 Then Exit Sub

   'Add the starting and ending tags for the HTML fragment
   sContextStart = sContextStart & "<!--StartFragment -->"
   sContextEnd = "<!--EndFragment -->" & sContextEnd

   'Build the HTML given the description, the fragment and the context.
   'And, replace the offset place holders in the description with values
   'for the offsets of StartHMTL, EndHTML, StartFragment and EndFragment.
   sData = m_sDescription & sContextStart & sHtmlFragment & sContextEnd
   sData = Replace(sData, "aaaaaaaaaa", _
                   Format(Len(m_sDescription), "0000000000"))
   sData = Replace(sData, "bbbbbbbbbb", Format(Len(sData), "0000000000"))
   sData = Replace(sData, "cccccccccc", Format(Len(m_sDescription & _
                   sContextStart), "0000000000"))
   sData = Replace(sData, "dddddddddd", Format(Len(m_sDescription & _
                   sContextStart & sHtmlFragment), "0000000000"))
   'Add the HTML code to the clipboard
   If CBool(OpenClipboard(0)) Then

      Dim hMemHandle As Long, lpData As Long

      hMemHandle = GlobalAlloc(0, Len(sData) + 10)

      If CBool(hMemHandle) Then

         lpData = GlobalLock(hMemHandle)
         If lpData <> 0 Then

            CopyMemory ByVal lpData, ByVal sData, Len(sData)
            GlobalUnlock hMemHandle
            EmptyClipboard
            SetClipboardData m_cfHTMLClipFormat, hMemHandle

         End If

      End If

      Call CloseClipboard
   End If
End Sub
Public Function GetHTMLClipboard() As String
   Dim sData As String

   If RegisterCF = 0 Then Exit Function

   If CBool(OpenClipboard(0)) Then

      Dim hMemHandle As Long, lpData As Long
      Dim nClipSize As Long

      GlobalUnlock hMemHandle
      'Retrieve the data from the clipboard
      hMemHandle = GetClipboardData(m_cfHTMLClipFormat)

      If CBool(hMemHandle) Then

         lpData = GlobalLock(hMemHandle)
         If lpData <> 0 Then
            nClipSize = lstrlen(lpData)
            sData = String(nClipSize + 10, 0)

            Call CopyMemory(ByVal sData, ByVal lpData, nClipSize)

            Dim nStartFrag As Long, nEndFrag As Long
            Dim nIndx As Long

            'If StartFragment appears in the data's description,
            'then retrieve the offset specified in the description
            'for the start of the fragment. Likewise, if EndFragment
            'appears in the description, then retrieve the
            'corresponding offset.
            nIndx = InStr(sData, "StartFragment:")
            If nIndx Then
               nStartFrag = CLng(Mid(sData, _
                                 nIndx + Len("StartFragment:"), 10))
            End If
            nIndx = InStr(sData, "EndFragment:")
            If nIndx Then
               nEndFrag = CLng(Mid(sData, nIndx + Len("EndFragment:"), 10))
            End If

            'Return the fragment given the starting and ending
            'offsets
            If (nStartFrag > 0 And nEndFrag > 0) Then
               GetHTMLClipboard = Mid(sData, nStartFrag + 1, _
                                 (nEndFrag - nStartFrag))
            End If

         End If

      End If

      Call CloseClipboard
   End If
End Function
Top
User avatar
oryaaaaa
Addict
Addict
Posts: 825
Joined: Mon Jan 12, 2004 11:40 pm
Location: Okazaki, JAPAN

Post by oryaaaaa »

Code: Select all

Global m_cfHTMLClipFormat.l 

Procedure.l RegisterCF()
  If m_cfHTMLClipFormat=0
    m_cfHTMLClipFormat=RegisterClipboardFormat_("HTML Format")
  EndIf
  ProcedureReturn m_cfHTMLClipFormat
EndProcedure

Procedure.s GetHTMLClipboard()
  If RegisterCF()=0
    ProcedureReturn ""
  EndIf
  OpenClipboard_(0)
  hData=GetClipboardData(m_cfHTMLClipFormat)
  If hData
    *pData=GlobalLock_(hData)
    If PeekB(hData)
      dwSize=MultiByteToWideChar_(65001,0,*pData,-1,0,0)
      Buf.s=Space(dwSize*2)
      MultiByteToWideChar_(65001,0,*pData,-1,@Buf,dwSize)
      dwSize=WideCharToMultiByte_(0,0,@Buf,-1,0,0,0,0)
      Buf2.s=Space(dwSize)
      WideCharToMultiByte_(0,0,@Buf,-1,@Buf2,dwSize,0,0)
      Ret1=FindString(Buf2,"<!--StartFragment",0)
      Ret1=FindString(Buf2,">",Ret1)+1
      If PeekB(@Buf2+Ret1-1)=$0D
        Ret1=Ret1+2
      EndIf
      Ret2=FindString(Buf2,"<!--EndFragment",Ret1)
      GetHTMLClipboardS.s=Mid(Buf2,Ret1,Ret2-Ret1)
    EndIf
    GlobalUnlock_(hData)
  Else
    GetHTMLClipboardS.s=""
  EndIf
  CloseClipboard_() 
  ProcedureReturn GetHTMLClipboardS.s
EndProcedure

Debug GetHTMLClipboard()
Delay(2000)
End
It made it to good. :D
Top
User avatar
oryaaaaa
Addict
Addict
Posts: 825
Joined: Mon Jan 12, 2004 11:40 pm
Location: Okazaki, JAPAN

Post by oryaaaaa »

It solved it.

Code: Select all

Global m_cfHTMLClipFormat.l , EOL$
EOL$ = Chr(13)+Chr(10)  
#CP_UTF8=65001

Procedure.l RegisterCF()
  If m_cfHTMLClipFormat=0
    m_cfHTMLClipFormat=RegisterClipboardFormat_("HTML Format")
  EndIf
  ProcedureReturn m_cfHTMLClipFormat
EndProcedure

Procedure PutHTMLClipboard(sHtmlFragment.s)
  If RegisterCF()=0
    ProcedureReturn
  EndIf
  *out = AllocateMemory(Len(sHtmlFragment)*5+2) 
  l = MultiByteToWideChar_(#CP_ACP,0,@sHtmlFragment,-1,0,0) 
  l = MultiByteToWideChar_(#CP_ACP,0,@sHtmlFragment,-1,*out,l) 
  l = WideCharToMultiByte_(#CP_UTF8,0,*out,-1,0,0,0,0) 
  out2.s = Space(l) 
  l = WideCharToMultiByte_(#CP_UTF8,0,*out,-1,@out2,l,0,0) 
  sHtmlFragment.s=out2
  m_sDescription.s = "Version:1.0"+EOL$+"StartHTML:aaaaaaaaaa"+EOL$+"EndHTML:bbbbbbbbbb"+EOL$+"StartFragment:cccccccccc"+EOL$+"EndFragment:dddddddddd"+EOL$
  sContextStart.s="<HTML><BODY>"+"<!--StartFragment -->"
  sContextEnd.s="<!--EndFragment -->"+"</BODY></HTML>"
  sData.s = m_sDescription.s + sContextStart + sHtmlFragment + sContextEnd
  sData.s = ReplaceString(sData, "aaaaaaaaaa", RSet(StrU(Len(m_sDescription),#Long), 10, "0"))
  sData.s = ReplaceString(sData, "bbbbbbbbbb", RSet(StrU(Len(sData),#Long), 10, "0"))
  sData.s = ReplaceString(sData, "cccccccccc", RSet(StrU(Len(m_sDescription+sContextStart),#Long), 10, "0"))
  sData.s = ReplaceString(sData, "dddddddddd",RSet(StrU(Len(m_sDescription+sContextStart+sHtmlFragment),#Long), 10, "0"))
  Debug sData
  OpenClipboard_(0)
  *hMemHandle = GlobalAlloc_(0, Len(sData) + 10)
  If *hMemHandle
;    Debug *hMemHandle
    *lpData = GlobalLock_(*hMemHandle)
    If *lpData<>0
;      Debug *lpData
      PokeS(*lpData, sData, Len(sData))
      GlobalUnlock_(*hMemHandle)
      EmptyClipboard_()
      SetClipboardData_(m_cfHTMLClipFormat, *hMemHandle)
    EndIf 
  EndIf
  FreeMemory(*out)
  CloseClipboard_() 
EndProcedure

Procedure.s GetHTMLClipboard()
  If RegisterCF()=0
    ProcedureReturn ""
  EndIf
  OpenClipboard_(0)
  hData=GetClipboardData(m_cfHTMLClipFormat)
  If hData
    *pData=GlobalLock_(hData)
    If PeekB(hData)
      dwSize=MultiByteToWideChar_(65001,0,*pData,-1,0,0)
      Buf.s=Space(dwSize*2)
      MultiByteToWideChar_(65001,0,*pData,-1,@Buf,dwSize)
      dwSize=WideCharToMultiByte_(0,0,@Buf,-1,0,0,0,0)
      Buf2.s=Space(dwSize)
      WideCharToMultiByte_(0,0,@Buf,-1,@Buf2,dwSize,0,0)
      Debug Buf2
      Ret1=FindString(Buf2,"<!--StartFragment",0)
      Ret1=FindString(Buf2,">",Ret1)+1
      If PeekB(@Buf2+Ret1-1)=$0D
        Ret1=Ret1+2
      EndIf
      Ret2=FindString(Buf2,"<!--EndFragment",Ret1)
      GetHTMLClipboardS.s=Mid(Buf2,Ret1,Ret2-Ret1)
    EndIf
    GlobalUnlock_(hData)
  Else
    GetHTMLClipboardS.s=""
  EndIf
  CloseClipboard_() 
  ProcedureReturn GetHTMLClipboardS.s
EndProcedure

A$=GetHTMLClipboard()
;Debug A$
Delay(1000)
PutHTMLClipboard(A$)
Delay(2000)
End
Last edited by oryaaaaa on Sun Jan 23, 2005 11:16 am, edited 1 time in total.
Top
DominiqueB
Enthusiast
Enthusiast
Posts: 103
Joined: Fri Apr 25, 2003 4:00 pm
Location: France

Hello oryaaaaa

Post by DominiqueB »

I've found ActiveBasic on the web a litle tile ago, anyway to have a doc in english for it ?

Thank's

Dominique
Dominique

Windows 10 64bits. Pure basic 32bits
Top
gnozal
PureBasic Expert
PureBasic Expert
Posts: 4229
Joined: Sat Apr 26, 2003 8:27 am
Location: Strasbourg / France
Contact:
Contact gnozal

Re: Hello oryaaaaa

Post by gnozal »

DominiqueB wrote:I've found ActiveBasic on the web a litle tile ago, anyway to have a doc in english for it ?
I don't think there is an english version or doc.
More basic compilers for windows / linux at http://basic.mindteq.com
For free libraries and tools, visit my web site (also home of jaPBe V3 and PureFORM).
Top
User avatar
oryaaaaa
Addict
Addict
Posts: 825
Joined: Mon Jan 12, 2004 11:40 pm
Location: Okazaki, JAPAN

Post by oryaaaaa »

The localize plan from Japanese to English is progressing now.
Things except the manual are expected to be able to be released in around spring.
Top
Post Reply

Return to “Coding Questions”