IDENTIFICATION DIVISION. PROGRAM-ID. VFILE1. 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 2 IS WINAPI. ** CALL-CONVENTION 0 WINAPI. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. WORKING-STORAGE SECTION. 77 FIRST-TIME PIC X(01) VALUE '1'. 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 VIX PIC 9(04) COMP-5 VALUE 0. 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 GETCLIPBOARDDATA PIC X(24) VALUE 'GetClipboardData'. 05 OPENCLIPBOARD PIC X(24) VALUE 'OpenClipboard'. 05 CLOSECLIPBOARD PIC X(24) VALUE 'CloseClipboard'. 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 VP PROCEDURE-POINTER. 05 VP-X REDEFINES VP PIC X(04). 05 VP-9 REDEFINES VP 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. 01 VTABLE. 05 VTABLE-ELEMENTS OCCURS 255 TIMES. 10 VID PIC 9(04) COMP-5. 10 VPTR USAGE POINTER. 10 VPTR-9 REDEFINES VPTR PIC 9(09) COMP-5. LINKAGE SECTION. 01 LINK-HID PIC 9(04) COMP-5. 01 LINK-HSTAT PIC X(02). 01 LINK-OFFSET PIC 9(09) COMP-5. 01 LINK-LEN PIC 9(09) COMP-5. 01 LINK-BUFFER PIC X(32755). 01 VBUFFER PIC X(32755). PROCEDURE DIVISION USING LINK-HID LINK-HSTAT LINK-OFFSET LINK-LEN LINK-BUFFER. DISPLAY 'ENTERING VFILE' UPON CONSOLE. GOBACK. ** CBL_READ_VFILE ENTRY 'CBL_OPEN_VFILE' USING LINK-HID LINK-HSTAT DISPLAY 'IN OPEN V' IF FIRST-TIME = '1' MOVE LOW-VALUES TO VTABLE MOVE 1 TO VIX MOVE '0' TO FIRST-TIME ELSE ADD 1 TO VIX END-IF. MOVE 10000000 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 DISPLAY 'AFTER ALLOC RC =:' LINK-DLL-PTR-9 CALL GlobalSize USING BY VALUE LINK-DLL-PTR-9 MOVE RETURN-CODE TO Z94 DISPLAY 'AFTER ALLOC RC =:' RETURN-CODE CALL GlobalLock USING BY VALUE LINK-DLL-PTR RETURNING DEREF ** CALL GlobalUnlock USING ** BY VALUE LINK-DLL-PTR MOVE DEREF-9 TO VPTR-9 (VIX). DISPLAY 'AFTER UNLOCK' MOVE '00' TO LINK-HSTAT. MOVE VIX TO LINK-HID. DISPLAY 'GOBACK FROM CBL_OPEN_VFILE' MOVE 0 TO RETURN-CODE GOBACK. ** CBL_READ_VFILE ENTRY 'CBL_READ_VFILE' USING LINK-HID LINK-OFFSET LINK-LEN LINK-BUFFER. MOVE 0 TO J. PERFORM VARYING I FROM 1 BY 1 UNTIL I > VIX IF LINK-HID = VID (I) MOVE I TO J MOVE VIX TO I END-IF END-PERFORM. IF J = 0 MOVE 8 TO RETURN-CODE GOBACK END-IF. MOVE VPTR (J) TO VP. SET ADDRESS OF VBUFFER TO VP. MOVE VBUFFER (LINK-OFFSET : LINK-LEN) TO LINK-BUFFER (1:LINK-LEN). MOVE 0 TO RETURN-CODE GOBACK. ** CBL_WRITE_VFILE ENTRY 'CBL_WRITE_VFILE' USING LINK-HID LINK-OFFSET LINK-LEN LINK-BUFFER. MOVE 0 TO J. PERFORM VARYING I FROM 1 BY 1 UNTIL I > VIX IF LINK-HID = VID (I) MOVE I TO J MOVE VIX TO I END-IF END-PERFORM. IF J = 0 MOVE 8 TO RETURN-CODE GOBACK END-IF. MOVE VPTR (J) TO VP. SET ADDRESS OF VBUFFER TO VP. MOVE LINK-BUFFER (1:LINK-LEN) TO VBUFFER (LINK-OFFSET : LINK-LEN) MOVE 0 TO RETURN-CODE GOBACK.