[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Problem with FTP_GET, FTP_BINARY when downloading mixed file types
Hi
I have attached the source code to this mail, and it is a working
version. I have tested it again with my test files and the problem is
the same.
Thanks
Pieter
The information contained in this email is confidential and may
contain proprietary information. It is meant solely for the intended
recipient. Access to this email by anyone else is unauthorised. If you
are not the intended recipient, any disclosure, copying, distribution
or any action taken or omitted in reliance on this, is prohibited and
may be unlawful. No liability or responsibility is accepted if
information or data is, for whatever reason corrupted or does not
reach its intended recipient. No warranty is given that this email is
free of viruses. The views expressed in this email are, unless
otherwise stated, those of the author and not those of HYPHEN
Technology (Pty) Ltd or its management. HYPHEN Technology (Pty) Ltd
reserves the right to monitor, intercept and block emails addressed to
its users or take any other action in accordance with its email use
policy.
? *?Program Name:?FTPTEST#R
? *?Author :?Pieter Henrico
? *?Date :?09/11/30
H DftActGrp(*No)
H BndDir('QC2LE')
H CopyNest(128)
H DatFmt(*ISO) DatEdit(*YMD) TimFmt(*ISO)
H BndDir('QC2LE')
H BNDDIR('FTPAPI') ACTGRP(*NEW)
D/COPY #FTPAPI_H
? *======================== *ENTRY ================================
? * Setup *Entry PList Information
D FTPTEST#R PR EXTPGM('FTPTEST#R')
? *
D FTPTEST#R PI
? *======================== INTCFGPF Entries ======================
D TNulPtr S *
D TString S 256 Based(TNulPtr)
D TInt S 10I 0 Based(TNulPtr)
D TName S 10 Based(TNulPtr)
D TLongName S 20 Based(TNulPtr)
D TBool S 1 Based(TNulPtr)
D TCommand S 3000 Based(TNulPtr)
D TAPIFormat S 8 Based(TNulPtr)
D TText S 50 Based(TNulPtr)
D TChar S 1 Based(TNulPtr)
D TMessageID S 7 Based(TNulPtr)
D TPointer S * Based(TNulPtr)
? *======================== INTCFGPF Entries ======================
D pWorkLib S like(TString)
D pDelay S like(TInt)
D pDescr S like(TString)
D pFileSelect S like(TString)
D pRmtServer S like(TString)
D pRmtUserid S like(TLongName)
D pRmtPasswd S like(TLongName)
D pRmtPath S like(TString)
D pFTPLogging S like(TString)
D pPostProcess S like(TString)
D pSbmCommand S like(TString)
D pJobQueue S like(TString)
D pUserName S like(TString)
D pIntValue S like(TString)
D pKey1 C 'FTPMULTIGETDELETE'
D pKey3 S like(TLongName)
D ObjExists Pr Like(TBool)
D ObjNam Like(TName) Value
D ObjLib Like(TName) Value
D ObjTyp Like(TName) Value
D GetObjDsc Pr Like(TBool)
D ObjNam Like(TName) Value
D ObjLib Like(TName) Value
D ObjTyp Like(TName) Value
D DscFmt Like(TApiFormat) Value
D ObjDsc Like(TObjDscDs)
DTObjDscDs Ds Inz
* BrfObjDscFmt
D ObjDscLen Like(TInt)
D ObjDscSiz Like(TInt)
D ObjNam Like(TName)
D ObjLib Like(TName)
D ObjTyp Like(TName)
D ObjRtnLib Like(TName)
D ObjAsp Like(TInt)
D ObjOwnr Like(TName)
D ObjDmn 2
D ObjCrtDtm 13
D ObjChgDtm 13
D ObjAtr Like(TName)
D ObjTxt Like(TText)
D ObjSrcFil Like(TName)
D ObjSrcLib Like(TName)
D ObjSrcMbr Like(TName)
* DtlObjDscFmt
D ObjSrcChgDtm 13
D ObjSavDtm 13
D ObjRstDtm 13
D ObjCrtUsr Like(TName)
D ObjCrtSys 8
D ObjResDat 7
D ObjSavSiz Like(TInt)
D ObjSavSeq Like(TInt)
D ObjStg Like(TName)
D ObjSavCmd Like(TName)
D ObjSavVolId 71
D ObjSavDvc Like(TName)
D ObjSavFil Like(TName)
D ObjSavLib Like(TName)
D ObjSavLbl 17
D ObjSavLvl 9
D ObjCompiler 16
D ObjLvl 8
D ObjUsrChg Like(TChar)
D ObjLicPgm 16
D ObjPtf Like(TName)
D ObjApar Like(TName)
D ObjUseDat 7
D ObjUsgInf Like(TChar)
D ObjUseDay Like(TInt)
D ObjSiz Like(TInt)
D ObjSizMlt Like(TInt)
D ObjCprSts Like(TChar)
D ObjAlwChg Like(TChar)
D ObjChgByPgm Like(TChar)
D ObjUsrAtr Like(TName)
D ObjOvrflwAsp Like(TChar)
D ObjSavActDtm 13
D ObjAudVal Like(TName)
D ObjPrmGrp Like(TName)
D BrfObjDscFmt C 'OBJD0200'
D DSAPIError Ds Inz
D APIErrSiz Like(TInt) Inz(%Size(DSAPIError))
D APIErrLen Like(TInt)
D APIErrId Like(TMessageID)
D 1
D APIErrText 256
D APIErrDftLen C 7
D APIErrDftId C 'CPF9898'
? *======================== Other Entries ======================
D pErrMsg S 256A inz(*Blanks)
D pFTPErrors S like(TBool)
D pCopyFailed S like(TBool)
D pCopyErrors S like(TBool)
D pNoFiles S like(TBool) PAH003
D pLoopOnce S like(TBool)
D pTempfile S like(TString)
D pWorkfile S like(TString)
D pFileName S like(TName)
D pLibName S like(TName)
D pDotPos S like(TInt)
D pSpacePos S like(TInt)
D pStrPos S like(TInt)
D pStrLen S like(TInt)
D pFileLength S like(TInt)
D pErrCount S like(TInt)
D pErrReporting S like(TName)
D pErrList S like(TCommand)
D pExtQueue S like(TString)
D pTempEnv S like(TName)
D pSpaces C const(' ')
D pUnderScore C const('_')
D pFd S like(TInt)
D pLogFile S like(TString)
D pLogTemp S like(TString)
D pFTPRptMail S 50a inz(*Blanks)
D pLogAll S n
D pModTime1 S Z PAH005
D pModTime2 S Z PAH005
D pTotTime S like(TInt) PAH005
D pCounter S like(TInt)
D pFileBusy S like(TBool)
D pIsZipped S like(TBool) PAH006
D pTempLib S like(TString)
D pTimeOut S like(TInt) inz(360)
D pNoTimeCheck S like(TBool) inz('0') PAH007
D pCommsFailed S like(TBool) inz('0') PAH007
D pTmpDir S like(TName)
D pTmpPath S like(TString) inz('/tmp/zip')
D pDelayTime S like(TName) inz('1')
? *
D pExtEmails DS
D Email1 50a
D Email2 50a
D Email3 50a
D pEmailString S like(TString)
? *======================== FTPAPI Entries ======================
D CompMsg PR
D peMsgTxt 256A value
* These two variables work together!!!!
D pMaxFiles S like(TInt) inz(200)
D Incoming S 256A DIM(200)
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 gotfiles S 10I 0
D FixFileName PR like(TName)
D pFileName like(TString) value
* system(Cmd)
D system Pr Like(TInt) ExtProc('system')
D pCmd Like(TPointer) Value Options(*String)
? *================================================================
? *?Main Program start here
? *
C BeginPgm Tag
? *================================================================
? *?Retrieve the configuration entries now
? *================================================================
C Eval pDescr = 'PTEST'
C Eval pDelay = 0
C Eval pWorkLib = 'TESTFTP'
C Eval pTempLib = pWorkLib
C Eval pFileSelect= 'file*.*'
C Eval pRmtServer= 'servername'
C Eval pRmtUserid= 'userid'
C Eval pRmtPasswd= 'password'
C Eval pRmtPath = '/'
C Eval pFTPLogging = '*ON'
C Eval pPostProcess = '*NONE'
C Eval pJobQueue = 'QBATCH'
C Eval pUserName = 'QSYSOPR'
C Eval pFtpRptMail = '*NONE'
C Eval pErrReporting= '*BOTH'
C Eval pExtQueue = 'QSYSOPR'
C Eval pExtEmails = '*NONE'
? *================================================================
? *?Check if everything should be logged, or only errors
? *================================================================
IF04C If pFtpRptMail = '*NONE'
C Eval pLogAll = *Off
IF04C Else
C Eval pLogAll = *On
IF04C EndIf
? *================================================================
? *?This tells FTPAPIR4 to log the FTP session to the joblog
? *?so we can debug any problems that occur:
? *================================================================
IF05C If pFTPLogging = '*ON'
C Callp Ftp_Logging(0: *On)
IF05C EndIf
? *================================================================
? *?Check now if the Machine Status Data Area is set, or if the subsystem is
? *?shutting down. If it is, exit the application, if not, loop.
? *================================================================
? *================================================================
? *?Reset some variables first
? *================================================================
C Eval pCopyFailed = *Off
C Eval pCopyErrors = *Off
C Eval pFtpErrors = *Off
C Eval pErrCount = 0
? *================================================================
? *?Here the FTP Process will take place. If FTPErrors is ON, ignore the remainder
? *?of the steps.
? *================================================================
? *================================================================
? *?Connect to FTP server. Log in with user name & password:
? *?
? *?Here we also specify that we want to use the default
? *?port for FTP, as well as a time-out value of 360 seconds.
? *?
? *?If we don't receive data for 360 seconds, the connection
? *?will "time-out"
? *================================================================
C Eval Fd = Ftp_Conn(pRmtServer:
C pRmtUserid:
C pRmtPasswd:
C FTP_PORT:
C pTimeOut) PAH006
IF07C If fd < 0
C Eval pFTPErrors = *On
* Send error message here
IF07C EndIf
? *================================================================
? *?Change to passive mode
? *================================================================
IF08C If ftp_passivemode(fd: *On) < 0
C and pFTPErrors = *Off
C callp ftp_quit(fd)
C Eval pFTPErrors = *On
* Send error message here
IF08C EndIf
? *================================================================
? *?Change to the correct path on the remote server
? *================================================================
IF10C If ftp_chdir(fd: pRmtPath) < 0
C and pFTPErrors = *Off
C callp ftp_quit(fd)
C Eval pFTPErrors = *On
* Send error message here
IF10C EndIf
? *================================================================
? *?Get a list of up to 200 files in the target directory
? *?(we intend to download all of these files)
? *================================================================
IF11C If pFTPErrors = *Off
C eval pNoFiles = *Off PAH003
C eval rc = ftp_list(fd: pFileSelect: pMaxFiles:
C %addr(incoming): num_files)
IF12C If rc<0
* Send error message here
IF13C If ErrNum = FTP_NOFILE or num_files = 0
* Send error message here
C eval num_files = 0
? *?Had to put this boolean check in to ensure mail does not get sent if there are zero files
C eval pNoFiles = *On PAH003
IF13C else
* Send error message here
IF13C EndIf
IF12C EndIf
? *?Check if the number of files retrieved, are more than the maxfile parms (PAH007)
C If Num_Files > pMaxFiles
* Send error message here
C Eval Num_Files = pMaxFiles
C EndIf
? *?Send the message about how many will actually be processed now. (PAH007)
C Eval pErrMsg = 'FTP ' +
C 'Files to download/process now: ' +
C %char(num_files)
C* callp CompMsg(pErrMsg)
IF11C EndIf
? *================================================================
? *?Download everything into our incoming dir.
? *================================================================
C eval gotfiles = 0
IF13C If pFTPErrors = *Off
DO2C 1 do num_files fileno
C If pCommsFailed = *Off
C Eval pCopyFailed = *Off
C Eval pCounter = 0
? *================================================================
? *?Check here first if the file's modification time changed. If it did, it means the
? *?file is still being uploaded. (PAH005)
? *?If this error occurs, only warn the first time. Ignore this check for other iterations.
? *?(PAH007)
? *================================================================
C Eval pFileBusy = *Off
IFuuC If pNoTimeCheck = *Off PAH007
C eval rc = ftp_mTime(fd:incoming(fileno):
C pModTime1)
* If an error occurs most probably the server does not support mTime.
* If this error occurs once, ignore for the rest of the session.
IF15C If rc < 0
* Send error message here
C Eval pFileBusy = *Off
C Eval pNoTimeCheck = *On PAH007
IF15C else
* Delay for 20 seconds, and check the file again. Compare the times now.
C callp system('DLYJOB DLY('+%trim(pDelaytime)+')')
C eval rc = ftp_mTime(fd:incoming(fileno):
C pModTime2)
* The program HAS to check the return code.
C If rc < 0
* Send error message here
C Eval pFileBusy = *Off
C Eval pNoTimeCheck = *On PAH007
C eval pTotTime = 0
C else
C eval pTotTime = %diff(pModTime2:pModTime1:*S)
C EndIf
* If the total time is longer than 0, the file is busy.
IF16C If pTotTime > 0
C Eval pFileBusy = *On
* Send error message here
C Eval pCopyFailed = *On
C Eval pCopyErrors = *On
C Eval pErrCount = pErrCount + 1
IF16C Else
C Eval pFileBusy = *Off
IF16C EndIf
IF15C EndIf
IFuuC EndIf PAH007
? *================================================================
? *?Check now if this is a text file, or a zipped file. (PAH006)
? *================================================================
IFyyC If %scan('.ZIP':incoming(fileno):1) > 0 or
C %scan('.zip':incoming(fileno):1) > 0
C Eval pIsZipped = *On
IFyyC Else
C Eval pIsZipped = *Off
IFyyC EndIf
? *================================================================
? *?Check if the file does not exist already.
? *================================================================
IF17C If pFileBusy = *Off
C Eval pFileName = FixFileName(incoming(fileno))
? *================================================================
? *?Check now if the file exist in the receiving library. Copy Failed = DO NOT DELETE FILE!
? *================================================================
IF20C If ObjExists(pFileName:
C pTempLib:'*FILE') = *On
* Send error message here
C Eval pCopyFailed = *On
C Eval pCopyErrors = *On
C Eval pErrCount = pErrCount + 1
IF20C EndIf
? *================================================================
? *?If this is a Zipped file, it has to go to the /tmp in IFS and extracted from there.
? *?Otherwise the work file will sit in?/QSYS.LIB/LibName.LIB.
? *================================================================
IFzzC If pIsZipped = *On PAH006
C Eval pWorkFile = %trim(pTmpPath) + '/' + PAH006
C %trim(incoming(fileno)) PAH006
C Else
C Eval pWorkFile = '/QSYS.LIB/' + PAH006
C %trim(pTempLib) + '.LIB/' +
C %trim(pFileName) + '.FILE/'+
C %trim(pFileName) + '.MBR'
IFzzC EndIf PAH006
? *================================================================
? *?Download everything into our incoming dir.
? *================================================================
* download the rest of the files
IF21C If pCopyFailed = *Off
? *================================================================
? *?Set BIN transfer mode to *Off. This step will have to done for each file now. (PAH006)
? *================================================================
IFXXC If pIsZipped = *Off PAH006
IF09C If ftp_binarymode(fd: *Off) < 0 PAH006
C and pFTPErrors = *Off PAH006
C callp ftp_quit(fd) PAH006
C Eval pFTPErrors = *On PAH006
* Send error message here
IF09C EndIf PAH006
IFxxC Else PAH006
IF09C If ftp_binarymode(fd: *On) < 0 PAH006
C and pFTPErrors = *Off PAH006
C callp ftp_quit(fd) PAH006
C Eval pFTPErrors = *On PAH006
* Send error message here
IF09C EndIf PAH006
IFxxC EndIf PAH006
*
IF22C If ftp_get(fd: incoming(fileno):
C %Trim(pWorkFile))>=0
C Eval gotfiles = gotfiles + 1
IF22C Else
* Send error message here
C Eval pCopyFailed = *On
C Eval pCopyErrors = *On
C Eval pErrCount = pErrCount + 1
? *?Here is an additional step. If the ErrNum = 74 (Session Lost), cancel the process
? *?(PAH007)
C If ErrNum = FTP_BADHDL
C Eval pCommsFailed = *On
C EndIf
IF22C Endif
? *================================================================
? *?If this is a Zipped file, extract the file now
? *================================================================
IFvvC If pIsZipped = *On and pCopyFailed = *Off PAH006
C* If UnZipFile(pWorkFile) > 0
C* Eval pCopyFailed = *On
C* Eval pErrCount = pErrCount + 1
* Send error message here
C* Else
*// Remove the Temp file now
C* EndIf
IFvvC EndIf PAH006
IF21C Endif
? *================================================================
? *?Delete the file on the server
? *================================================================
IF23C If pCopyFailed = *Off
IF24C If ftp_delete(fd: incoming(fileno))>=0
IF24C Else
* Send error message here
IF24C Endif
IF23C Endif
? *================================================================
? *?Kick off the Post-Processing Job
? *================================================================
IF25C If pCopyFailed = *Off and pIsZipped = *Off
IF26C If pPostProcess <> '*NONE'
C* Callp SbmPostProcess(pFileName:pTempLib)
IF26C Endif
IF25C Endif
IF17C Endif
* If the comms failed for what-ever reason, get out of the loop!
C Else PAH007
C Leave PAH007
C Endif PAH007
DO2C Enddo
IF13C EndIf
? *================================================================
? *?Close FTP session
? *================================================================
C callp ftp_quit(fd)
? *================================================================
? *?All roads lead to EXIT
? *================================================================
C EndPgm Tag
C eval *inlr = *on
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
? *?Fix the file name to follow a specific naming convention
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
? *
? P FixFileName B
D FixFileName PI like(TName)
D p_FileName Like(TString) value
? *
D pDotPos S like(TInt)
D pSpacePos S like(TInt)
D pStrPos S like(TInt)
D pStrLen S like(TInt)
D pFileLength S like(TInt)
D pTempFile S like(TString)
D pWorkFile S like(TName)
/free
pDotPos = %scan('.':p_FileName:1);
pFileLength = %len(%trim(p_FileName));
pSpacePos = %scan(' ':p_FileName:1);
// First we have to replace spaces with underscores (_)
If pSpacePos < pFileLength;
pTempFile = %xlate(pSpaces:pUnderScore:
%subst(p_FileName:1:pFileLength));
Else;
pTempFile = %subst(p_FileName:1:pFileLength);
EndIf;
// Now Replace dashes in the file name with underscores (_).
pSpacePos = %scan('-':pTempFile:1);
If pSpacePos > 0;
pTempFile = %xlate('-':pUnderScore:
%subst(pTempFile:1:%len(%trim(pTempFile))));
EndIf;
// Now we determine where the dot in the filename is
Select;
// If the dot is before the 11 character
// 12345678901234567890
// Example: ThisIsMyF.txt
When pDotPos > 0 and pDotPos < 11;
pWorkFile = %subst(pTempFile:1:pDotPos - 1);
// If the dot is after the 10th character
// 12345678901234567890
// Example: ThisIsMyFi.txt
When pDotPos > 10;
pWorkFile = %subst(pTempFile:1:10);
// When there is NO dot in place
// 12345678901234567890
// Example: ThisIsMyFiletxt (no dot in place)
When pDotPos = 0 and pFileLength > 10;
pWorkFile = %subst(pTempFile:1:10);
Other;
pWorkFile = %Trim(pTempFile);
EndSl;
Return pWorkFile;
/End-Free
? P E
P ObjExists B Export
D Pi Like(TBool)
D ObjNam Like(TName) Value
D ObjLib Like(TName) Value
D ObjTyp Like(TName) Value
C Return GetObjDsc(ObjNam: ObjLib:
C ObjTyp: BrfObjDscFmt:
C TObjDscDs )
P E
*---------------------------------------------------------
P GetObjDsc B Export
D Pi Like(TBool)
D ObjNam Like(TName) Value
D ObjLib Like(TName) Value
D ObjTyp Like(TName) Value
D DscFmt Like(TApiFormat) Value
D ObjDsc Like(TObjDscDs)
D QObjNam S Like(TLongName)
D BrfObjDscSiz C 90
D DtlObjDscSiz C %Size(TObjDscDs)
C Reset TObjDscDs
C Eval QObjNam = ObjNam + ObjLib
C If DscFmt = BrfObjDscFmt
C Eval ObjDscSiz = BrfObjDscSiz
C Else
C Eval ObjDscSiz = DtlObjDscSiz
C EndIf
C Eval ObjDsc = TObjDscDs
C Call 'QUSROBJD'
C Parm ObjDsc
C Parm ObjDscSiz
C Parm DscFmt
C Parm QObjNam
C Parm ObjTyp
C Parm DSAPIError
C Return (ApiErrLen=0)
P E
-----------------------------------------------------------------------
This is the FTPAPI mailing list. To unsubscribe, please go to:
http://www.scottklement.com/mailman/listinfo/ftpapi
-----------------------------------------------------------------------