IDENTIFICATION DIVISION. PROGRAM-ID. VFILE1. ** VFILE1 implements these fujitsu and micro focus cbl_ routines: ** cbl_open_vfile ** cbl_close_vfile ** cbl_write_vfile ** cbl_read_vfile ** ** currently cbl_close_file is not fully functional with gnucobol ** Reason: globalfree is defined in both winbase.h and windows.h ** globalfree is commented out - the local subpool index is freed ** ** Usage requires an initial CALL to VFILE1 - to expose CBL_XXXX ** ** TESTVFX.CBL is a test harness and example usage of the above 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 Z-OFF PIC 9(04) COMP-5. 77 Z-LEN PIC 9(04) COMP-5. 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. 78 GLOBALALLOC VALUE 'GlobalAlloc'. 78 GLOBALUNLOCK VALUE 'GlobalUnlock'. 78 GLOBALLOCK VALUE 'GlobalLock'. 78 GLOBALSIZE VALUE 'GlobalSize'. 78 GLOBALFREE VALUE 'GlobalFree'. 78 SETCLIPBOARDDATA VALUE 'SetClipboardData'. 78 GETCLIPBOARDDATA VALUE 'GetClipboardData'. 78 OPENCLIPBOARD VALUE 'OpenClipboard'. 78 CLOSECLIPBOARD VALUE 'CloseClipboard'. 78 EMPTYCLIPBOARD VALUE 'EmptyClipboard'. 78 LOADLIBRARYA VALUE 'LoadLibraryA'. 78 GETDLL VALUE 'GetProcAddress '. 01 PROGRAM-FIELDS. 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-HANDLE PROCEDURE-POINTER. 05 LINK-DLL-HANDLE-X REDEFINES LINK-DLL-HANDLE PIC X(04). 05 LINK-DLL-HANDLE-9 REDEFINES LINK-DLL-HANDLE 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. 10 VHANDLE USAGE POINTER. 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. * RETURN - THIS EXPOSES ENTRY POINTS BELOW GOBACK. ** CBL OPEN_VFILE ENTRY 'CBL_OPEN_VFILE' USING LINK-HID LINK-HSTAT * FIND AN EMPTY CELL TO ANCHOR THE MEMORY ALLOCATION IF FIRST-TIME = '1' MOVE LOW-VALUES TO VTABLE MOVE 1 TO VIX MOVE '0' TO FIRST-TIME ELSE MOVE 0 TO J PERFORM VARYING I FROM 1 BY 1 UNTIL I > 255 IF VID (I) = 0 MOVE I TO J MOVE 255 TO I END-IF END-PERFORM IF J = 0 MOVE 24 TO RETURN-CODE GOBACK END-IF MOVE J TO VIX END-IF. * GETMAIN / ALLOCATE MEMORY MOVE 10000000 TO DWORD MOVE 64 TO GMEM-FIXED-HEX-ZEROED CALL WINAPI GlobalAlloc USING BY VALUE GMEM-FIXED-HEX-ZEROED BY VALUE DWORD RETURNING LINK-DLL-HANDLE * LOCK MEMORY AND RETURN A POINTER FROM THE LINK-DLL-HANDLE ABOVE CALL winapi GlobalLock USING BY VALUE LINK-DLL-HANDLE RETURNING DEREF * MAKE THE MEMORY AVAILABLE VIA DEREF POPULATED BY THE CALL ABOVE CALL winapi GlobalUnlock USING BY VALUE LINK-DLL-HANDLE * STORE THE RETURNED SUB-POOL IN A LOCAL ARRAY INDEXED SERIALLY MOVE DEREF-9 TO VPTR-9 (VIX). MOVE '00' TO LINK-HSTAT. MOVE VIX TO LINK-HID. MOVE VIX TO VID (VIX). MOVE LINK-DLL-HANDLE TO VHANDLE (VIX). SET ADDRESS OF VBUFFER TO DEREF MOVE 0 TO RETURN-CODE GOBACK. ** CBL_READ_VFILE ENTRY 'CBL_READ_VFILE' USING BY VALUE LINK-HID BY VALUE LINK-OFFSET BY VALUE LINK-LEN BY REFERENCE LINK-BUFFER. * FIND THE MEMORY ADDRESS STORED IN THE MEMORY POOL 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. * ESTABLISH ADDRESSABILITY TO THE ALLOCATED MEMORY FOR THIS CELL 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 BY VALUE LINK-HID BY VALUE LINK-OFFSET BY VALUE LINK-LEN BY REFERENCE LINK-BUFFER. * FIND THE MEMORY ADDRESS STORED IN THE MEMORY POOL 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 12 TO RETURN-CODE GOBACK END-IF. MOVE VPTR (J) TO VP. * ESTABLISH ADDRESSABILITY TO THE ALLOCATED MEMORY FOR THIS CELL SET ADDRESS OF VBUFFER TO VP. MOVE LINK-BUFFER (1:LINK-LEN) TO VBUFFER (LINK-OFFSET : LINK-LEN) MOVE 0 TO RETURN-CODE GOBACK. ** CBL_CLOSE_VFILE ENTRY 'CBL_CLOSE_VFILE' USING LINK-HID 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 16 TO RETURN-CODE GOBACK END-IF. MOVE 0 TO VID (J) ** CALL WINAPI GlobalFree USING ** VHANDLE (J) MOVE 0 TO RETURN-CODE GOBACK.