IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

Using FTPCONNECT, FTPGET, FTPPUT


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
mrar_160

New User


Joined: 14 Sep 2005
Posts: 48

PostPosted: Mon Feb 27, 2006 8:53 am
Reply with quote

HI all.
may i know, if anyone have an experience in using FTPCONNECT,FTPPUT,FTPGET?

I found a cobol program for using FTP. But when i compile the program i got mgs
Quote:
"FTPCONNECT" was invalid
..

This is the cobol pgm:
Code:

000046        1 TCPIP-RETURN-CODES.
000047        5 TCPIP-RETURN-CODE                          PIC 9(07).
000048        5 TCPIP-RETURN-MESSAGE                       PIC X(255).
000049        main.
000069             MOVE `deskware.com` TO WS-HOST-NAME.
000070             MOVE `anonymous` TO WS-USER.
000071             MOVE `cobolscript@deskware.com` TO WS-PASSWORD.
000072
000073             FTPCONNECT USING WS-HOST-NAME WS-USER WS-WORD.
000074             DISPLAY `FTPCONNECT TCPIP-RETURN-CODES: ` & TCPIP-RETURN-CODES.
000075
000076             FTPBINARY.
000077             DISPLAY `FTPASCII TCPIP-RETURN-CODES: `  & TCPIP-RETURN-CODES.
000078
000079             FTPCD USING `pub/cobol/win32/0.005`.
000080             DISPLAY `FTPCD TCPIP-RETURN-CODES: `  & TCPIP-RETURN-CODES.
000081
000082             FTPGET USING `sample5.cpy`.           
000083             DISPLAY `FTPGET TCPIP-RETURN-CODES: `  & TCPIP-RETURN-CODES.
000084 
000093             FTPCLOSE.
000094             DISPLAY 'FTPCLOSE TCPIP-RETURN-CODES: `  & TCPIP-RETURN-CODES.
000095
000096
000097             GOBACK.
 

i found this code here : www.cobolscript.com/ftp.htm
Anybody can run this program without error, let me know ok..
Back to top
View user's profile Send private message
ofer71

Global Moderator


Joined: 27 Dec 2005
Posts: 2358
Location: Israel

PostPosted: Mon Feb 27, 2006 11:39 am
Reply with quote

I think these are ANSI COBOL statements - not the COBOL you'll find on your mainframe.

O.
Back to top
View user's profile Send private message
mrar_160

New User


Joined: 14 Sep 2005
Posts: 48

PostPosted: Wed Mar 01, 2006 6:51 am
Reply with quote

Oo..
Em..How could i find the FTP comand in COBOL language?I mean, not using JCL to do the FTP..
I want to write a cobol program and include the FTP job inside the coding..
Anybody have any experience do this program?
Thank you.
Back to top
View user's profile Send private message
ofer71

Global Moderator


Joined: 27 Dec 2005
Posts: 2358
Location: Israel

PostPosted: Wed Mar 01, 2006 8:49 am
Reply with quote

In the mainframe, you don't have COBOL commands to interface with FTP. However, you can use the TSO command FTP from within your COBOL code.

To see how to invoke TSO commands from within COBOL, please look for examples in Google (I think the program name is COB2SYS/COB2TSO...).

O.
Back to top
View user's profile Send private message
mrar_160

New User


Joined: 14 Sep 2005
Posts: 48

PostPosted: Fri Mar 03, 2006 8:41 am
Reply with quote

Ok, i've got the URL..
But, i do not know whether this will work or not to call TSO FTP job or not..
Seem like will not work..
See the coding below.
Code:
//IBMUSERJ JOB (ACCT#),COB2TSO,
// NOTIFY=&SYSUID,
// CLASS=A,MSGCLASS=X,COND=(0,NE)
//COB2 EXEC PGM=IGYCRCTL
 CBL NOLIB,APOST,NODECK,OBJECT,NOSEQ,BUF(10000),DYNAM
 CBL NOMAP,NOLIST,NOOFFSET,NOXREF
       Identification Division.
         Program-ID. CB2TSOEV.
         Author. Gilbert Saint-Flour.
      ******************************************************************
      *                                                                *
      *   MODULE NAME = COB2TSO                                        *
      *                                                                *
      *   DESCRIPTIVE NAME = Issue TSO commands from a COBOL program.  *
      *                                                                *
      *   FUNCTION = This sample program demonstrates how to invoke    *
      *              TSO commands from a COBOL program using           *
      *              standard TSO services as documented in the        *
      *              TSO/E Programming Services manual.                *
      *                                                                *
      *              Most TSO commands, including CLISTs and REXX      *
      *              execs can be executed using this technique.       *
      *              TSO commands which require authorization          *
      *              (such as OUTPUT, SEND, TRANSMIT and RECEIVE)      *
      *              will not work.                                    *
      *                                                                *
      *   Origin = http://gsf-soft.com/Download/                       *
      *                                                                *
      ******************************************************************
       Data Division.
        Working-Storage Section.
         01 Filler.
           05 ws-dummy        Pic s9(8) Comp.
           05 ws-return-code  Pic s9(8) Comp.
           05 ws-reason-code  Pic s9(8) Comp.
           05 ws-info-code    Pic s9(8) Comp.
           05 ws-cppl-address Pic s9(8) Comp.
           05 ws-flags        Pic X(4) Value X'00010001'.
           05 ws-buffer       Pic X(256).
           05 ws-length       Pic s9(8) Comp Value 256.

       Procedure Division.
      *----------------------------------------------------------------*
      *          Call IKJTSOEV to create the TSO/E environment         *
      *----------------------------------------------------------------*
           CALL 'IKJTSOEV' Using ws-dummy
                                 ws-return-code
                                 ws-reason-code
                                 ws-info-code
                                 ws-cppl-address.
           IF ws-return-code > zero
             DISPLAY 'IKJTSOEV Failed, Return-code=' ws-return-code
                                     ' Reason-code=' ws-reason-code
                                     'Info-code='    ws-info-code
             MOVE ws-return-code to Return-code
             STOP RUN.
      *----------------------------------------------------------------*
      *          Build the TSO/E command in ws-buffer                  *
      *----------------------------------------------------------------*

           MOVE 'ALLOCATE DD(SYSPUNCH) SYSOUT HOLD' to ws-buffer.

      *----------------------------------------------------------------*
      *   Call the TSO/E Service Routine to execute the TSO/E command  *
      *----------------------------------------------------------------*
           CALL 'IKJEFTSR' Using ws-flags
                                 ws-buffer
                                 ws-length
                                 ws-return-code
                                 ws-reason-code
                                 ws-dummy.
           IF ws-return-code > zero
             DISPLAY 'IKJEFTSR Failed, Return-code=' ws-return-code
                                     ' Reason-code=' ws-reason-code
             MOVE ws-return-code to Return-code
             STOP RUN.

      *----------------------------------------------------------------*
      *          Check that the ALLOCATE command worked                *
      *----------------------------------------------------------------*
           DISPLAY 'ALLOCATE Worked ! ' Upon Syspunch.

           STOP RUN.
/*
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT2 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT3 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT4 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT5 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT6 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT7 DD UNIT=VIO,SPACE=(TRK,1)
//SYSLIN DD UNIT=VIO,SPACE=(TRK,1),DISP=(,PASS),BLKSIZE=3200
//*
//GO    EXEC PGM=LOADER,PARM=NOPRINT
//SYSLIN DD DSN=*.COB2.SYSLIN,DISP=(OLD,PASS)
//SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR
//SYSOUT DD SYSOUT=*
//SYSTSPRT DD SYSOUT=*



It stated that
" TSO commands which require authorization (such as OUTPUT, SEND, TRANSMIT and RECEIVE) will not work. "
FTP command require the authorization right?(Need username and password to perfome get/put command)

Anybody can give any comment?
TQ.[/code]
Back to top
View user's profile Send private message
superk

Global Moderator


Joined: 26 Apr 2004
Posts: 4652
Location: Raleigh, NC, USA

PostPosted: Thu Mar 09, 2006 3:28 am
Reply with quote

I'm on a z/OS V1R4 system and using IBM COBOL for OS/390 2.2.2, and using the IKJTSOEV and IKJEFTSR calls to run an FTP process works just fine.
Back to top
View user's profile Send private message
mrar_160

New User


Joined: 14 Sep 2005
Posts: 48

PostPosted: Thu Mar 09, 2006 7:16 am
Reply with quote

Oh ya?
superk, if you dont mine, can you post the example using the IKJTSOEV and IKJEFTSR calls to run an FTP? it is same like the code that i posted above?
Thank you..
Back to top
View user's profile Send private message
superk

Global Moderator


Joined: 26 Apr 2004
Posts: 4652
Location: Raleigh, NC, USA

PostPosted: Thu Mar 09, 2006 6:40 pm
Reply with quote

I'm not a programmer, so this code is rather crude:
Code:

       IDENTIFICATION DIVISION.               
       PROGRAM-ID. FTPIT.                     
       INSTALLATION.                           
       AUTHOR. SUPERK.                         
       DATE-WRITTEN. 3/8/2006.                 
                                               
       ENVIRONMENT DIVISION.                   
       INPUT-OUTPUT SECTION.                   
                                               
         FILE-CONTROL.                         
           SELECT FTP-INPUT ASSIGN TO S-INPUT 
             ORGANIZATION IS SEQUENTIAL       
             ACCESS IS SEQUENTIAL.             
                                               
       DATA DIVISION.                         
       FILE SECTION.                           
                                               
       FD  FTP-INPUT                           
           LABEL RECORD STANDARD               
           BLOCK 0 RECORDS                     
           RECORDING MODE F                   
           RECORD CONTAINS 80 CHARACTERS.                               
       01 INPUT-RECORD                 PIC X(80).                       
                                                                       
       WORKING-STORAGE SECTION.                                         
       01  FILLER.                                                     
           05  WS-DUMMY PIC S9(8) COMP.                                 
           05  WS-RETURN-CODE PIC S9(8) COMP.                           
           05  WS-REASON-CODE PIC S9(8) COMP.                           
           05  WS-INFO-CODE PIC S9(8) COMP.                             
           05  WS-CPPL-ADDRESS PIC S9(8) COMP.                         
           05  WS-FLAGS PIC X(4) VALUE X'00010001'.                     
           05  WS-BUFFER PIC X(256).                                   
           05  WS-LENGTH PIC S9(8) COMP VALUE 256.                     
                                                                       
       PROCEDURE DIVISION.                                             
           CALL 'IKJTSOEV' USING WS-DUMMY WS-RETURN-CODE WS-REASON-CODE
             WS-INFO-CODE WS-CPPL-ADDRESS.                             
           IF WS-RETURN-CODE > ZERO                                     
             DISPLAY 'IKJTSOEV FAILED, RETURN-CODE=' WS-RETURN-CODE     
             ' REASON-CODE=' WS-REASON-CODE 'INFO-CODE=' WS-INFO-CODE   
             MOVE WS-RETURN-CODE TO RETURN-CODE                         
             STOP RUN.                                                 
                                                                   
           OPEN OUTPUT FTP-INPUT.                                   
           MOVE SPACES TO INPUT-RECORD.                             
           MOVE 'SERVER PORT' TO INPUT-RECORD.                     
           WRITE INPUT-RECORD.                                     
           MOVE 'LS         ' TO INPUT-RECORD.                     
           WRITE INPUT-RECORD.                                     
           MOVE 'QUI        ' TO INPUT-RECORD.                     
           WRITE INPUT-RECORD.                                     
           CLOSE FTP-INPUT.                                         
                                                                   
           MOVE 'FTP' TO WS-BUFFER.                                 
           CALL 'IKJEFTSR' USING WS-FLAGS WS-BUFFER WS-LENGTH       
             WS-RETURN-CODE WS-REASON-CODE WS-DUMMY.               
           DISPLAY WS-BUFFER.                                       
           IF WS-RETURN-CODE > ZERO                                 
             DISPLAY 'IKJEFTSR FAILED, RETURN-CODE=' WS-RETURN-CODE
             ' REASON-CODE=' WS-REASON-CODE                         
             MOVE WS-RETURN-CODE TO RETURN-CODE                     
             STOP RUN.                                             
                                                                   
           MOVE ZEROS TO RETURN-CODE.                               
           STOP RUN.           
Back to top
View user's profile Send private message
mrar_160

New User


Joined: 14 Sep 2005
Posts: 48

PostPosted: Fri Mar 10, 2006 7:49 am
Reply with quote

superk,
Thank you..
I will try it..
Back to top
View user's profile Send private message
mrar_160

New User


Joined: 14 Sep 2005
Posts: 48

PostPosted: Fri Mar 10, 2006 3:08 pm
Reply with quote

I compiled the program and i got this error msg when try to link edit..
Why the symbol IKJTSOEV is unresolved?

Code:

1DFSMS/MVS V1 R4.0 BINDER     17:25:06 FRIDAY MARCH 10, 2006
 BATCH EMULATOR  JOB(PEPCOMP ) STEP(STEP1   ) PGM= HEWL      PROCEDURE(LKED    )
 IEW2456E 9207 SYMBOL IKJTSOEV UNRESOLVED.  MEMBER COULD NOT BE INCLUDED FROM THE DESIGNATED CALL LIBRARY.
 IEW2638S 4321 AN EXECUTABLE VERSION OF MODULE COBFTP EXISTS AND CANNOT BE REPLACED BY THE NON-EXECUTABLE MODULE JUST
          CREATED.
 IEW2008I 0F03 PROCESSING COMPLETED.  RETURN CODE =  12.


1----------------------
 MESSAGE SUMMARY REPORT
 ----------------------
  SEVERE MESSAGES        (SEVERITY = 12)
  2638

  ERROR MESSAGES         (SEVERITY = 08)
  2456

  WARNING MESSAGES       (SEVERITY = 04)
  NONE

  INFORMATIONAL MESSAGES (SEVERITY = 00)
  2008


  **** END OF MESSAGE SUMMARY REPORT ****

Back to top
View user's profile Send private message
martin9

Active User


Joined: 01 Mar 2006
Posts: 290
Location: Basel, Switzerland

PostPosted: Fri Mar 10, 2006 9:35 pm
Reply with quote

hy mrar_160,

you must include in your binder step (IEWL),
the library where the IKJTSOEV resides, ok.
the other question is: is it necessary, to call
IKJTSOEV statically? Try it dynamically and
the binder doesn't need to resolve that symbol.

martin9
Back to top
View user's profile Send private message
mrar_160

New User


Joined: 14 Sep 2005
Posts: 48

PostPosted: Tue Mar 14, 2006 7:44 am
Reply with quote

martin9..
Quote:

you must include in your binder step (IEWL),
the library where the IKJTSOEV resides

Actually iam not very expert in cobol MVS..
i dont know to include binder step.. icon_sad.gif

Quote:

Try it dynamically and
the binder doesn't need to resolve that symbol

Do you mean, i need to put any command not only to call IKJTSOEV then
the binder doesn't need to resolve that symbol?
Ok, i will try to put any command as well not only to call IKJTSOEV..
TQ.
Back to top
View user's profile Send private message
martin9

Active User


Joined: 01 Mar 2006
Posts: 290
Location: Basel, Switzerland

PostPosted: Tue Mar 14, 2006 1:46 pm
Reply with quote

hy,

this has nothing to do with cobol mvs directly.
you must bnd each obeject code before becoming
an executable. PGM=IEWL or HEWL..
look at yout compile job, there must be such a step,
normally after the compile step.
--> also: link edit , binder utility ...
in your syslib dd you must concatenate the dataset
containing IKJTSOEV...

to call a program dynamically means, you code
CALL PGM USING PAR1, PAR2 where PGM is X(08) including
the real program name as value. i.e IKJTSOEV
with this possibility, you concatanate the dataset containing
IKJTSOEV to the steplib dd.
the call will be resoved at run time.

martin9
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> COBOL Programming

 


Search our Forums:

Back to Top