IDENTIFICATION DIVISION.
       PROGRAM-ID. TESTCLIP.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. IBM-PC.
       OBJECT-COMPUTER. IBM-PC.
       SPECIAL-NAMES.
      **   CALL-CONVENTION 66 IS WINDLL
      **   CALL-CONVENTION 66 IS WINAPI.
      **   CALL-CONVENTION 74 IS WINAPI.
           CALL-CONVENTION 0 WINAPI.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       77  GMEM-FIXED-HEX-ZEROED PIC 9(04) COMP-5 VALUE 8194.
       77  CF-TEXT       PIC X(02) VALUE X'0100'.
       77  CF-TEXT2      PIC X(02) VALUE X'0100'.
       77  CF-TEXT3      PIC 9(04) COMP-5 VALUE 1.
       77  CF-TEXT4      PIC X(02) VALUE X'0100'.
       77  ERROR-PAUSE   PIC X(01).
       77  DWORD         PIC 9(15) COMP-5.
       77  UNPACK        PIC 9(08).
       77  I             PIC 9(04) COMP-5 VALUE 0.
       77  J             PIC 9(04) COMP-5 VALUE 0.
       77  K             PIC 9(04) COMP-5 VALUE 0.
       77  L             PIC 9(04) COMP-5 VALUE 0.
       77  M             PIC 9(04) COMP-5 VALUE 0.
       77  Z91           PIC 9(04) COMP-5.
       77  Z92           PIC 9(04) COMP-5.
       77  Z93           PIC 9(08) COMP-5.
       77  Z94           PIC 9(08) COMP-5.
       77  RET-CODE      PIC 9(08) COMP-5 VALUE 0.
       01  PROGRAM-FIELDS.
           05  GLOBALALLOC          PIC X(24) VALUE 'GlobalAlloc'.
           05  GLOBALUNLOCK         PIC X(24) VALUE 'GlobalUnlock'.
           05  GLOBALLOCK           PIC X(24) VALUE 'GlobalLock'.
           05  GLOBALSIZE           PIC X(24) VALUE 'GlobalSize'.
           05  SETCLIPBOARDDATA     PIC X(24) VALUE 'SetClipboardData'.
           05  OPENCLIPBOARD        PIC X(24) VALUE 'OpenClipboard'.
           05  EMPTYCLIPBOARD       PIC X(24) VALUE 'EmptyClipboard'.
           05  LOADLIBRARYA         PIC X(24) VALUE 'LoadLibraryA'.
           05  GETDLL               PIC X(24) VALUE 'GetProcAddress '.
           05  DLL-BUFFER-LEN       PIC 9(08) COMP-5 VALUE 200.
           05  DLL-HANDLE           PIC 9(08) COMP-5.
           05  DLL-LIBRARY          PIC X(24) VALUE SPACES.
           05  DLL-ZERO             PIC 9(08) COMP-5 VALUE ZERO.
           05  DLL-PTR              PROCEDURE-POINTER.
           05  DLL-PTR-X REDEFINES DLL-PTR PIC X(04).
           05  LINK-DLL-PTR         PROCEDURE-POINTER.
           05  LINK-DLL-PTR-X REDEFINES LINK-DLL-PTR PIC X(04).
           05  LINK-DLL-PTR-9 REDEFINES LINK-DLL-PTR PIC 9(08) COMP-5.
           05  DLL-NAME.
               10  DNAME OCCURS 20 TIMES PIC X(01).
           05  FILLER    PIC X(01) VALUE X'00'.
           05  SIMPLEDLL PIC X(24).
           05  NOCMD     PIC 9(05) COMP-5 VALUE 0.
           05  NOARG     POINTER.
           05  NOARG-9 REDEFINES NOARG PIC 9(08) COMP-5.
           05  DEREF     POINTER.
           05  DEREF-X REDEFINES DEREF PIC X(04).
           05  DEREF-9 REDEFINES DEREF PIC 9(08) COMP-5.
       LINKAGE SECTION.
       01  CLIP-DATA               PIC X(63).
       PROCEDURE DIVISION.
       A-000-MAIN.
       A-001-PROCESS.
           CALL GlobalAlloc USING
                            BY VALUE ZERO.
           MOVE 63 TO DWORD
           MOVE 64 TO GMEM-FIXED-HEX-ZEROED
           CALL GlobalAlloc USING
                            BY VALUE GMEM-FIXED-HEX-ZEROED
                            BY VALUE DWORD
                            RETURNING LINK-DLL-PTR
           CALL GlobalSize USING
                           BY VALUE LINK-DLL-PTR-9
           MOVE RETURN-CODE TO Z94
           CALL GlobalLock USING
                           BY VALUE LINK-DLL-PTR
                           RETURNING DEREF
           SET ADDRESS OF CLIP-DATA TO DEREF
           MOVE SPACES TO CLIP-DATA
           MOVE 'NOTHING COULD BE FINER THAN TO BE IN CURACAO....'
            TO CLIP-DATA
           MOVE X'0D0A00' TO CLIP-DATA (59:3)
           CALL  GlobalUnLock USING
                              BY VALUE LINK-DLL-PTR
           CALL OpenClipboard  USING
                               BY VALUE 0.
           CALL EmptyClipboard.
           CALL SetClipboardData USING
                                 BY VALUE  CF-TEXT3
                                 BY VALUE  LINK-DLL-PTR
                                 RETURNING NOARG
           IF RETURN-CODE = 0
               CALL WINAPI 'GetLastError'
               DISPLAY 'LAST ERROR RC =:' RETURN-CODE
           END-IF
           CALL WINAPI 'CloseClipboard'.
           STOP RUN.