You are here:
DBG/400
>
DBG400 Web
>
SourceCodeList
>
ClSource
>
ClDBG187CL
(24 Jun 2005,
MartinRowe
)
(raw view)
E
dit
A
ttach
<verbatim> /* ************************************************************************** */ /* DBG187CL: WRKUSROUTQ Screen option processor */ /* Copyright (C) 2000 Martin Rowe <martin@dbg400.net> */ /* */ /* This program is free software; you can redistribute it and/or modify */ /* it under the terms of the GNU General Public License as published by */ /* the Free Software Foundation; either version 2 of the License, or */ /* (at your option) any later version. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU General Public License for more details. */ /* */ /* You should have received a copy of the GNU General Public License */ /* along with this program; if not, write to the Free Software */ /* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ /* */ /* Some commands (c) Tom Liotta http://zap.to/tl400 Used with permission */ /* ************************************************************************** */ PGM PARM(&FILE &JOB &USER &JOBNBR &SPLNBR + &OPTION &BATCHFILE &STMFDIR &FTPDIR + &REMOTEMACH &REMOTEUSER &REMOTEPASS + &FILEEXT &FORMAT &FILENAME &HTMLTITLE) DCL VAR(&BATCHFILE) TYPE(*CHAR) LEN(50) DCL VAR(&EMPTY) TYPE(*CHAR) LEN(10) VALUE(' ') DCL VAR(&FILE) TYPE(*CHAR) LEN(10) DCL VAR(&FILEEXT) TYPE(*CHAR) LEN(5) DCL VAR(&FILEPATH) TYPE(*CHAR) LEN(63) DCL VAR(&FILENAME) TYPE(*CHAR) LEN(50) DCL VAR(&FULLFILE) TYPE(*CHAR) LEN(55) DCL VAR(&FORMAT) TYPE(*CHAR) LEN(1) DCL VAR(&JOB) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6) DCL VAR(&MBROPT) TYPE(*CHAR) LEN(8) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512) DCL VAR(&OPTION) TYPE(*CHAR) LEN(1) DCL VAR(&PAGELENGTH) TYPE(*DEC) LEN(3 0) DCL VAR(&PCCMD) TYPE(*CHAR) LEN(250) DCL VAR(&PCFILE) TYPE(*CHAR) LEN(50) DCL VAR(&PCFILEEXT) TYPE(*CHAR) LEN(10) DCL VAR(&PCSTMF) TYPE(*CHAR) LEN(150) DCL VAR(&PCSTMFPATH) TYPE(*CHAR) LEN(150) DCL VAR(&RTNDIR) TYPE(*CHAR) LEN(60) DCL VAR(&FTPDIR) TYPE(*CHAR) LEN(60) DCL VAR(&HTMLTITLE) TYPE(*CHAR) LEN(50) DCL VAR(&DIRNAMLEN) TYPE(*DEC) LEN(7 0) DCL VAR(&REMOTEMACH) TYPE(*CHAR) LEN(15) DCL VAR(&REMOTEUSER) TYPE(*CHAR) LEN(10) DCL VAR(&REMOTEPASS) TYPE(*CHAR) LEN(10) DCL VAR(&SPLNBR) TYPE(*CHAR) LEN(4) DCL VAR(&SPLNBRDEC) TYPE(*DEC) LEN(4 0) DCL VAR(&STARTPOS) TYPE(*DEC) LEN(3 0) VALUE(1) DCL VAR(&STMF) TYPE(*CHAR) LEN(150) DCL VAR(&STMFDIR) TYPE(*CHAR) LEN(60) DCL VAR(&STMFDIRWIN) TYPE(*CHAR) LEN(60) DCL VAR(&SYSPATH) TYPE(*CHAR) LEN(20) DCL VAR(&USER) TYPE(*CHAR) LEN(10) /* ************************************************************************** */ /* GLOBAL MESSAGE MONITOR */ /* ************************************************************************** */ MONMSG MSGID(CPF0000 RPG0000 QRG0000 RSF0000 + MCH0000) EXEC(GOTO CMDLBL(##ERROR)) GOTO CMDLBL(##NOERROR) ##ERROR: /* MOVDIAGMSG (c) Tom Liotta http://zap.to/tl400 Used with permission */ MOVDIAGMSG MONMSG MSGID(CPF0000) /* RSNESCMSG (c) Tom Liotta http://zap.to/tl400 Used with permission */ RSNESCMSG MONMSG MSGID(CPF0000) RETURN ##NOERROR: /* ************************************************************************** */ /* START OF MAINLINE CODE */ /* ************************************************************************** */ CHGVAR VAR(&MBROPT) VALUE('*REPLACE') /* Option 1: Send spool file */ IF COND(&OPTION *EQ '1') THEN(DO) ? SNDNETSPLF FILE(&FILE) + JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLNBR) MONMSG MSGID(CPF0000) ENDDO /* Option 2: Change spoolfile attributes */ IF COND(&OPTION *EQ '2') THEN(DO) ? CHGSPLFA FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) + SPLNBR(&SPLNBR) MONMSG MSGID(CPF0000) ENDDO /* Option 3: Hold spoolfile */ IF COND(&OPTION *EQ '3') THEN(DO) HLDSPLF FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) + SPLNBR(&SPLNBR) MONMSG MSGID(CPF0000) ENDDO /* Option 4: Delete spoolfile */ IF COND(&OPTION *EQ '4') THEN(DO) DLTSPLF FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) + SPLNBR(&SPLNBR) MONMSG MSGID(CPF0000) ENDDO /* Option 5: Display spoolfile */ IF COND(&OPTION *EQ '5') THEN(DO) DSPSPLF FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) + SPLNBR(&SPLNBR) MONMSG MSGID(CPF0000) ENDDO /* Option 6: Release spoolfile */ IF COND(&OPTION *EQ '6') THEN(DO) RLSSPLF FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) + SPLNBR(&SPLNBR) MONMSG MSGID(CPF0000) ENDDO /* Option 7: Display messages */ IF COND(&OPTION *EQ '7') THEN(DO) /* ??Not worked out an easy way of doing this yet?? */ ENDDO /* Option 8: Display spoolfile attributes */ IF COND(&OPTION *EQ '8') THEN(DO) WRKSPLFA FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) + SPLNBR(&SPLNBR) MONMSG MSGID(CPF0000) ENDDO /* Option 9: Change spoolfile attributes */ IF COND(&OPTION *EQ '9') THEN(DO) WRKPRTSTS FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) + SPLNBR(&SPLNBR) MONMSG MSGID(CPF0000) ENDDO /* If one of the formatted/PC file options */ IF COND((&OPTION *EQ 'P') *OR (&OPTION *EQ 'T') + *OR (&OPTION *EQ 'V') *OR (&OPTION *EQ 'F')) THEN(DO) CHGVAR VAR(&MSGDTA) VALUE('Processing selected + spoolfile. Please wait...') SNDPGMMSG MSGID(GSM9999) MSGF(DBGMSGF) MSGDTA(&MSGDTA) + TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Clear out the file that will hold the resultant data */ CLRPFM FILE(QTEMP/DBG1872W) /* If target format is HTML, add the standard header */ IF COND((&FILEEXT *EQ '.HTML') *OR (&FILEEXT + *EQ '.html')) THEN(DO) CALL PGM(DBG189R4) PARM('HTMLSTART' &HTMLTITLE) MONMSG MSGID(CPF0000) ENDDO /* Load the 'from' file with spoolfile data, if formatting required */ IF COND((&OPTION *EQ 'V') *OR (&FORMAT *EQ + 'Y')) THEN(DO) CPYSPLF FILE(&FILE) TOFILE(QTEMP/DBG1871W) + JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLNBR) + CTLCHAR(*PRTCTL) /* Any problems, then quit */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ENDPGM)) /* Format the data (insert blank lines, etc) */ OVRDBF FILE(DBG1871W) TOFILE(QTEMP/DBG1871W) OVRDBF FILE(DBG1872W) TOFILE(QTEMP/DBG1872W) CHGVAR VAR(&SPLNBRDEC) VALUE(&SPLNBR) CALL PGM(DBG187R4) PARM(&JOB &USER &JOBNBR &FILE + &SPLNBRDEC) DLTOVR FILE(DBG1871W) DLTOVR FILE(DBG1872W) ENDDO /* Otherwise load the 'to' file directly, as no special formatting required */ ELSE CMD(DO) CPYSPLF FILE(&FILE) TOFILE(QTEMP/DBG1872W) + JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLNBR) + MBROPT(*ADD) CTLCHAR(*NONE) ENDDO /* If target format is HTML, add the standard footer */ IF COND((&FILEEXT *EQ '.HTML') *OR (&FILEEXT + *EQ '.html')) THEN(DO) CALL PGM(DBG189R4) PARM('HTMLEND' &HTMLTITLE) MONMSG MSGID(CPF0000) ENDDO /* Option V: View formatted spool file */ IF COND(&OPTION *EQ 'V') THEN(DO) DSPPFM FILE(QTEMP/DBG1872W) ENDDO /* Option F, T or P: Save spoolfile as text document */ IF COND((&OPTION *EQ 'T') *OR (&OPTION *EQ + 'P') *OR (&OPTION *EQ 'F')) THEN(DO) CHGVAR VAR(&FULLFILE) VALUE(&FILENAME |< &FILEEXT) CHGVAR VAR(&PCFILE) VALUE('"' |< &FILENAME |< '"') CHGVAR VAR(&PCFILEEXT) VALUE('"' |< &FILEEXT |< '"') /* Remove any dodgy characters from the PC filename generated */ CALL PGM(DBG191R4) PARM(&FULLFILE) /* If IFS location provided, use it, otherwise use the current directory */ IF COND(&STMFDIR *EQ ' ') THEN(DO) RTVCURDIR RTNDIR(&RTNDIR) DIRNAMLEN(&DIRNAMLEN) CHGVAR VAR(&STMFDIR) VALUE(&RTNDIR) ENDDO CHGVAR VAR(&STMF) VALUE(&STMFDIR |< '/' || &FULLFILE) CHGVAR VAR(&FILEPATH) + VALUE('/QSYS.LIB/QTEMP.LIB/DBG1872W.FILE/DB+ G1872W.MBR') /* Copy to IFS as a text file */ CPYTOSTMF FROMMBR(&FILEPATH) TOSTMF(&STMF) + STMFOPT(*REPLACE) STMFCODPAG(*PCASCII) /* Tell user where the file is located (useful for cut'n'paste if required) */ IF COND(&OPTION *EQ 'T') THEN(DO) CHGVAR VAR(&MSGDTA) VALUE('File: ' || &STMF) SNDPGMMSG MSGID(GSM9999) MSGF(DBGMSGF) MSGDTA(&MSGDTA) + TOPGMQ(*PRV) MSGTYPE(*COMP) ENDDO /* For option P or F resolve IP address of remote machine if not specified */ IF COND((&OPTION *EQ 'P') *OR (&OPTION *EQ + 'F')) THEN(DO) /* RTNIPADDR (c) Tom Liotta http://zap.to/tl400 Used with permission */ IF COND(&REMOTEMACH *EQ ' ') THEN(RTNIPADDR + IPADDR(&REMOTEMACH)) ENDDO /* Option P: Open text document on local PC (requires AS/400 & PC config) */ IF COND(&OPTION *EQ 'P') THEN(DO) CHGVAR VAR(&STMFDIRWIN) VALUE(&STMFDIR) CALL PGM(DBG192R4) PARM(&STMFDIRWIN) CHGVAR VAR(&PCSTMFPATH) VALUE('"' || '\\' || + &SYSPATH |< &STMFDIRWIN |< '\"') CHGVAR VAR(&PCCMD) VALUE(&BATCHFILE |> &PCSTMFPATH + |> &PCFILE |> &PCFILEEXT) RUNRMTCMD CMD(&PCCMD) RMTLOCNAME(&REMOTEMACH *IP) + RMTUSER(*CURRENT) RMTPWD(&REMOTEPASS) MONMSG MSGID(CPF9100) EXEC(DO) /* Tell user they need to have IT set them up for auto transfer */ CHGVAR VAR(&MSGDTA) VALUE('Your system is not + correctly configured for opening the PC + file - Contact IT.') SNDPGMMSG MSGID(GSM9999) MSGF(DBGMSGF) MSGDTA(&MSGDTA) + TOPGMQ(*PRV) MSGTYPE(*COMP) ENDDO /* Delete the text file now */ RMVLNK OBJLNK(&STMF) ENDDO /* Option F: FTP the document to the target machine */ IF COND(&OPTION *EQ 'F') THEN(DO) CLRPFM FILE(QTEMP/FTPSRC) MBR(FTPOUT) OVRDBF FILE(FTPSRC) TOFILE(QTEMP/FTPSRC) MBR(FTPIN) CALL PGM(DBG190R4) PARM(&FILENAME &FILEEXT + &STMFDIR &FTPDIR &REMOTEMACH &REMOTEUSER &REMOTEPASS) DLTOVR FILE(FTPSRC) OVRDBF FILE(INPUT) TOFILE(QTEMP/FTPSRC) MBR(FTPIN) OVRDBF FILE(OUTPUT) TOFILE(QTEMP/FTPSRC) MBR(FTPOUT) FTP RMTSYS(DUMMY_HOST) DLTOVR FILE(INPUT OUTPUT) CLRPFM FILE(QTEMP/FTPSRC) MBR(FTPIN) /* Delete the text file now */ RMVLNK OBJLNK(&STMF) CHGVAR VAR(&MSGDTA) VALUE('File: ' || + &FULLFILE |< ' sent to ' || &REMOTEMACH) SNDPGMMSG MSGID(GSM9999) MSGF(DBGMSGF) MSGDTA(&MSGDTA) + TOPGMQ(*PRV) MSGTYPE(*COMP) ENDDO ENDDO ENDDO ENDPGM: DLTOVR FILE(DBGUOL00) MONMSG MSGID(CPF9841) RETURN ENDPGM </verbatim> -- Main.MartinRowe - 24 Jun 2005
E
dit
|
A
ttach
|
P
rint version
|
H
istory
: r1
|
B
acklinks
|
V
iew topic
|
Edit
w
iki text
|
M
ore topic actions
Topic revision: r1 - 24 Jun 2005 - 05:14:31 -
MartinRowe
DBG400
Log In
DBG400 Web
Index
Search
Changes
Notifications
Statistics
Site Map
Downloads
Webs
DBG400
Jamaro
Main
Sandbox
Sandtub
System
Send a link to this page
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400?
Send feedback