[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
RE: Undesired CCSID conversion by FTPAPI
Hi Werner.
Please find attached a general ftp program that I have put together from all of Scott's advice and examples and ways of doing things (All Kudos to Scott). It will ftp effectively from any as400 to any ftp server including other as400s.
It requires some parameters to run.
IPFTPSERVER (Destination server ip)
IPUSERNAME (Username)
IPPASSWORD (Password)
IPRETURNCODE (Error code returned if any encountered)
IPRETURNMSG (Error message returned if any encountered)
IPREMOTEDIR (Remote directory name, where you are ftp'ing to eg. /Tmp/test/ftp)
IPLOCALDIR (Local directory Where the file you want to ftp is on your machine eg /tmp/test/ftp/source)
IPACTION (Action to take with the file once it has finished ftping 'N' for nothing, 'A' for archive, 'D' for delete)
IPCOMPLETEDIR (Whether you want to ftp the complete directory Y/N)
IPSUBDIRS (Whether you want the ftp to include sub directories as well Y/N)
IPWRITELOG (Do you want a log file Y/N)
IPCLEARLOG (Do you want the log file cleared before the ftp starts Y/N)
IPFILENAME (Complete filename of you want to ftp only a specific file eg TESTFTPSINGLEFILE.PDF or A mask which will ftp files that meet the criteria eg TEST will ftp all files with TEST in the name in the local directory)
IPLOGFILE (Location of the log file eg /tmp/test/testlogfile.txt
IPARCHIVE (Location of the archive if archive selected for option IPACTION)
Could you run this program ftp'ing your file with a log file and see what the resulting CCSID is. I would be very interested.
Thanks
Ronnie Visser
-----Original Message-----
From: ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx [mailto:ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx] On Behalf Of Werner Noll (Gefis)
Sent: Monday, December 05, 2011 3:35 PM
To: 'HTTPAPI and FTPAPI Projects'
Subject: AW: Undesired CCSID conversion by FTPAPI
Hi Ronnie,
I'm little bit confused about the mentioned command STOR ...
I only use the FTP-APIs and cannot find there any STOR procedure.
What I'm doing in my RPG program (snippets after connect):
Step 1:
// Set Name Format
If FTP_NamFmt(fd:1) < *zeros;
CallP(E) FTP_Quit(fd); // Close FTP session
*inLR = *on;
Return;
EndIf;
Step 2:
CallP(E) FTP_BinaryMode(fd:*ON);
Step 3 (after reading the directory entries from a temp file):
If FTP_Put(fd:%trimr(#PthLvl3):%trimr(#PthLvl3))
< *zeros;
r$FTPErrMsg = FTP_Error();
FTP_Quit(fd); // Quit FTP-Session
*inLR = *on;
Return;
EndIf;
Step 4:
// And now we reset the CCSID to 500
p$FTPCmd = 'CHGATR OBJ(''' + %trimr(#PthLvl3) +
''') ATR(*CCSID) VALUE(500)';
If FTP_RmtCmd(fd:%trimr(p$FTPCmd)) < *zeros;
*inLR = *on;
Return;
EndIf;
This works fine for me. But nevertheless I wonder why the CCSID of the
target file was different to the source file although I used binary mode.
Probably the FTP_BinaryMode procedure fails somewhere, but I didn't find an
error yet.
Regards,
Werner Noll
Gesellschaft für Individual-Software mbH
Ludwigstrasse 15
63739 Aschaffenburg
Germany
Geschäftsführer: Werner Noll, Bernd Schröder
HR Aschaffenburg HRB 6020
Phone: +49-6021-299880
Fax: +49-6021-299882
e-mail: werner.noll@xxxxxxxxx
-----Ursprüngliche Nachricht-----
Von: ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx
[mailto:ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx] Im Auftrag von Ronnie
Gesendet: Montag, 5. Dezember 2011 09:43
An: HTTPAPI and FTPAPI Projects
Betreff: RE: Undesired CCSID conversion by FTPAPI
Hi Werner.
If FTP in binary mode were to change the CCSID of the destination file there
would be mayor implications for all ftp users to as400. I think your binary
mode setting is failing for some reason.
We would be very interested in the result of the STOR command from FTPAPI
which should look something like this :
> STOR INLY01JNB1124124036.txt
150 Opening BINARY mode data connection for INLY01JNB1124124036.txt.
If it does not say " BINARY mode data connection " its not a binary ftp.
FTPAPI uses Raw ftp command "TYPE I" for binary transfers.
Can you supply a log file of your ftp.
Thanks
-----Original Message-----
From: ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx
[mailto:ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx] On Behalf Of
thomas.raddatz@xxxxxx
Sent: Monday, December 05, 2011 9:40 AM
To: ftpapi@xxxxxxxxxxxxxxxxxxxxxx
Subject: AW: Undesired CCSID conversion by FTPAPI
Werner,
You may also try to explicitly set the CCSID of your data with the
following AS/400 specific FTP command before sending the file:
quote type c 1252
put ...
It works well for me.
Thomas.
ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx schrieb am 04.12.2011 16:13:22:
> Von: werner.noll@xxxxxxxxx
> An: ftpapi@xxxxxxxxxxxxxxxxxxxxxx
> Datum: 04.12.2011 16:26
> Betreff: AW: Undesired CCSID conversion by FTPAPI
> Gesendet von: ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx
>
> Hello Dennis,
>
> it took some time get the FTP_QUOTE or FTP_RMTCMD API executed on the
target
> iSeries system as there were a couple of additional security programs
> running which prohibited the access.
> Now it's working fine. I used FTP_RMTCMD but it would probably also run
with
> FTP_QUOTE.
>
> Many thanks for your help.
> Regards,
>
> Werner Noll
> Gesellschaft für Individual-Software mbH
> Ludwigstrasse 15
> 63739 Aschaffenburg
> Germany
> Geschäftsführer: Werner Noll, Bernd Schröder
> HR Aschaffenburg HRB 6020
> Phone: +49-6021-299880
> Fax: +49-6021-299882
> e-mail: werner.noll@xxxxxxxxx
> -----Ursprüngliche Nachricht-----
> Von: ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx
> [mailto:ftpapi-bounces@xxxxxxxxxxxxxxxxxxxxxx] Im Auftrag von Dennis
> Lovelady
> Gesendet: Freitag, 25. November 2011 15:27
> An: 'HTTPAPI and FTPAPI Projects'
> Betreff: RE: Undesired CCSID conversion by FTPAPI
>
> Hello, Werner:
>
> Scott and others can describe much more clearly than I why the FTP
server on
> the remote system does not (apparently) use the CCSID of the user
profile
> when creating a new IFS file. (I assume this is to go into IFS.)
>
> But as for resolution, if there is no way to get the system to create
these
> files with the desired CCSID, I would follow the transfer with a call to
> FTP_QUOTE() to set the desired CCSID. There are lots of other ways to
go
> about the same thing, such as creating the file beforehand, and using
> FTP_APPEND instead of FTP_PUT, et cetera.... Since these actions
> effectively become a part of the transfer, the concern about being a
batch
> process should be satisfied.
>
> I hope this helps.
>
> Dennis Lovelady
> http://www.linkedin.com/in/dennislovelady
> --
> "We lived for days on nothing but food and water."
> -- W.C. Fields
>
> > I use Scott Klement?s FTP APIs with great success for many years but I
> always
> > used them for communication with systems other than iSeries.
> >
> > Now I need to transfer a streamfile with CCSID 500 from one iSeries to
> another.
> >
> > It?s done on the source system by a special user profile with CCSID
500
> and
> > the user profile on the target system is specified identical.
> >
> > Although I set explicitly binary mode to *ON the file becomes after
> > transmission CCSID 819 and the data is unreadable.
> >
> > Of course it?s possible to change the CCSID by CHGATR command but it?s
not
> > practical as this transfer should be part of a batch process.
> >
> >
> >
> > Can anyone give me some hints on my problem?
> >
> > Many thanks in advance.
> >
> >
> >
> > Regards,
> >
> >
> >
> > Werner Noll
> > Gesellschaft für Individual-Software mbH Ludwigstrasse 15
> >
> > 63739 Aschaffenburg
> >
> > Germany
> >
> > Geschäftsführer: Werner Noll, Bernd Schröder
> >
> > HR Aschaffenburg HRB 6020
> > Phone: +49-6021-299880
> > Fax: +49-6021-299882
> >
> > e-mail: werner.noll@xxxxxxxxx
> >
> >
>
>
> -----------------------------------------------------------------------
> This is the FTPAPI mailing list. To unsubscribe, please go to:
> http://www.scottklement.com/mailman/listinfo/ftpapi
> -----------------------------------------------------------------------
>
> -----------------------------------------------------------------------
> This is the FTPAPI mailing list. To unsubscribe, please go to:
> http://www.scottklement.com/mailman/listinfo/ftpapi
> -----------------------------------------------------------------------
--
IMPORTANT NOTICE:
This email is confidential, may be legally privileged, and is for the
intended recipient only. Access, disclosure, copying, distribution, or
reliance on any of it by anyone else is prohibited and may be a criminal
offence. Please delete if obtained in error and email confirmation to the
sender.
-----------------------------------------------------------------------
This is the FTPAPI mailing list. To unsubscribe, please go to:
http://www.scottklement.com/mailman/listinfo/ftpapi
-----------------------------------------------------------------------
-----------------------------------------------------------------------
This is the FTPAPI mailing list. To unsubscribe, please go to:
http://www.scottklement.com/mailman/listinfo/ftpapi
-----------------------------------------------------------------------
// >>PRE-COMPILER<<
//
// >>CRTCMD<< CRTRPGMOD MODULE(&LI/&OB) +
// SRCFILE(&SL/&SF) +
// SRCMBR(&SM);
//
// >>COMPILE<<
// >>PARM<< TRUNCNBR(*NO);
// >>PARM<< DBGVIEW(*LIST);
// >>END-COMPILE<<
//
// >>EXECUTE<<
//
// >>CMD<< CRTPGM PGM(&LI/&OB) +
// MODULE(*PGM) +
// BNDSRVPGM(&LI/FTPAPIR4) +
// ACTGRP(*NEW);
//
// >>END-PRE-COMPILER<<
//
H BNDDIR('FTPAPI':'QC2LE') DFTACTGRP(*NO) ACTGRP(*NEW)
//
/COPY *libl/QRPGLESRC,FTPAPI_H
/COPY LIBFTP/QRPGLESRC,IFSIO_H
/copy *libl/qs36src,qp0lstdi_h
D ftp S 10I 0
D Msg S 52A
D ftpserver s 30A
D username s 64A
D password s 64A
D returncode s 10I 0
D returnmsg s 256A
D remotedir s 1024A
D localdir s 1024A
D action s 1A
D completedir s 1A
D subdirs s 1A
D writelog s 1A
D clearlog s 1A
D filename s 256A
D logfile s 256A
D archive s 256A
d localfile s 1024A
d localfile2 s 1024A
d logdirfile s 1024A
D teststr s 9999a
D wCmd s 9999a
d wCmdLen s 15p 5
D wwLen S 10I 0
D wwPos S 10I 0
D wwReply S 10I 0
D log S 10I 0
D Incoming S 256A DIM(9999)
D num_files S 10I 0
D fileno S 10I 0
D rc S 10I 0
D fd S 10I 0
D ErrNum S 10I 0
D putfiles S 10I 0
D err S 10I 0
D mystat s like(statds64)
D dh S *
d P ds likeds(Qlg_Path_Name_t)
D myPort S 10I 0 inz(-1)
D mySock S 10I 0 inz(-1)
D myAcct S 32A inz('*DEFAULT')
D myTimeout S 10I 0 inz(-1)
D Logger PR
D peMsgTxt 256A Const
D peLogFile 10I 0
D CompMsg PR
D peMsgTxt 256A Const
D DiagMsg PR
D peMsgTxt 256A Const
D errno PR 10I 0
D bitand PR 10U 0
D fact1 10U 0 value
D fact2 10U 0 value
D is_dir PR 1A
D peDir 640A const
D do_dir PR 10I 0
D peDir 640A const
D peArchive 640A const
D S_ISDIR PR 1N
D mode 10U 0 value
D c__errno PR * ExtProc('__errno')
D strerror PR * ExtProc('strerror')
D errnum 10I 0 value
D QCMD PR ExtPgm('QCMDEXC')
D wCmd 9999a const options(*varsize)
d wCmdLen 15p 5 const
D PUTFTPIFS pr
d IPFTPSERVER like(FTPSERVER)
d IPUSERNAME like(USERNAME)
d IPPASSWORD like(PASSWORD)
d IPRETURNCODE like(RETURNCODE)
d IPRETURNMSG like(RETURNMSG)
d IPREMOTEDIR like(REMOTEDIR)
d IPLOCALDIR like(LOCALDIR)
d IPACTION like(ACTION)
d IPCOMPLETEDIR like(COMPLETEDIR)
d IPSUBDIRS like(SUBDIRS)
d IPWRITELOG like(WRITELOG)
d IPCLEARLOG like(CLEARLOG)
d IPFILENAME like(FILENAME)
d IPLOGFILE like(LOGFILE)
d IPARCHIVE like(ARCHIVE)
D PUTFTPIFS pi
d IPFTPSERVER like(FTPSERVER)
d IPUSERNAME like(USERNAME)
d IPPASSWORD like(PASSWORD)
d IPRETURNCODE like(RETURNCODE)
d IPRETURNMSG like(RETURNMSG)
d IPREMOTEDIR like(REMOTEDIR)
d IPLOCALDIR like(LOCALDIR)
d IPACTION like(ACTION)
d IPCOMPLETEDIR like(COMPLETEDIR)
d IPSUBDIRS like(SUBDIRS)
d IPWRITELOG like(WRITELOG)
d IPCLEARLOG like(CLEARLOG)
d IPFILENAME like(FILENAME)
d IPLOGFILE like(LOGFILE)
d IPARCHIVE like(ARCHIVE)
//Äparameter entry list·
c* *entry plist
c* parm FTPSERVER
c* parm USERNAME
c* parm PASSWORD
c* parm RETURNCODE
c* parm RETURNMSG
c* parm REMOTEDIR
c* parm LOCALDIR
c* parm COMPLETEDIR
c* parm SUBDIRS
c* parm WRITELOG
c* parm CLEARLOG
c* parm FILENAME
c* parm LOGFILE
/FREE
//Input Validation
FTPSERVER = IPFTPSERVER;
USERNAME = IPUSERNAME;
PASSWORD = IPPASSWORD;
RETURNCODE = IPRETURNCODE;
RETURNMSG = IPRETURNMSG;
REMOTEDIR = IPREMOTEDIR;
LOCALDIR = IPLOCALDIR;
ACTION = IPACTION;
COMPLETEDIR = IPCOMPLETEDIR;
SUBDIRS = IPSUBDIRS;
WRITELOG = IPWRITELOG;
CLEARLOG = IPCLEARLOG;
FILENAME = IPFILENAME;
LOGFILE = IPLOGFILE;
ARCHIVE = IPARCHIVE;
if action = 'A' and archive = *blanks;
archive = LOCALDIR + '/Archive';
ENDIF;
if action = 'N' and archive <> *blanks;
archive = *blanks;
ENDIF;
if action = 'A' and archive = *blanks;
logger(' Archive selected but no archive folder specified' : log );
returncode = 999;
returnmsg = 'Archive selected but no archive folder specified';
*inlr = *on;
return;
ENDIF;
if action = 'A' and archive <> *blanks;
if %subst(archive:%len(%trim(archive)):1) <> '/'
and %trim(archive) = '/';
archive = %trim(archive) + '/';
ENDIF;
wwpos = %scan('%/LOCDIR%' : archive);
if wwpos > 0;
if wwpos = 1;
teststr = %subst(archive:wwpos+9:%len(%trim(archive))-(wwpos+8));
archive = %trim(localdir) + %subst(archive:wwpos+9:
%len(%trim(archive))-(wwpos+8));
else;
archive = %subst(archive:1:wwpos - 1) +
%trim(localdir) + %subst(archive:wwpos+9:
%len(%trim(archive))-(wwpos+8));
ENDIF;
ENDIF;
wwpos = %scan('%DATE%' : archive);
if wwpos > 0;
if wwpos = 1;
archive = %char(%date()) + %subst(archive:wwpos+6:
%len(%trim(archive))-(wwpos+6));
else;
teststr = %subst(archive:1:wwpos - 1);
teststr = %char(%date());
teststr = %subst(archive:wwpos+6:
%len(%trim(archive))-(wwpos+5));
archive = %subst(archive:1:wwpos - 1) +
%char(%date()) + %subst(archive:wwpos+6:
%len(%trim(archive))-(wwpos+5));
ENDIF;
ENDIF;
wwpos = %scan('/' : archive);
dow wwpos > 0;
if wwpos = 1;
wwpos = %scan('/' : archive : wwpos + 1);
iter;
endif;
wcmd = 'crtdir dir(''' + %subst(archive:1:wwpos-1) +
''')';
wCmdLen = %len(wcmd);
monitor;
QCMD(wCmd:wCmdLen);
on-error;
ENDMON;
wwpos = %scan('/' : archive : wwpos + 1);
ENDDO;
//have to do it one more time to cover last directory
wcmd = 'crtdir dir(''' + %trim(archive) +
''')';
wCmdLen = %len(wcmd);
monitor;
QCMD(wCmd:wCmdLen);
on-error;
ENDMON;
ENDIF;
if logfile <> *blanks;
wwpos = %scan('%DATE%' : logfile);
if wwpos > 0;
if wwpos = 1;
logfile = %char(%date()) + %subst(logfile:wwpos+6:
%len(%trim(logfile))-(wwpos+6));
else;
logfile = %subst(logfile:1:wwpos - 1) +
%char(%date()) + %subst(logfile:wwpos+6:
%len(%trim(logfile))-(wwpos+5));
ENDIF;
ENDIF;
ENDIF;
// Strip off trailing '/'
wwpos = %scan(' ' : localdir);
localdir = %subst(localdir:1:wwpos-1);
wwpos = %scan(' ' : remotedir);
remotedir = %subst(remotedir:1:wwpos-1);
wwpos = %scan(' ' : filename);
filename = %subst(filename:1:wwpos-1);
wwLen = %len(%trimr(localdir));
if wwLen>1 and %subst(localdir:wwLen:1) = '/';
localdir = %subst(localdir:1:wwLen-1);
endif;
wwpos = %scan('/' : logfile);
if wwpos = 0;
logdirfile = %trim(localdir)+ '/' + %trim(logfile) + '.txt';
else;
wwpos = %scan('.' : logfile);
if wwpos = 0;
logdirfile = %trim(logfile) + '.txt';
else;
logdirfile = %trim(logfile);
endif;
endif;
// Open log file for FTP messages.
// 511: 37);
if writelog = 'Y';
if clearlog = 'Y';
log = open(%trim(logdirfile):
O_WRONLY+O_CREAT+O_TRUNC+O_CODEPAGE:
511: 819);
closef(log);
else;
if access(%trimr(logdirfile): F_OK) < 0;
err = errno;
if err = 3025;
log = open(%trim(logdirfile):
O_WRONLY+O_CREAT+O_TRUNC+O_CODEPAGE:
511: 819);
closef(log);
endif;
endif;
if access(%trimr(logdirfile): R_OK) < 0;
err = errno;
CompMsg('Access to logfile error- See joblog');
returncode = -1;
endif;
endif;
log = open(%trim(logdirfile):
O_WRONLY+O_APPEND+O_TEXTDATA);
endif;
// Write a date time record into the log file.
if writelog = 'Y';
logger('FTP started on - date: ' + %char(%date()) + ' time: '
+ %char(%time()) : log );
logger(' Parms: ' : log );
logger(' Server - ' + %trim(ftpserver) : log );
logger(' Username - ' + %trim(username) : log );
logger(' Remote directory - ' + %trim(remotedir) : log );
logger(' Local directory - ' + %trim(localdir) : log );
logger(' Action - ' + %trim(action) : log );
logger(' (A)rchive - ' : log );
logger(' (D)elete - ' : log );
logger(' (N)othing - ' : log );
logger(' Complete directory - ' + %trim(completedir) : log );
logger(' Include sub directories - ' + %trim(subdirs) : log );
logger(' Write a log file - ' + %trim(writelog) : log );
logger(' Clear logfile - ' + %trim(clearlog) : log );
logger(' File name - ' + %trim(filename) : log );
logger(' Log file - ' + %trim(logdirfile) : log );
logger(' Archive folder - ' + %trim(archive) : log );
else;
CompMsg('FTP started on - date: ' + %char(%date()) + ' time: '
+ %char(%time()));
CompMsg(' Parms: ');
CompMsg(' Server - ' + %trim(ftpserver));
CompMsg(' Username - ' + %trim(username));
CompMsg(' Remote directory - ' + %trim(remotedir));
CompMsg(' Local directory - ' + %trim(localdir));
CompMsg(' Action - ' + %trim(action));
CompMsg(' (A)rchive - ');
CompMsg(' (D)elete - ');
CompMsg(' (N)othing - ');
CompMsg(' Complete directory - ' + %trim(completedir));
CompMsg(' Include sub directories - ' + %trim(subdirs));
CompMsg(' Write a log file - ' + %trim(writelog));
CompMsg(' Clear logfile - ' + %trim(clearlog));
CompMsg(' File name - ' + %trim(filename));
CompMsg(' Log file - ' + %trim(logdirfile));
CompMsg(' Archive folder - ' + %trim(archive));
endif;
// Connect to an FTP server.
ftp = ftp_open(%trim(FTPSERVER): myPort: myTimeout);
if ftp < 0;
if writelog = 'Y';
logger(FTP_errorMsg(0:wwReply):log);
returncode = wwReply;
returnmsg = FTP_errorMsg(0);
*inlr = *on;
return;
else;
CompMsg(FTP_errorMsg(0:wwReply));
returncode = wwReply;
returnmsg = FTP_errorMsg(0);
*inlr = *on;
return;
endif;
endif;
if writelog = 'Y';
ftp_exitProc(ftp: FTP_EXTLOG:
%paddr('LOGGER'): %addr(log));
endif;
returncode = ftp_login(ftp: %trim(USERNAME): %trim(PASSWORD): myAcct);
if returncode < 0;
if writelog = 'Y';
logger(FTP_errorMsg(ftp:wwReply):log);
returncode = wwReply;
returnmsg = FTP_errorMsg(0);
*inlr = *on;
return;
else;
CompMsg(FTP_errorMsg(ftp:wwReply));
returncode = wwReply;
returnmsg = FTP_errorMsg(ftp);
*inlr = *on;
return;
endif;
endif;
// Change to the Remote directory on
// the FTP server. Deal with any errors.
returncode = ftp_chdir(ftp: %trim(REMOTEDIR));
if returncode < 0;
if writelog = 'Y';
logger(FTP_errorMsg(ftp:wwReply):log);
returncode = wwReply;
returnmsg = FTP_errorMsg(0);
ftp_quit(ftp);
*inlr = *on;
return;
else;
CompMsg(ftp_errorMsg(ftp:wwReply));
returncode=wwReply;
returnmsg = FTP_errorMsg(ftp);
ftp_quit(ftp);
*inlr = *on;
return;
endif;
endif;
// Set binary mode for file transfers
ftp_binaryMode(ftp: *on);
// Set passive mode for file transfers
//ftp_passiveMode(ftp: *on);
// Set logging mode for file transfers
// ftp_logging(ftp: *on);
if completedir = 'N' and filename <> *blanks;
exsr putfile;
// The transfer was successful...
if writelog = 'Y';
logger('Success!' : log );
logger(' Return Code - ' + %trim(%char(returncode)) : log );
logger(' Return Message - ' + %trim(returnmsg) : log );
logger('FTP ended on - date: ' + %char(%date()) + ' time: '
+ %char(%time()) : log );
else;
CompMsg(' Return Code - ' + %trim(%char(returncode)));
CompMsg(' Return Message - ' + %trim(returnmsg));
CompMsg('FTP ended on - date: ' + %char(%date()) + ' time: '
+ %char(%time()));
endif;
closef(log);
ftp_quit(ftp);
CompMsg('Success!');
returncode = 0;
returnmsg = 'Success!';
*inlr = *on;
ENDIF;
if completedir = 'Y' and subdirs = 'N';
exsr putdir;
// The transfer was successful...
if writelog = 'Y';
if putfiles > 0;
logger('Success!' : log );
logger(' Return Code - ' + %trim(%char(returncode)) : log );
logger(' Return Message - ' + %trim(returnmsg) : log );
else;
logger(' Return Code - ' + %trim(%char(returncode)) : log );
logger(' Return Message - ' + %trim(returnmsg) : log );
logger('No files received!' : log );
endif;
logger(' Return Code - ' + %trim(%char(returncode)) : log );
logger(' Return Message - ' + %trim(returnmsg) : log );
logger('FTP ended on - date: ' + %char(%date()) + ' time: '
+ %char(%time()) : log );
else;
CompMsg(' Return Code - ' + %trim(%char(returncode)));
CompMsg(' Return Message - ' + %trim(returnmsg));
CompMsg('FTP ended on - date: ' + %char(%date()) + ' time: '
+ %char(%time()));
endif;
closef(log);
ftp_quit(ftp);
if putfiles > 0;
CompMsg('Success!');
returnmsg = 'Success!';
returncode = 0;
else;
CompMsg('No files received!');
returnmsg = 'No files received!';
returncode = 100;
endif;
*inlr = *on;
ENDIF;
if completedir = 'Y' and subdirs = 'Y';
do_dir(*blanks:%trim(archive));
if writelog = 'Y';
if putfiles > 0;
logger('Success!' : log );
logger(' Return Code - ' + %trim(%char(returncode)) : log );
logger(' Return Message - ' + %trim(returnmsg) : log );
else;
logger(' Return Code - ' + %trim(%char(returncode)) : log );
logger(' Return Message - ' + %trim(returnmsg) : log );
logger('No files received!' : log );
endif;
logger(' Return Code - ' + %trim(%char(returncode)) : log );
logger(' Return Message - ' + %trim(returnmsg) : log );
logger('FTP ended on - date: ' + %char(%date()) + ' time: '
+ %char(%time()) : log );
else;
CompMsg(' Return Code - ' + %trim(%char(returncode)));
CompMsg(' Return Message - ' + %trim(returnmsg));
CompMsg('FTP ended on - date: ' + %char(%date()) + ' time: '
+ %char(%time()));
endif;
closef(log);
ftp_quit(ftp);
if putfiles > 0;
CompMsg('Success!');
returnmsg = 'Success!';
returncode = 0;
else;
CompMsg('No files received!');
returnmsg = 'No files received!';
returncode = 100;
endif;
ENDIF;
IPRETURNCODE = RETURNCODE;
IPRETURNMSG = RETURNMSG;
*inlr = *on;
//********************************************************************
//* Put a single file to remote directory *
//********************************************************************
begsr putfile;
// Get the filename
// save it to the local directory.
localfile = %trim(localdir) + '/' + %trim(filename);
logger(' ' :log);
logger('File started : ' + %char(%timestamp()):log);
returncode = ftp_put(ftp: %trim(filename): %trim(localfile));
if returncode < 0;
if writelog = 'Y';
logger(ftp_errorMsg(ftp:wwReply):log);
returncode = wwReply;
returnmsg = FTP_errorMsg(0);
ftp_quit(ftp);
*inlr = *on;
return;
else;
CompMsg(ftp_errorMsg(ftp:wwReply));
returncode=wwReply;
returnmsg = FTP_errorMsg(ftp);
ftp_quit(ftp);
*inlr = *on;
return;
endif;
else;
logger('File ended : ' + %char(%timestamp()):log);
endif;
if action <> 'N';
if action = 'D';
wcmd = 'rmvlnk objlnk(''' + %trim(localfile) +
''')';
wCmdLen = %len(wcmd);
monitor;
QCMD(wCmd:wCmdLen);
on-error;
ENDMON;
ENDIF;
if action = 'A';
wcmd = 'mov obj(''' + %trim(localfile) +
''') todir(''' + %trim(archive) + ''')';
wCmdLen = %len(wcmd);
monitor;
QCMD(wCmd:wCmdLen);
on-error;
ENDMON;
ENDIF;
ENDIF;
ENDSR;
//********************************************************************
//* Put the complete local directory to remote directory *
//********************************************************************
begsr putdir;
// Get the entire directory, use filename as mask
// save it to the local directory.
dh = opendir(%trimr(LocalDir));
if dh = *NULL;
diagmsg('opendir(): ' +
%str(strerror(errno)));
returncode = -1;
endif;
ftp_mkdir(ftp: %trimr(RemoteDir));
if ftp_chdir(ftp: %trimr(RemoteDir)) < 0;
closedir(dh);
DiagMsg(FTP_errorMsg(ftp));
returncode = -1;
endif;
dow returncode >= 0;
//Read next directory entry
p_dirent = readdir(dh);
if p_dirent = *NULL;
leave;
endif;
// Skip special files "." and ".."
localfile = *blanks;
localfile = %subst(d_name: 1: d_namelen);
if localfile = '.' or localfile = '..';
iter;
endif;
// Get stat structure for local file
localfile = %trim(localdir) + '/' + %trim(d_name);
if stat(%trimr(localfile): %addr(mystat))<0;
diagmsg('stat(): ' + %trim(d_name) +
': ' + %str(strerror(errno)));
endif;
// If local file is a directory skip it
p_statds64 = %addr(mystat);
if S_ISDIR(st_mode);
iter;
endif;
// upload the rest of the files
putfiles = 0;
if filename = *blanks;
logger(' ' :log);
logger('File started : ' + %char(%timestamp()):log);
returncode = ftp_put(ftp: %subst(d_name: 1: d_namelen):
%trim(localfile));
if returncode < 0;
if writelog = 'Y';
logger(ftp_errorMsg(ftp:wwReply):log);
returncode = wwReply;
returnmsg = FTP_errorMsg(0);
else;
CompMsg(ftp_errorMsg(ftp:wwReply));
returncode=wwReply;
returnmsg = FTP_errorMsg(ftp);
endif;
else;
logger('File ended : ' + %char(%timestamp()):log);
putfiles = putfiles + 1;
if action <> 'N';
wwpos = %scan(X'00' : localfile);
localfile2 = %subst(localfile:1:wwpos-1);
if action = 'D';
wcmd = 'rmvlnk objlnk(''' + %trim(localfile2) +
''')';
wCmdLen = %len(wcmd);
QCMD(wCmd:wCmdLen);
ENDIF;
if action = 'A';
wcmd = 'mov obj(''' + %trim(localfile2) +
''') todir(''' + %trim(archive) + ''')';
wCmdLen = %len(wcmd);
monitor;
QCMD(wCmd:wCmdLen);
on-error;
ENDMON;
ENDIF;
ENDIF;
endif;
endif;
if filename <> *blanks;
wwPos = %scan(%trim(filename) : d_name);
if wwPos > 0;
logger(' ' :log);
logger('File started : ' + %char(%timestamp()):log);
returncode = ftp_put(ftp: %subst(d_name: 1: d_namelen):
%trim(localfile));
if returncode < 0;
if writelog = 'Y';
logger(ftp_errorMsg(ftp:wwReply):log);
returncode = wwReply;
returnmsg = FTP_errorMsg(0);
else;
CompMsg(ftp_errorMsg(ftp:wwReply));
returncode=wwReply;
returnmsg = FTP_errorMsg(ftp);
endif;
else;
logger('File ended : ' + %char(%timestamp()):log);
putfiles = putfiles + 1;
if action <> 'N';
wwpos = %scan(X'00' : localfile);
localfile2 = %subst(localfile:1:wwpos-1);
if action = 'D';
wcmd = 'rmvlnk objlnk(''' + %trim(localfile2) +
''')';
wCmdLen = %len(wcmd);
QCMD(wCmd:wCmdLen);
ENDIF;
if action = 'A';
wcmd = 'mov obj(''' + %trim(localfile2) +
''') todir(''' + %trim(archive) + ''')';
wCmdLen = %len(wcmd);
monitor;
QCMD(wCmd:wCmdLen);
on-error;
ENDMON;
ENDIF;
ENDIF;
endif;
endif;
endif;
clear dirent;
enddo;
closedir(dh);
if returncode < 0;
ftp_quit(ftp);
*inlr = *on;
return;
endif;
ENDSR;
/END-FREE
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// This procedure calls itself recursively for each subdirectory
// in a directory.
//
// For each non-subdir in the directory, it calls FTP_PUT
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P do_dir B
D do_dir PI 10I 0
D peDir 640A const
D peArchive 640A const
D dh S *
D wwDirname S 640A
D wwArchive S 640A
D wwFile S 640A
D wwLen S 10I 0
D FtpDir S 640A
D LocalDirp S 640A
D LocalFile S 640A
D wdPos S 10I 0
D mystat s like(statds64)
// Strip off trailing '/'
/FREE
wwLen = %len(%trimr(peDir));
if wwLen>1 and %subst(peDir:wwLen:1) = '/';
wwDirname = %subst(peDir:1:wwLen-1);
else;
wwDirname = peDir;
endif;
wwLen = %len(%trimr(peArchive));
if wwLen>1 and %subst(peArchive:wwLen:1) = '/';
wwArchive = %subst(peArchive:1:wwLen-1);
else;
wwArchive = peArchive;
endif;
wcmd = 'crtdir dir(''' + %subst(peArchive:1:wwLen) +
''')';
wCmdLen = %len(wcmd);
monitor;
QCMD(wCmd:wCmdLen);
on-error;
ENDMON;
// Add prefixes for local & remote directory names
LocalDirp= %trim(localdir)
+ %trimr(wwDirName);
FtpDir = %trim(remotedir) + %trimr(wwDirName);
// Open local directory
dh = opendir(%trimr(LocalDirp));
if dh = *NULL;
diagmsg('opendir(): ' +
%str(strerror(errno)));
return -1;
endif;
// Create/switch to same dir on FTP server
ftp_mkdir(ftp: %trim(FtpDir));
if ftp_chdir(ftp: %trim(FtpDir)) < 0;
closedir(dh);
DiagMsg(FTP_errorMsg(ftp));
return -1;
endif;
dow 1 = 1;
// Read next directory entry
p_dirent = readdir(dh);
if p_dirent = *NULL;
leave;
endif;
// Skip special files "." and ".."
wwFile = %subst(d_name: 1: d_namelen);
if wwFile = '.' or wwFile = '..';
iter;
endif;
// Get stat structure for local file
LocalFile = %trim(localdir) +
%trimr(wwDirName) + '/' + wwFile;
if stat(%trimr(LocalFile): %addr(mystat))<0;
diagmsg('stat(): ' + %trim(wwFile) +
': ' + %str(strerror(errno)));
endif;
// If local file is a directory, call this procedure again,
// with the new directory name.
p_statds64 = %addr(mystat);
if S_ISDIR(st_mode);
//Do not call it if it is an archive directory.
wdpos = %scan(%trim(wwFile) : wwArchive);
if wdpos = 0;
if do_dir(%trimr(wwDirName) + '/' +
wwFile:%trimr(wwArchive) + '/' + wwFile) < 0;
return -1;
endif;
else;
iter;
endif;
ftp_chdir(ftp: FtpDir);
// Otherwise, assume it's a file, and transfer it.
else;
if filename = *blanks;
logger(' ' :log);
logger('File started : ' + %char(%timestamp()):log);
returncode = ftp_put(ftp: %trim(wwFile): %trim(LocalFile));
if returncode < 0;
if writelog = 'Y';
logger(ftp_errorMsg(ftp:wwReply):log);
returncode = wwReply;
returnmsg = FTP_errorMsg(0);
else;
CompMsg(ftp_errorMsg(ftp:wwReply));
returncode=wwReply;
returnmsg = FTP_errorMsg(ftp);
endif;
else;
logger('File ended : ' + %char(%timestamp()):log);
putfiles = putfiles + 1;
if action <> 'N';
wwpos = %scan(X'00' : localfile);
if wwpos = 0;
wwpos = %scan(' ' : localfile);
ENDIF;
localfile2 = %subst(localfile:1:wwpos-1);
if action = 'D';
wcmd = 'rmvlnk objlnk(''' + %trim(localfile2) +
''')';
wCmdLen = %len(wcmd);
QCMD(wCmd:wCmdLen);
ENDIF;
if action = 'A';
wcmd = 'mov obj(''' + %trim(localfile2) +
''') todir(''' + %trim(wwArchive) + ''')';
wCmdLen = %len(wcmd);
monitor;
QCMD(wCmd:wCmdLen);
on-error;
ENDMON;
ENDIF;
ENDIF;
endif;
endif;
if filename <> *blanks;
wwPos = %scan(%trim(filename) : wwFile);
if wwPos > 0;
logger(' ' :log);
logger('File started : ' + %char(%timestamp()):log);
returncode = ftp_put(ftp: %trim(wwFile): %trim(LocalFile));
if returncode < 0;
if writelog = 'Y';
logger(ftp_errorMsg(ftp:wwReply):log);
returncode = wwReply;
returnmsg = FTP_errorMsg(0);
else;
CompMsg(ftp_errorMsg(ftp:wwReply));
returncode=wwReply;
returnmsg = FTP_errorMsg(ftp);
endif;
else;
logger('File ended : ' + %char(%timestamp()):log);
putfiles = putfiles + 1;
if action <> 'N';
wwpos = %scan(X'00' : localfile);
if wwpos = 0;
wwpos = %scan(' ' : localfile);
ENDIF;
localfile2 = %subst(localfile:1:wwpos-1);
if action = 'D';
wcmd = 'rmvlnk objlnk(''' + %trim(localfile2) +
''')';
wCmdLen = %len(wcmd);
QCMD(wCmd:wCmdLen);
ENDIF;
if action = 'A';
wcmd = 'mov obj(''' + %trim(localfile2) +
''') todir(''' + %trim(wwArchive) + ''')';
wCmdLen = %len(wcmd);
monitor;
QCMD(wCmd:wCmdLen);
on-error;
ENDMON;
ENDIF;
ENDIF;
endif;
endif;
endif;
endif;
enddo;
closedir(dh);
return 0;
/END-FREE
P E
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// This writes the details of each session to a log file
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P Logger B
D Logger PI
D peMsgTxt 256A Const
D peLogFile 10I 0
D size s 10I 0
D text s 258A
D msg s 50A
/FREE
if peLogfile <> log;
msg = 'Logger(): peLogFile is in error';
dsply '' ' ' msg;
endif;
size = %len(%trimr(peMsgTxt));
text = %subst(peMsgTxt:1:size) + x'0d25';
callp write(peLogFile: %addr(text): size+2);
/END-FREE
P E
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// This sends a completion message to the calling program
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P CompMsg B
D CompMsg PI
D peMsgTxt 256A Const
D dsEC DS
// Bytes Provided (size of struct)
D dsECBytesP 1 4B 0 INZ(256)
// Bytes Available (returned by API)
D dsECBytesA 5 8B 0 INZ(0)
// Msg ID of Error Msg Returned
D dsECMsgID 9 15
// Reserved
D dsECReserv 16 16
// Msg Data of Error Msg Returned
D dsECMsgDta 17 256
D SndPgmMsg PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 256A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 1A
D wwMsgLen S 10I 0
D wwTheKey S 4A
c ' ' checkr peMsgTxt wwMsgLen
/FREE
SndPgmMsg('CPF9897': 'QCPFMSG *LIBL':
peMsgTxt: wwMsgLen: '*COMP':'*PGMBDY':
1: wwTheKey: dsEC);
/END-FREE
P E
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// This puts a diagnostic message into the job log
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P DiagMsg B
D DiagMsg PI
D peMsgTxt 256A Const
D dsEC DS
// Bytes Provided (size of struct)
D dsECBytesP 1 4B 0 INZ(256)
// Bytes Available (returned by API)
D dsECBytesA 5 8B 0 INZ(0)
// Msg ID of Error Msg Returned
D dsECMsgID 9 15
// Reserved
D dsECReserv 16 16
// Msg Data of Error Msg Returned
D dsECMsgDta 17 256
D SndTheMsg PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 256A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 1A
D wwMsgLen S 10I 0
D wwTheKey S 4A
/FREE
wwMsgLen = %len(%trimr(peMsgTxt));
SndTheMsg('CPF9897': 'QCPFMSG *LIBL':
peMsgTxt: wwMsgLen: '*DIAG':
'*': 0: wwTheKey: dsEC);
/END-FREE
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This tests a file mode to see if a file is a directory.
*
* Here is the C code we're trying to duplicate:
* #define _S_IFDIR 0040000 */
* #define S_ISDIR(mode) (((mode) & 0370000) == _S_IFDIR)
*
* 1) ((mode) & 0370000) takes the file's mode and performs a
* bitwise AND with the octal constant 0370000. In binary,
* that constant looks like: 00000000000000011111000000000000
* The effect of this code is to turn off all bits in the
* mode, except those marked with a '1' in the binary bitmask.
*
* 2) ((result of #1) == _S_IFDIR) What this does is compare
* the result of step 1, above with the _S_IFDIR, which
* is defined to be the octal constant 0040000. In decimal,
* that octal constant is 16384.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P S_ISDIR B
D S_ISDIR PI 1N
D mode 10U 0 value
D DS
D dirmode 1 4U 0
D byte1 1 1A
D byte2 2 2A
D byte3 3 3A
D byte4 4 4A
* Turn off bits in the mode, as in step (1) above.
c eval dirmode = mode
c bitoff x'FF' byte1
c bitoff x'FE' byte2
c bitoff x'0F' byte3
c bitoff x'FF' byte4
* Compare the result to 0040000, and return true or false.
B01 c if dirmode = 16384
c return *On
X01 c else
c return *Off
E01 c endif
P E
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// Get the UNIX/C error number
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P errno B
D errno PI 10I 0
D p_errno S *
D wwreturn S 10I 0 based(p_errno)
/FREE
p_errno = c__errno;
return wwreturn;
/END-FREE
P E
-----------------------------------------------------------------------
This is the FTPAPI mailing list. To unsubscribe, please go to:
http://www.scottklement.com/mailman/listinfo/ftpapi
-----------------------------------------------------------------------