Ver Mensaje Individual
  #8
Antiguo 12 de febrero de 2017, 18:19
Kuk
Administrador
Última Actividad 19.09.2026 20:11
Posts Posts: 2.500
Likes enviados Enviados: 1037
Likes recibidos Recibidos: 1207

Recato53, aquí tienes lo que necesitas, lo he comprobado y funciona. En realidad es un ejemplo de cómo compartir memoria entre 2 procesos.

En el programa llamante hacemos:

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01  hMapFile    BINARY-LONG.
  5.  01  ADR         POINTER.
  6.  01  nADR REDEFINES ADR
  7.                  PIC S9(9) COMP-5.
  8.  01  LastError   PIC S9(9) COMP-5.
  9.  
  10.  LINKAGE SECTION.
  11.  01  InternetRC  PIC S9(4) COMP-5.
  12.  
  13.  PROCEDURE       DIVISION.
  14.    
  15.      *> CREAMOS LA MEMORIA
  16.      CALL "CreateFileMappingA" WITH STDCALL USING BY VALUE -1  *> INVALID_HANDLE_VALUE
  17.                                                   BY VALUE 0   *> NULL
  18.                                                   BY VALUE 4   *> PAGE_READWRITE
  19.                                                   BY VALUE 0  
  20.                                                   BY VALUE 4 *> TAMAÑO MEMORIA EN BYTES
  21.                                                   BY CONTENT "VarComp" & X"00" *> NOMBRE DE LA MEMORIA
  22.                                                   RETURNING hMapFile
  23.    
  24.      *> COMPROBAMOS LA REFERENCIA
  25.      IF  hMapFile = ZEROS
  26.          INVOKE POW-SELF "DisplayMessage"
  27.           USING "Error creando Memoria Compartida" 16
  28.          
  29.          EXIT PROGRAM
  30.      END-IF
  31.    
  32.      *> OBTENEMOS EL PUNTERO
  33.      CALL "MapViewOfFile" WITH STDCALL USING BY VALUE hMapFile
  34.                                              BY VALUE H"0F001F" *> FILE_MAP_ALL_ACCESS
  35.                                              BY VALUE 0
  36.                                              BY VALUE 0
  37.                                              BY VALUE 4 *> TAMAÑO MEMORIA EN BYTES
  38.                                              RETURNING ADR
  39.    
  40.      
  41.      *> SI NO HEMOS OBTENIDO EL PUNTERO, MIRAMOS POR QUE
  42.      IF  ADR = NULL
  43.          CALL "GetLastError" WITH STDCALL RETURNING LastError
  44.          
  45.          INVOKE POW-SELF "DisplayMessage"
  46.           USING "Error creando Memoria Compartida" LastError 16
  47.          
  48.          CALL "CloseHandle" WITH STDCALL USING BY VALUE hMapFile
  49.      
  50.      ELSE
  51.         *> SI TENEMOS EL PUNTERO, MAPEAMOS A LA VARIABLE
  52.          SET ADDRESS OF InternetRC TO ADR
  53.      END-IF
  54.          
  55.      MOVE POW-FALSE TO "Enabled" OF CmCommand1
  56.      
  57.      INVOKE POW-SELF "ExecuteSync" USING "INTERNET.EXE"
  58.      
  59.      MOVE POW-TRUE TO "Enabled" OF CmCommand1
  60.      
  61.      IF  InternetRC = 1
  62.          INVOKE POW-SELF "DisplayMessage"
  63.           USING "¡Hay conexión a Internet!" 64
  64.          
  65.      ELSE
  66.          INVOKE POW-SELF "DisplayMessage"
  67.           USING "NO hay conexión a Internet..." 48
  68.      END-IF          
  69.  
  70.      *> ELIMINAMOS LA MEMORIA CREADA
  71.      CALL "CloseHandle" WITH STDCALL USING BY VALUE hMapFile
  72.          

En el programa llamado hacemos:

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01  hMapFile    BINARY-LONG.
  5.  01  ADR         POINTER.
  6.  01  nADR REDEFINES ADR
  7.                  PIC S9(9) COMP-5.  
  8.  01  LastError   PIC S9(9) COMP-5.              
  9.  
  10.  01 CONEXION     PIC X(30).
  11.  01 ST-INTERNET  PIC S9(9) COMP-5.
  12.  01 FUNC         PIC X(24).    
  13.  
  14.  LINKAGE SECTION.
  15.  01  InternetRC  PIC S9(4) COMP-5.
  16.  PROCEDURE       DIVISION.
  17.          
  18.      MOVE "http://www.google.es" & X"00" TO CONEXION
  19.    
  20.      MOVE "InternetCheckConnectionA" TO FUNC
  21.  
  22.      CALL FUNC WITH STDCALL USING
  23.               by reference CONEXION
  24.               by value 1
  25.               by value 0
  26.               returning ST-INTERNET    
  27.      END-CALL                
  28.    
  29.      *> ACCEDEMOS A LA MEMORIA CREADA
  30.      CALL "OpenFileMappingA" WITH STDCALL USING BY VALUE H"0F001F" *> FILE_MAP_ALL_ACCESS
  31.                                                 BY VALUE 0
  32.                                                 BY CONTENT "VarComp" & X"00" *> NOMBRE DE LA MEMORIA
  33.                                                 RETURNING hMapFile
  34.                                                    
  35.      IF  hMapFile = ZEROS
  36.          INVOKE POW-SELF "DisplayMessage"
  37.           USING "Error accediendo a la Memoria Compartida" 16
  38.          
  39.          EXIT PROGRAM
  40.      END-IF
  41.    
  42.      *> OBTENEMOS EL PUNTERO    
  43.      CALL "MapViewOfFile" WITH STDCALL USING BY VALUE hMapFile
  44.                                              BY VALUE H"0F001F" *> FILE_MAP_ALL_ACCESS
  45.                                              BY VALUE 0
  46.                                              BY VALUE 0
  47.                                              BY VALUE 4
  48.                                              RETURNING ADR
  49.                                                
  50.      IF  ADR = NULL
  51.          CALL "GetLastError" WITH STDCALL RETURNING LastError
  52.          
  53.          INVOKE POW-SELF "DisplayMessage"
  54.           USING "Error obteniendo puntero de Memoria Compartida" LastError 16        
  55.      
  56.      ELSE
  57.          SET ADDRESS OF InternetRC TO ADR
  58.          
  59.          MOVE ST-INTERNET TO InternetRC        
  60.      END-IF

Incluyo el proyecto por si a caso
Archivos Adjuntos
Tipo de Archivo: rar INTERTET CONX.rar (111,9 KB)Descargas: 114



NORMAS DEL FORO - para garantizar el buen funcionamiento del Foro.
¿Te han ayudado? NO TE OLVIDES de darle a
¿Quieres dirigirte a alguien en tu post? Notifícale haciendo clic en su Nick
Kuk is offline   Responder Con Cita