PureBasic Forums - English

Code: Select all

; ***************************************************************************
;
;                           Examine Cliboard data
;
;                  List all data contained in the clipboard
;                             For Windows only
;                       PB 6.11 - By Zapman Sept 2024
;
; ***************************************************************************
;
; For each data, this program try to know more about it, to read strings
; of any type and to print picture of any type.
;
; It can be a help to learn how to convert pictures from any format, or how
; to deal with the IStream and IStorage interfaces.
;
;
Procedure.s GetWinErrorMessage(errorCode)
  ;
  ; Retourne un texte qui explicite l'erreur dont le numéro
  ; est passé dans le paramètre 'errorCode'.
  :
  Protected messageBuffer$ = Space(256) ; Buffer pour le message
  Protected messageLength

  messageLength = FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM | #FORMAT_MESSAGE_IGNORE_INSERTS, #Null, errorCode, 0, @messageBuffer$, 256, #Null)
  
  If messageLength > 0
    ; Supprime les retours à la ligne à la fin du message
    messageBuffer$ = ReplaceString(messageBuffer$, Chr(10), "")
    messageBuffer$ = ReplaceString(messageBuffer$, Chr(13), "")
    messageBuffer$ = Trim(messageBuffer$)
  Else
    messageBuffer$ = "Unknown error code:"
  EndIf
  ProcedureReturn messageBuffer$ + "  ($" + Hex(errorCode) + ")"
EndProcedure
;
Procedure WtoUnsignedI(number.w)
  Protected Result = number
  ;
  If Result < 0
    Result + 65536
  EndIf
  ProcedureReturn Result
EndProcedure
;
Procedure.s GetFormatName(cfFormat.w)
  ;
  ; Retourne un nom de format en fonction du code passé dans cfFormat
  ;
  Protected formatName$ = Space(256)
  Protected Format = WtoUnsignedI(cfFormat)
  ;
  Select Format
    ; Formats standards
    Case #CF_TEXT : formatName$ = "CF_TEXT"
    Case #CF_BITMAP : formatName$ = "CF_BITMAP"
    Case #CF_METAFILEPICT : formatName$ = "CF_METAFILEPICT"
    Case #CF_SYLK : formatName$ = "CF_SYLK"
    Case #CF_DIF : formatName$ = "CF_DIF"
    Case #CF_TIFF : formatName$ = "CF_TIFF"
    Case #CF_OEMTEXT : formatName$ = "CF_OEMTEXT"
    Case #CF_DIB : formatName$ = "CF_DIB"
    Case #CF_PALETTE : formatName$ = "CF_PALETTE"
    Case #CF_PENDATA : formatName$ = "CF_PENDATA"
    Case #CF_RIFF : formatName$ = "CF_RIFF"
    Case #CF_WAVE : formatName$ = "CF_WAVE"
    Case #CF_UNICODETEXT : formatName$ = "CF_UNICODETEXT"
    Case #CF_ENHMETAFILE : formatName$ = "CF_ENHMETAFILE"
    Case #CF_HDROP : formatName$ = "CF_HDROP"
    Case #CF_LOCALE : formatName$ = "CF_LOCALE"
    Case #CF_DIBV5 : formatName$ = "CF_DIBV5"
    Default
      GetClipboardFormatName_(Format, @formatName$, 256)
  EndSelect
  ;
  If formatName$ = ""
    formatName$ = "Unknown format (" + Str(Format) + ")"
  EndIf
  ;
  ProcedureReturn formatName$
EndProcedure
;
Procedure.s GetTymedName(Tymed)
  ;
  ; Retourne le nom de la constante dont la valeur est passée dans le paramètre 'Tymed'.
  ;
  Protected Tymed$ = ""
  ;
  If Tymed = 0
    tymed$ = "TYMED_NULL"
  Else
    If Tymed & 1
      Tymed$ + "TYMED_HGLOBAL + "
    EndIf
    If Tymed & 2
      Tymed$ + "TYMED_FILE + "
    EndIf
    If Tymed & 4
      Tymed$ + "TYMED_ISTREAM + "
    EndIf
    If Tymed & 8
      Tymed$ + "TYMED_ISTORAGE + "
    EndIf
    If Tymed & 16
      Tymed$ + "TYMED_GDI + "
    EndIf
    If Tymed & 32
      Tymed$ + "TYMED_MFPICT + "
    EndIf
    If Tymed & 64
      Tymed$ + "TYMED_ENHMF"
    EndIf
  EndIf
  If Tymed$ = ""
    tymed$ = "Unknown tymed value: " + Str(Tymed)
  EndIf
  If Right(Tymed$, 3) = " + "
    Tymed$ = Left(Tymed$, Len(Tymed$) - 3)
  EndIf
  ProcedureReturn Tymed$
EndProcedure
;
Procedure.s HandleToFilesList(handle)
  ; Extract FilesList from a DROPFILE Structure
  ;
  Protected *pDrop.DROPFILES, *buffer, SOC, pos, nbzero
  Protected StringSize, *buffer2, ct, MyString$
  ;
  *pDrop.DROPFILES = GlobalLock_(handle)
  *buffer = *pDrop + *pDrop\pFiles ; data is stored at this adress
  If *pDrop\fWide =#True ; if FilesList is stored in unicode mode, each character has 2 bytes size
    SOC = 2
  Else
    SOC = 1
  EndIf
  pos = -SOC
  nbzero = 0
  Repeat ; look for a double zero at the end of the FilesList
    pos + SOC
    If PeekB(*buffer+pos)=0
      nbzero + 1
    Else
      nbzero = 0
    EndIf
  Until nbzero = 2 Or pos>1000 ; If we don't find a double zero, we stop to explore the memory after 1000 character
  If nbzero = 2 ; OK, we now have the lenght of the FilesList
    StringSize = pos
    *buffer2 = AllocateMemory(StringSize)
    CopyMemory(*buffer,*buffer2,StringSize) ; duplicate the buffer to leave the original buffer as it is
    ct = 0
    Repeat
      If PeekB(*buffer2+ct)=0
        PokeB(*buffer2+ct,10) ; replace zero by chr(10) in all the FilesList
      EndIf
      ct + SOC
    Until ct = (StringSize-SOC)
    If *pDrop\fWide =#True
      MyString$ = PeekS(*buffer2,#PB_Any,#PB_Unicode)
    Else
      MyString$ = PeekS(*buffer2,#PB_Any,#PB_Ascii)
    EndIf
    FreeMemory(*buffer2)
  EndIf
  GlobalUnlock_(handle)
  ProcedureReturn MyString$
EndProcedure
;
Procedure ShowBitmapPictInWindow(hWd, hBitmap)
  ;
  ; Draw the hBitmap into hWd
  ;
  Protected hdcWindow = GetDC_(hWd)
  Protected rect.RECT, SRatio.f
  GetClientRect_(hWd, @rect)
  ; Calculates the width and height of the gadget or window
  Protected destWidth = rect\right - rect\left
  Protected destHeight = rect\bottom - rect\top
  If hBitmap
    ; Retrieves the Bitmap
    Protected bmp.BITMAP
    GetObject_(hBitmap, SizeOf(BITMAP), @bmp)
    ;
    SRatio.f = bmp\bmWidth/bmp\bmHeight
    If SRatio < 1
      destWidth = destHeight*SRatio
    Else
      destHeight = destWidth/SRatio
    EndIf
    ;
    ; Creates a memory context to hold the bitmap
    Protected hdcMem = CreateCompatibleDC_(hdcWindow)
    If hdcMem
      ; Selects the bitmap into the memory context
      Protected oldBmp = SelectObject_(hdcMem, hBitmap)
      ; Copies the resized bitmap into the window or gadget
      StretchBlt_(hdcWindow, 0, 0, destWidth, destHeight, hdcMem, 0, 0, bmp\bmWidth, bmp\bmHeight, #SRCCOPY)
      ; Cleans up the memory context
      DeleteDC_(hdcMem)
    Else
      Debug "Unable to create CompatibleDC"
    EndIf
  EndIf
EndProcedure
;
Import "gdiplus.lib"
  GdiplusStartup(*token, *input, *output)
  GdiplusShutdown(token)
  GdipCreateHBITMAPFromBitmap(Bitmap.i, *GdiPImage, *background)
  GdipLoadImageFromStream(pStream.IStream, *GdiPImage)
  GdipDisposeImage(GdiPImage.i)
EndImport
;
Procedure ShowStreamedPictInWindow(hWd, *pStream)
  Protected *pImage, hBitmap, SC
  ;
  Shared GdiplusToken ; Must be shared or global to be accepted by GdiplusStartup
  Structure GdiplusStartupInput
    GdiplusVersion.l
    DebugEventCallback.l
    SuppressBackgroundThread.l
    SuppressExternalCodecs.l
  EndStructure
  Protected GdiplusStartupInput.GdiplusStartupInput
  
  GdiplusStartupInput\GdiplusVersion = 1
  SC = GdiplusStartup(@GdiplusToken, @GdiplusStartupInput, #Null)
  If SC = #S_OK
    SC = GdipLoadImageFromStream(*pStream, @*pImage)
    If SC = #S_OK
    
      ; Convertir l'image GDI+ en HBITMAP
      SC = GdipCreateHBITMAPFromBitmap(*pImage, @hBitmap, 0)
      If SC = #S_OK
        ShowBitmapPictInWindow(hWd, hBitmap)
        DeleteObject_(hBitmap)
      Else
        Debug "Unable to create bitmap with GdiPlus: " + GetWinErrorMessage(SC)
      EndIf
      
      ; Libérer l'image GDI+
      GdipDisposeImage(*pImage)
    Else
      Debug "Unable to load image with GdiPlus: " + GetWinErrorMessage(SC)
    EndIf
    GdiplusShutdown(GdiplusToken)
  Else
    Debug "Error while initializing GdiPlus: " + GetWinErrorMessage(SC)
  EndIf
EndProcedure
;
Procedure ShowPictFromStgMedium(hWd, *StgMed.STGMEDIUM, Format = 0)
  ;
  ; Displays the MetaFile or ENHMetafile or Bitmap or DIB contained in *StgMed
  ; in the window hWd.
  ;
  ; Declare a RECT structure to store the dimensions of the gadget/window
  Protected rect.RECT, hdcMem
  Protected XRatio.f, YRatio.f, SRatio.f
  Protected formatName$ = Space(256)
  GetClipboardFormatName_(Format, @formatName$, 256)
  Protected SupportedByGDI$ = ",PNG,JPG,JFIF,JPEG,TIFF,BMP,GIF,WMF,EMF,ICO,Windows Bitmap,"
  If FindString(SupportedByGDI$, "," + FormatName$ + ",")
    Protected Picture = 1
  Else
    Picture = 0
  EndIf
  ;
  ; Retrieve the dimensions of the gadget or window
  If GetClientRect_(hWd, @rect)
    ; Calculate the width and height of the gadget or window
    Protected destWidth = rect\right - rect\left
    Protected destHeight = rect\bottom - rect\top
    Protected hdcWindow = GetDC_(hWd)
    Protected brush = GetStockObject_(#WHITE_BRUSH)
    ;
    FillRect_(hdcWindow, @rect, brush)
    DeleteObject_(brush)
    
    ; Check if the STGMEDIUM contains a metafile
    If *StgMed And *StgMed\tymed = #TYMED_MFPICT
      ; Lock the memory to access the METAFILEPICT structure
      Protected *pMetaFile.METAFILEPICT = GlobalLock_(*StgMed\hMetaFilePict)
      If *pMetaFile
        ; Retrieve the metafile dimensions
        If *pMetaFile\hMF
          SRatio.f = *pMetaFile\xExt/*pMetaFile\yExt
          If SRatio < 1
            destWidth = destHeight*SRatio
          Else
            destHeight = destWidth/SRatio
          EndIf
          ; Set the mapping mode for the device context
          SetMapMode_(hdcWindow, #MM_ANISOTROPIC) ; Allows scaling adjustments
          SetViewportExtEx_(hdcWindow, destWidth, destHeight, 0)
          
          ; Display the metafile content scaled in the window or gadget
          PlayMetaFile_(hdcWindow, *pMetaFile\hMF)
        EndIf
        GlobalUnlock_(*StgMed\hMetaFilePict)
      EndIf

    ElseIf *StgMed And *StgMed\tymed = #TYMED_ENHMF
      If *StgMed\hEnhMetaFile
        ; Retrieve the Enhanced metafile header and its dimensions
        Protected enhMFHeader.ENHMETAHEADER
        GetEnhMetaFileHeader_(*StgMed\hEnhMetaFile, SizeOf(ENHMETAHEADER), @enhMFHeader)
        ;
        XRatio.f = (enhMFHeader\rclbounds\right - enhMFHeader\rclbounds\left)/destWidth
        YRatio.f = (enhMFHeader\rclbounds\bottom - enhMFHeader\rclbounds\top)/destHeight
        If XRatio < YRatio
          XRatio = YRatio
        EndIf
        ;
        ; Set the mapping mode for the device context
        Protected DispRect.rect
        DispRect\left = 0
        DispRect\top = 0
        DispRect\right = enhMFHeader\rclbounds\right/XRatio
        DispRect\bottom = enhMFHeader\rclbounds\bottom/XRatio
        ; Display the Enhanced Metafile content scaled in the window or gadget
        PlayEnhMetaFile_(hdcWindow, *StgMed\hEnhMetaFile, DispRect)
        ;
      EndIf
     ElseIf *StgMed And *StgMed\tymed = #TYMED_GDI And Format = #CF_BITMAP
      ShowBitmapPictInWindow(hWd, *StgMed\hBitmap)
      ;
    ElseIf *StgMed And *StgMed\tymed = #TYMED_HGLOBAL And Picture
      If *StgMed\hGlobal
        Protected *pStream.IStream
        If CreateStreamOnHGlobal_(*StgMed\hGlobal, #False, @*pStream) = #S_OK
          ShowStreamedPictInWindow(hWd, *pStream)
          *pStream\Release()
        EndIf
      EndIf
    ElseIf *StgMed And *StgMed\tymed = #TYMED_HGLOBAL And (Format = #CF_DIB Or Format = #CF_DIBV5)
      If *StgMed\hGlobal
        ; Lock the memory to access the DIB header
        Protected *pDIB = GlobalLock_(*StgMed\hGlobal)
        If *pDIB
          ; Retrieve DIB information
          If Format = #CF_DIB
            Protected bmpInfo.BITMAPINFOHEADER
            CopyMemory(*pDIB, @bmpInfo, SizeOf(BITMAPINFOHEADER))
            Protected pWidth = bmpInfo\biWidth
            Protected pHeight = bmpInfo\biWidth
            Protected headerSize = bmpInfo\biSize
          Else
            Protected bmpV5Info.BITMAPV5HEADER
            CopyMemory(*pDIB, @bmpV5Info, SizeOf(BITMAPV5HEADER))
            pWidth = bmpV5Info\bV5Width
            pHeight = bmpV5Info\bV5Width
            headerSize = bmpV5Info\bV5Width
          EndIf
          
          ; Calculate the ratio to maintain proportions
          SRatio.f = pWidth / pHeight
          If SRatio < 1
            destWidth = destHeight * SRatio
          Else
            destHeight = destWidth / SRatio
          EndIf
          ;
          ; Create a memory context to hold the DIB
          hdcMem = CreateCompatibleDC_(hdcWindow)
          If hdcMem
            ; Select and display the scaled DIB
            StretchDIBits_(hdcWindow, 0, 0, destWidth, destHeight, 0, 0, pWidth, pHeight, *pDIB + headerSize, *pDIB, #DIB_RGB_COLORS, #SRCCOPY)
            ; Clean up the memory context
            DeleteDC_(hdcMem)
          EndIf
          
          ; Unlock the memory
          GlobalUnlock_(*StgMed\hGlobal)
        EndIf
      EndIf
    EndIf
    ReleaseDC_(hWd, hdcWindow)
  EndIf
  
EndProcedure
;
Procedure.s ReadStringFromMemory(MemAdr, sFormat = #PB_Unicode, CF_Format = 0)
  Protected Ret$, *DataBufferTemp
  ;
  Ret$ = PeekS(MemAdr, 1000, sFormat) ; limited to 1000 characters.
  If CF_Format = #CF_OEMTEXT
    *DataBufferTemp = AllocateMemory((Len(Ret$) + 1)*2)
    If *DataBufferTemp
      ; Since we limited the size of the string read to 1000 characters,
      ; we re-PokeS the truncated string at the starting address
      ; to ensure that OemToChar does not exceed the size of the buffer
      ; we allocated for it:
      PokeS(MemAdr, Ret$, - 1, #PB_Ascii)
      ;
      OemToChar_(MemAdr, *DataBufferTemp)
      Ret$ = PeekS(*DataBufferTemp, 1000)
      FreeMemory(*DataBufferTemp)
      Ret$ = ReplaceString(Ret$,Chr(9834),Chr(13))
      Ret$ = ReplaceString(Ret$,Chr(9689),Chr(10))
    EndIf
  EndIf
  Ret$ = ReplaceString(Ret$, Chr(13), "¶")
  Ret$ = ReplaceString(Ret$, Chr(10), "")
  ProcedureReturn Ret$
EndProcedure
;
Procedure.s FormatHexFromL(Number, Length)
  ; Creates a string representing a number in hexadecimal form.
  Protected Arg, Ret$
  ;
  If Length = 8 : Arg = #PB_Quad
  ElseIf Length = 4 : Arg = #PB_Word
  ElseIf Length = 2 : Arg = #PB_Byte
  Else : Debug "FormatHexFromL: Asked Length not implemented in FormatHexFromL"
    ProcedureReturn ""
  EndIf
  Ret$ = Hex(Number, Arg)
  ProcedureReturn "$"+RSet(Ret$, Length, "0")
EndProcedure
;
Procedure.s AnalyseStringFromMemory(*Buffer, BufferSize)
  ;
  ; Based on a simple memory pointer, this procedure
  ; will attempt to determine if it points to a string
  ; and whether the string is in Unicode or ASCII.
  ;
  Protected lbyte, Chrlbyte$, str$
  If *Buffer
    Protected ReadLimit = BufferSize
    If ReadLimit > 20 : ReadLimit = 20 : EndIf
    ; Examines the memory byte by byte, counting
    ; the zeros to identify Unicode strings, and
    ; stacking the hexadecimal version of the bytes read in Hexstr$:
    Protected Hexstr$ = ""
    Protected Nb0 = 0
    Protected ct
    For ct = 0 To ReadLimit - 1
      lbyte = PeekB(*Buffer + ct)
      If lbyte < 0  : lbyte + 256 : EndIf
      If lbyte > 31 And lbyte < 128 Or lbyte > 159
        Chrlbyte$ = ":" + Chr(lbyte)
      Else 
        Chrlbyte$ = ""
      EndIf
      Hexstr$ + ReplaceString(FormatHexFromL(lByte,2), "$", "") + Chrlbyte$ + " "
      If lbyte = 0
        Nb0 + 1
      EndIf
    Next
    ;
    If Nb0 > ReadLimit * 0.4
      ; Nearly half of the bytes read are zeros.
      ; We assume it is a Unicode string.
      str$ = " / ''" + ReadStringFromMemory(*Buffer, #PB_Unicode) + "''."
    Else
      ; We assume it is an ASCII or Utf8 string.
      str$ = " / ''" + ReadStringFromMemory(*Buffer, #PB_Ascii) + "''."
      If FindString(str$, "Ã") Or FindString(str$, "Å") Or FindString(str$, "À") Or FindString(str$, "Á") Or FindString(str$, "Â") Or FindString(str$, "Ä")
        ; It seems that we get an UTF8 string.
        str$ = " / ''" + ReadStringFromMemory(*Buffer, #PB_UTF8) + "''."
        If FindString(str$, Chr(65533))
          ; Ooops! perhaps, it's not UTF8
          str$ = " / ''" + ReadStringFromMemory(*Buffer, #PB_Ascii) + "''."
        EndIf
      EndIf
    EndIf
    ; 
    If Len(str$) < 20
      ; The string is short, so it may not be a string.
      ; We will add the hexadecimal presentation of the bytes read.
      str$ + " / " + Hexstr$
      If ReadLimit < BufferSize
        ; We have only read part of the memory.
        str$ + "..."
      Else
        ; We have read the entire memory.
        str$ + "."
      EndIf
    EndIf
    ;
  EndIf
  ;
  ProcedureReturn str$
EndProcedure
;
Procedure.s ReadFirstBytesFromStream(*pStream.IStream, NumBytes.q, Canvas = 0)
  Protected *Buffer
  Protected BytesRead.l
  Protected pos.q, Ret$
  ;
  If *pStream
    If Canvas
      ShowStreamedPictInWindow(GadgetID(Canvas), *pStream)
    Else
      If *pStream\Seek(0, #STREAM_SEEK_END, @pos.q) = #S_OK
        If NumBytes = -1 Or NumBytes > pos
          NumBytes = pos
        EndIf
      EndIf
      ;
      If NumBytes < 1 : NumBytes = 40 : EndIf
        
      ; Allocate a buffer to read the bytes
      *Buffer = AllocateMemory(NumBytes)
      If *Buffer = 0
        Debug "Memory allocation error."
        ProcedureReturn
      EndIf
      ;
      ; Read the first bytes from the stream
      If *pStream\Seek(0, #STREAM_SEEK_SET, 0) = #S_OK
        If *pStream\Read(*Buffer, NumBytes, @BytesRead)  = #S_OK
          Ret$ = AnalyseStringFromMemory(*Buffer, NumBytes)
        Else
          Debug "Error while reading the IStream."
        EndIf
      Else
        Debug "Error while reading the IStream."
      EndIf
      FreeMemory(*Buffer)
    EndIf
  Else
    Debug "Invalid parameter: *pStream is null."
  EndIf
  
  ProcedureReturn Ret$
  ; 
EndProcedure
;
Procedure.s ReadFirstBytesFromStorage(*pStorage.IStorage, NumBytes, Canvas = 0)
  ;
  Structure STATSTG
    pwcsName.i        ; Pointeur vers le nom de l'objet (wide string).
    type.l            ; Type de l'objet (STGTY_STORAGE, STGTY_STREAM, etc.).
    cbSize.q          ; Taille de l'objet en octets.
    mtime.FILETIME    ; Date et heure de la dernière modification.
    ctime.FILETIME    ; Date et heure de la création.
    atime.FILETIME    ; Date et heure du dernier accès.
    grfMode.l         ; Mode d'accès utilisé pour ouvrir l'objet.
    grfLocksSupported.l ; Type de verrouillage supporté par l'objet.
    clsid.GUID        ; Identifiant de la classe (CLSID) pour le stockage.
    grfStateBits.l    ; Bits d'état actuels de l'objet de stockage.
    reserved.l        ; Réservé pour un usage futur (doit être zéro).
  EndStructure
  ;
  Protected *pEnum.IEnumSTATSTG
  Protected statStg.STATSTG
  Protected result
  Protected count.l = 0
  Protected *pStream.IStream
  Protected TypePrefixe$, Ret$
  ;
  ; Get an enumerator for the storage elements
  result = *pStorage\EnumElements(0, 0, 0, @*pEnum)
  If result <> #S_OK
    Debug "Failed to enumerate storage elements. Error: " + Str(result)
    ProcedureReturn
  EndIf
  ;
  ; Loop through the enumerator to find streams
  While *pEnum\Next(1, @statStg, 0) = #S_OK
    count + 1
    
    ; Check the type of element (stream or storage)
    Select statStg\type
      Case #STGTY_STREAM
        TypePrefixe$ = Chr(13) + "    • IStream named ''"+PeekS(statStg\pwcsName, -1, #PB_Unicode)+"''"
        If PeekS(statStg\pwcsName, -1, #PB_Unicode)
          ; Open the stream
          result = *pStorage\OpenStream(statStg\pwcsName, 0, #STGM_READ | #STGM_SHARE_EXCLUSIVE, 0, @*pStream)
          If result = #S_OK
            If Canvas
              ShowStreamedPictInWindow(GadgetID(Canvas), *pStream)
            Else
              Ret$ + TypePrefixe$ + ReadFirstBytesFromStream(*pStream, NumBytes, Canvas)
            EndIf
            ; Release the stream
            *pStream\Release()
          Else
            Debug "Failed to open the IStream ''" + PeekS(statStg\pwcsName, -1, #PB_Unicode) + "'' in the IStorage: " + GetWinErrorMessage(result)
          EndIf
        EndIf
        
      Case #STGTY_STORAGE
        Ret$ + Chr(13) + "    • IStorage named ''"+PeekS(statStg\pwcsName, -1, #PB_Unicode)+"''."
      Case #STGTY_LOCKBYTES 
        Ret$ + Chr(13) + "    • LockBytes content named ''"+PeekS(statStg\pwcsName, -1, #PB_Unicode)+"''."
      Case #STGTY_PROPERTY  
        Ret$ + Chr(13) + "    • Property content named ''"+PeekS(statStg\pwcsName, -1, #PB_Unicode)+"''."
        ;
      Default
        Ret$ + Chr(13) + "    • Unknown type data named ''"+PeekS(statStg\pwcsName, -1, #PB_Unicode)+"''."
        ;
    EndSelect
    ; Free the name string
    CoTaskMemFree_(statStg\pwcsName)
  Wend
  
  ; Clean up
  *pEnum\Release()
  
  ProcedureReturn Ret$
EndProcedure
;
Procedure.s EnumFormatsFromIDataObject(*pDataObject.IDataObject, PrintIt = 1, Canvas1 = 0, Canvas2 = 0, Canvas3 = 0)
  ;
  ; Enumerates the data contained by an IDataObject and provides
  ; a brief overview.
  ; If a gadget with the number Canvas1 exists, it will be filled
  ; with the MetaFile image found in the IDataObject.
  ; If a gadget with the number Canvas2 exists, it will be filled
  ; with the Bitmap or DIB/DIBV5 image found in the IDataObject.
  ; If a gadget with the number Canvas3 exists, it will be filled
  ; with formats such as PNG, JPG, JPEG, TIFF, BMP, GIF, WMF, EMF, ICO, Windows Bitmap
  ; found in the IDataObject.
  ; If PrintIt = 1, the list of found formats will be displayed in
  ; the 'Debug' window. In any case, it will be included in
  ; the return value.
  ;
  Protected *enumFormat.IEnumFORMATETC, stgm.STGMEDIUM
  Protected formatEtc.FORMATETC
  Protected sc.l, Ret$, tx$
  Protected ENHMetafile = 0
  ;
  If *pDataObject = 0
    MessageRequester("Oops!", "EnumFormatsFromIDataObject error: Parameter is null.")
    ProcedureReturn
  EndIf
  ;
  If Canvas1 And IsGadget(Canvas1)
    ; Clear the gadget used to display images from the IDataObject.
    ShowPictFromStgMedium(GadgetID(Canvas1), 0)
  EndIf
  If Canvas2 And IsGadget(Canvas2)
    ; Clear the gadget used to display images from the IDataObject.
    ShowPictFromStgMedium(GadgetID(Canvas2), 0)
  EndIf
  If Canvas3 And IsGadget(Canvas3)
    ; Clear the gadget used to display images from the IDataObject.
    ShowPictFromStgMedium(GadgetID(Canvas3), 0)
  EndIf
  ;
  Ret$ =   "____________________________________________________________" + Chr(13)
  ;
  ; Obtain the format enumerator from the IDataObject
  SC = *pDataObject\EnumFormatEtc(#DATADIR_GET, @*enumFormat)
  If SC = #S_OK And *enumFormat
    ;
    Ret$ + "  ***** Available formats found in the IDataObject : *****" + Chr(13)
    Ret$ + "____________________________________________________________" + Chr(13)
    ;
    ; Loop through all available formats
    While *enumFormat\Next(1, @formatEtc, #Null) = #S_OK
      *pDataObject\getData(formatEtc, @stgm.STGMEDIUM)
      Protected Format = WtoUnsignedI(formatEtc\cfFormat)
      ; Get the format name
      Protected FormatName$ = GetFormatName(Format)
      Protected SupportedByGDI$ = ",PNG,JPG,JPEG,JFIF,TIFF,BMP,GIF,WMF,EMF,ICO,Windows Bitmap,"
      If FindString(SupportedByGDI$, "," + FormatName$ + ",")
        Protected Picture = 1
      Else
        Picture = 0
      EndIf
      ;
      tx$ = " • " + FormatName$ + "/" + GetTymedName(stgm\tymed)
      ;
      If Format = #CF_LOCALE Or Format = #CF_OEMTEXT Or Format = #CF_TEXT Or Format = #CF_UNICODETEXT
        ;
        If stgm\tymed = #TYMED_HGLOBAL
          ;
          ; Get the handle to global memory
          Protected *pGlobalMemory = GlobalLock_(stgm\hGlobal)
          If *pGlobalMemory
            If Format = #CF_OEMTEXT Or Format = #CF_TEXT
              tx$ + " / ''" + ReadStringFromMemory(*pGlobalMemory, #PB_Ascii, Format) + "''"
            ElseIf Format = #CF_LOCALE
              Protected dLCID = PeekL(*pGlobalMemory)
              Protected languageName.s = Space(100)
              If GetLocaleInfo_(dLCID, #LOCALE_SLANGUAGE, @languageName, 100) > 0
                tx$ + " : " + languageName
              Else
                tx$ + " : Unknown language"
              EndIf
            Else;If Format = #CF_UNICODETEXT
              tx$ + " / ''" + ReadStringFromMemory(*pGlobalMemory) + "''"
            EndIf
          EndIf
          GlobalUnlock_(stgm\hGlobal)
        EndIf
        ;
      ElseIf Format = #CF_HDROP
        tx$ +  Chr(13) + "    • " + ReplaceString(HandleToFilesList(stgm\hGlobal), Chr(10), Chr(13) + "    • ")
        ;
      ElseIf stgm\tymed = #TYMED_FILE
        tx$ + " / ''" + PeekS(stgm\lpszFileName, -1, #PB_Unicode) + "''."
        ;
      ElseIf stgm\tymed = #TYMED_MFPICT Or stgm\tymed = #TYMED_ENHMF Or stgm\tymed = #TYMED_GDI Or (stgm\tymed And (Format = #CF_DIB Or Format = #CF_DIBV5))
        tx$ + " / See the picture below."
        ;
        If Canvas1 And IsGadget(Canvas1) And ((Format = #CF_METAFILEPICT And ENHMetafile = 0) Or Format = #CF_ENHMETAFILE)
          If Format = #CF_ENHMETAFILE : ENHMetafile = 1 : EndIf
          ShowPictFromStgMedium(GadgetID(Canvas1), stgm)
        EndIf
        If Canvas2 And IsGadget(Canvas2) And (Format = #CF_DIB Or Format = #CF_DIBV5 Or Format = #CF_BITMAP)
          ShowPictFromStgMedium(GadgetID(Canvas2), stgm, Format)
        EndIf
        ;
      ElseIf stgm\tymed = #TYMED_ISTREAM
        If Picture And Canvas3 And IsGadget(Canvas3)
          tx$ + " / See the picture below."
          ReadFirstBytesFromStream(stgm\pstm, 100, Canvas3)
        Else
          tx$ + ReadFirstBytesFromStream(stgm\pstm, 100)
        EndIf
        ;
      ElseIf stgm\tymed = #TYMED_ISTORAGE
        If Picture And Canvas3 And IsGadget(Canvas3)
          tx$ + " / See the picture below."
          ReadFirstBytesFromStorage(stgm\pstg, 100, Canvas3)
        Else
          tx$ + ReadFirstBytesFromStorage(stgm\pstg, 100)
        EndIf
      ElseIf stgm\tymed And stgm\hGlobal And GlobalSize_(stgm\hGlobal)
        ;
        If Picture And Canvas3 And IsGadget(Canvas3)
          tx$ + " / See the picture below."
          ShowPictFromStgMedium(GadgetID(Canvas3), stgm, Format)
        Else
          ;
          ; We don't know what type of data we are dealing with.
          ; We will still try to read it as if it were characters
          ; to see what happens:
          ;
          tx$ + AnalyseStringFromMemory(GlobalLock_(stgm\hGlobal), GlobalSize_(stgm\hGlobal))
          GlobalUnlock_(stgm\hGlobal)
        EndIf
        ;
      ElseIf stgm\hGlobal <> 0
        tx$ + " / hGlobal = " + Str(stgm\hGlobal)
      ElseIf stgm\tymed = #Null Or stgm\hGlobal = 0
        tx$ + " / stgm\hGlobal = " + Str(stgm\hGlobal) + " / StgMedium\pUnkForRelease = " + Str(stgm\pUnkForRelease) + " / Format\dwAspect = " + Str(formatEtc\dwAspect) + " / Format\ptd = " + Str(formatEtc\ptd) + " / Format\lindex = " + Str(formatEtc\lindex)
      Else
        tx$ + "stgm\hGlobal = "+Str(stgm\hGlobal)
      EndIf
      ;
      If tx$
        Ret$ + tx$ + Chr(13)
      EndIf
      ReleaseStgMedium_(stgm)
    Wend
    ;
    ; Release the enumerator
    *enumFormat\Release()
  Else
    Ret$ = "Error : Unable to open format enumerator."
  EndIf
  Ret$ + "____________________________________________________________" + Chr(13)
  ;
  If PrintIt
    Debug Ret$
  EndIf
  ProcedureReturn Ret$
EndProcedure
;
Procedure ExamineClipboard()
  ;
  Protected MyWindow, txtrange.CHARRANGE
  Protected EGadget, CGadget1, CGadget2, CGadget3, RedoButton, QuitButton
  Protected ct, Init, NewDataObject.IDataObject
  ;
  MyWindow = OpenWindow(#PB_Any, 0, 0, 600, 600, "What's in my Clipboard?", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  If MyWindow
    ;
    txtrange.CHARRANGE\cpMin = -1 ;  début de la sélection. 
    txtrange\cpMax           = -1 ; fin de la sélection
   
    EGadget = EditorGadget(#PB_Any, 5, 5, WindowWidth(MyWindow)-10, WindowHeight(MyWindow)-240)
    SendMessage_(GadgetID(EGadget), #EM_SETTEXTMODE, #TM_RICHTEXT, 0) ; To be able to paste pictures in our EditorGadget
    
    ImageWidth = (WindowWidth(MyWindow)-20)/3
    TextGadget(#PB_Any, 5, WindowHeight(MyWindow)-240 + 15, 170, 20, "Pict Metafile/ENHMetafile")
    CGadget1 = CanvasGadget(#PB_Any, 5, WindowHeight(MyWindow)-240 + 35, ImageWidth, 175)
    ;
    TextGadget(#PB_Any, ImageWidth + 5 + 5, WindowHeight(MyWindow)-240 + 15, 170, 20, "Bitmap/DIB/DIBV5 Picture")
    CGadget2 = CanvasGadget(#PB_Any, ImageWidth + 10, WindowHeight(MyWindow)-240 + 35, ImageWidth, 175)
    ;
    TextGadget(#PB_Any, (ImageWidth + 5)*2 + 5, WindowHeight(MyWindow)-240 + 15, 170, 20, "PNG/JPG/JPEG/TIFF/GIF/ICO")
    CGadget3 = CanvasGadget(#PB_Any, (ImageWidth + 5)*2 + 5, WindowHeight(MyWindow)-240 + 35, ImageWidth, 175)
    
    RedoButton = ButtonGadget(#PB_Any, 5, WindowHeight(MyWindow) - 25, 120, 20, "Refresh")
    QuitButton = ButtonGadget(#PB_Any, WindowWidth(MyWindow)-125, WindowHeight(MyWindow) - 25, 120, 20, "Quit")
    ;
    SetActiveGadget(EGadget)
    ;
    ; We let the entire window draw
    ; so that our images can be redrawn
    ; over an existing environment:
    For ct = 1 To 100
      WindowEvent()
    Next
    ;
    Init = 1
    ;
    Repeat
      Event = WaitWindowEvent()
      If Event = #PB_Event_Gadget Or init
        EventGadget = EventGadget()
        If EventGadget = QuitButton
          Event = #PB_Event_CloseWindow
        ElseIf EventGadget = RedoButton Or init
          If Init = 0 : NewDataObject.IDataObject\Release() : EndIf
          OleGetClipboard_(@NewDataObject)
          SetGadgetText(EGadget, EnumFormatsFromIDataObject(NewDataObject, 0, CGadget1, CGadget2, CGadget3) + Chr(13) + Chr(13))
          SendMessage_(GadgetID(EGadget), #EM_EXSETSEL, 0, @txtrange)
        EndIf
      EndIf
      init = 0
    Until Event = #PB_Event_CloseWindow
  EndIf
EndProcedure

ExamineClipboard()