Code: Accessing Windows Clipboard

Several years ago, I found some code to access the Win32 functions for the Windows Clipboard. I don't remember where I found it, who wrote it or if it was VB code that I modified or already written for Lotusscript. I rewrote the the code as a class and put it in a script library called "Class.Win32.ClipBoard". The complete code is listed below. In my next blog entry I will describe how I am using this class for some very convenient functions.



Option Public

Option Declare


Declare Private Function GetClipboardData Lib "User32" (Byval wFormat As Long) As Long

Declare Private Function SetClipboardData Lib "user32" (Byval wFormat As Long, Byval hData As Long) As Long

Declare Private Function OpenClipboard Lib "User32" Alias "OpenClipboard" (Byval hwnd As Long) As Long

Declare Private Function CloseClipboard Lib "User32" Alias "CloseClipboard" () As Long

Declare Private Function GlobalLock Lib "kernel32" Alias "GlobalLock" (Byval hMem As Long) As Long

Declare Private Function GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (Byval hMem As Long) As Long

Declare Private Function GlobalAlloc Lib "kernel32" (Byval wFlags As Long, Byval dwBytes As Long) As Long

Declare Private Function GlobalFree Lib "kernel32" (Byval hMem As Long) As Long

Declare Private Function EmptyClipboard Lib "user32" () As Long

Declare Private Function lstrcpyLP2Str Lib "kernel32" Alias "lstrcpyA" (Byval lpString1 As String, _

Byval lpString2 As Long) As Long

Declare Private Function lstrlenLP Lib "kernel32" Alias "lstrlenA" (Byval lpString As Long) As Long

Declare Private Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Byval strDest As Any, _

Byval lpSource As Any, Byval Length As Any)

Declare Private Function GetFocus Lib "User32" Alias "GetFocus" () As Long 


Private Const CF_TEXT = 1

Private Const GMEM_MOVABLE = &H2&

Private Const GMEM_DDESHARE = &H2000&


Class WindowsClipboard


Public Property Get Contents As String

    Dim hClipboard As Long

Dim LpStrl As Long

     Dim Resultl As Long

    Dim Clipboardstr As String


         If (OpenClipboard(0&) <> 0) Then

            hClipboard = GetClipboardData(CF_TEXT)

            If (hClipboard <> 0) Then

                LpStrl = GlobalLock(hClipboard)

                Clipboardstr = Space$(lstrlenLP(LpStrl))

                 Resultl = lstrcpyLP2Str(Clipboardstr, LpStrl)



                 Clipboardstr = "NULL"

              End If

            Call CloseClipboard()


            Clipboardstr = ""

        End If

        Contents = Clipboardstr

    End Property ' Ends the "Get" method for the "Contents" property


    Public Property Set Contents As String

         Dim lSize As Long

         Dim hMem As Long

         Dim pMemory As Long

        Dim temp As Variant


        lSize = Len(Contents)+1

        hMem = GlobalAlloc(GMEM_MOVABLE Or GMEM_DDESHARE, lSize)

        If hMem = 0 Or Isnull(hMem) Then Exit Property

        pMemory = GlobalLock(hMem)

        If pMemory = 0 Or Isnull(pMemory) Then 


            Exit Property

        End If

         Call MoveMemory(pMemory, Contents, lSize)

        Call GlobalUnlock(hMem)

        If (OpenClipboard(0&) <> 0) Then

            If (EmptyClipboard() <> 0) Then

                temp = SetClipboardData(CF_TEXT, hMem)

             End If

            temp = CloseClipboard()

        End If


    End Property ' Ends the "Set" method for the "Contents" property


End Class




Leave a Reply