RPG
Aus informatikvs
- Raten - Programmieren - Gewinnen
- Role - Play - Game
- Report - Program - Generator
Inhaltsverzeichnis
Dekodieren Unicode- / Character-Feld
0000.00 **************************************************************/ 0027.00 h CCSID(*GRAPH : *SRC) 0028.00 h CCSID(*UCS2 : 1200) 0029.00 h CCSID(*CHAR : *JOBRUN) 0030.00 h alwnull(*usrctl) 0031.00 h option(*NoDebugIo:*SrcStmt) ... 0131.00 **************************************************************/ 0132.00 d $256UNIC S 256C CCSID(1200) 0133.00 d $256CHAR S 256A 0134.00 **************************************************************/ ... 0179.00 c Clear $256UNIC 0180.00 c Eval $256UNIC = mytstuc 0181.00 c Eval $256CHAR = $256UNIC 0182.00 c Eval myt2tch = $256CHAR 0183.00 c Clear $256UNIC 0184.00 c Eval $256CHAR = mytstch 0185.00 c Eval $256UNIC = $256CHAR 0186.00 c Eval myt2tuc = $256UNIC ... 0999.00 //**************************************************************/
Datum - Monatsletzten ermitteln
0061.00 //**************************************************************/
0062.00 BegSr §Ultimo;
0063.00 #Ultimo = %date(); // '2015-03-30'
0064.00 #Ultimo = #Ultimo - %days(%subdt(#Ultimo : *days)-1); // '2015-03-01'
0065.00 #Ultimo = #Ultimo + %months(1); // '2015-04-01'
0066.00 #Ultimo = #Ultimo - %days(1); // '2015-03-31'
0067.00 #Brain = %diff(#ultimo:D'1899-12-30':*days); // 42094
0069.00 EndSr;
0070.00 //**************************************************************/
0027.00 //**************************************************************/
0028.00 BegSr §Datum;
0029.00 #Brain = %diff(%date():D'1899-12-30':*days);
0030.00 #Date = D'1899-12-30' + %days(#Brain);
0031.00 #Date = %date(151224 : *ymd);
0032.00 #Date = %date(20151224 : *iso);
0033.00 #Date = %date('151224' : *ymd0);
0034.00 #Date = %date('20151224' : *iso0);
0035.00 #Date = %date('18.12.14' : *dmy.);
0036.00 #num8s0= %dec(%date():*eur); // ttmmjjjj
0037.00 #num8s0= %dec(%date():*iso); // jjjjmmtt
0046.00 EndSr;
0047.00 //**************************************************************/
Embedded SQL programming
//**************************************************************/
...
exec sql set option commit=*NONE,
closqlcsr=*ENDMOD,
dlyprp=*YES;
...
Exec Sql select v7tgtx
into :#feld
from v7tabgld
where v7apid = 'KW'
and v7tbnr = 363
and v7tgid = : #tgid
and v7spcd = : #spcd
fetch first 1 rows only;
If SqlCode = 100;
#feld = *blanks;
Exec Sql
insert into v7tabgld (V7APID, V7TBNR, V7TGID, V7SPCD, V7TGTX)
Values('KW', 363, :#tgid, :#spcd, :#FELD);
ElseIf SqlCode <> 0;
#feld = 'sqlcode: ' + %char(sqlcode);
dsply(e) #feld;
Endif;
...
Exec Sql update v7tabgld
set v7tgtx = :#feld
where v7apid = 'KW'
and v7tbnr = 363
and v7tgid = : #tgid
and v7spcd = : #spcd;
If SqlCode <> 0;
#Feld = 'Fehler beim Update ' + %char(sqlcode);
dsply(e) #Feld;
Endif;
...
//**************************************************************/
Zebra Etikett drucken
0001.00 *****************************************************************
0002.00 h dftname(hszebrac)
0003.00 h decedit('0,') datedit(*ymd.)
0004.00 h datfmt(*iso) timfmt(*iso)
0005.00 h Option(*NoDebugIo:*SrcStmt)
0006.00 /IF DEFINED(*CRTBNDRPG)
0007.00 h dftactgrp(*no)
0008.00 /ENDIF
0009.00 *****************************************************************
0010.00 *****************************************************************
0011.00 * Druckerdatei um Kartonkleber auf Zebradrucker zu drucken
0012.00 * CRTPRTF FILE(LEHRBIB/HSZEBRA) DEVTYPE(*LINE)
0013.00 Fhszebra O F 100 Printer UsrOpn
0014.00 *****************************************************************
0015.00 d sprintf PR 10i 0 ExtProc('sprintf')
0016.00 d * Value
0017.00 d * Value Options(*string:*nopass)
0018.00 d * Value Options(*string:*nopass)
0019.00 d * Value Options(*string:*nopass)
0020.00 d * Value Options(*string:*nopass)
0021.00 d system PR 10i 0 ExtProc('system')
0022.00 d * Value Options(*string)
0023.00 *****************************************************************
0024.00 d DrZeile# s 90a
0025.00 d AnzEti# s 5u 0 inz(1)
0026.00 d #dots c 'N,40,55'
0027.00 d #name s 30a
0028.00 d x s 5u 0
0029.00 d #col s like(x)
0030.00 d #row s like(x)
0031.00 *****************************************************************
0032.00
0033.00 c ExSr Drck2Zebra
0034.00
0035.00 c Eval *inlr = *On
0036.00 c Return
0037.00 *****************************************************************
0038.00 /free
0039.00 //**************************************************************
0040.00 //***
0041.00 //**************************************************************
0042.00 BegSr Drck2Zebra;
0043.00 DrZeile# = 'ovrprtf file(HSZEBRA) HOLD(*YES) OUTQ(*JOB)';
0044.00 If (system(%trim(%trim(DrZeile#))) <> 0);
0045.00 Dsply 'Fehler beim Ovrprtf !';
0046.00 LeaveSr;
0047.00 EndIf;
0048.00 open HSZEBRA;
0049.00
0050.00 // Kleber initialisieren
0051.00 DrZeile# = '^XA' // start format
0052.00 + '^CFD' // alphanum. Font "D"
0053.00 + '^FWN' // Feld nicht drehen
0054.00 + '^LH0,0' // label home position
0055.00 + '^LRN' // nicht revers drucken
0056.00 + '^MD0' // Schwärzung wie Druckerdefault
0057.00 + '^MMT' // Vorschub nach Druck
0058.00 + '^MNY' // seperate Etiketten
0059.00 + '^MTT' // Thermotransfer-Etiketten
0060.00 + '^PMN' // nicht horizontal spiegeln
0061.00 + '^PON' // nicht auf den Kopf
0062.00 + '^PQ' // Druckqualität
0063.00 + %char(AnzEti#)
0064.00 + ',0,1,Y' // keine Pause, one replicate??, pause
0065.00 + '^PR2'; // langsam drucken
0066.00 Except DrZeile;
0067.00
0068.00 //*** 6 Adressaufkleber für Max Müller in 2 Spalten ***
0069.00 #row = 0;
0070.00 For x=1 to 9;
0071.00 #row += 50;
0072.00 If %rem(x+3 : 3) = 1;
0073.00 #name = 'Max Müller';
0074.00 #row += 50;
0075.00 ElseIf %rem(x+3 : 3) = 2;
0076.00 #name = 'Maximilianstraße 1';
0077.00 Else;
0078.00 #name = '80539 München';
0079.00 EndIf;
0080.00 ExSr EineZeile;
0081.00 EndFor;
0082.00
0083.00 DrZeile# = '^XA';
0084.00 Except DrZeile;
0085.00 EndSr;
0086.00
0087.00 //**************************************************************
0088.00 BegSr EineZeile;
0089.00 DrZeile# = '';
0090.00 #col = 100;
0091.00 sprintf( %addr(DrZeile#)
0092.00 : '^A0%s^FO%s^FD%s^FS'
0093.00 : #dots
0094.00 : %char(#col)+','+%char(#row)
0095.00 : %trim(#name)
0096.00 );
0097.00 Except DrZeile;
0098.00 DrZeile# = '';
0099.00 #col = 800;
0100.00 sprintf( %addr(DrZeile#)
0101.00 : '^A0%s^FO%s^FD%s^FS'
0102.00 : #dots
0103.00 : %char(#col)+','+%char(#row)
0104.00 : %trim(#name)
0105.00 );
0106.00 Except DrZeile;
0107.00 EndSr;
0108.00 //**************************************************************
0109.00 /end-free
0110.00 *****************************************************************
0111.00 * Druckausgabe für Zebradrucker
0112.00 OHSZEBRA E DrZeile 1
0113.00 O DrZeile# 90
return points (endsr)
*DETL Continue at the beginning of detail lines. *GETIN Continue at the get input record routine. *TOTC Continue at the beginning of total calculations. *TOTL Continue at the beginning of total lines. *OFL Continue at the beginning of overflow lines. *DETC Continue at the beginning of detail calculations. *CANCL Cancel the processing of the program.
Funktionstasten
| *inka | F01 |
| *inkb | F02 |
| *inkc | F03 |
| *inkd | F04 |
| *inke | F05 |
| *inkf | F06 |
| *inkg | F07 |
| *inkh | F08 |
| *inki | F09 |
| *inkj | F10 |
| *inkk | F11 |
| *inkl | F12 |
| *inkm | F13 |
| *inkn | F14 |
| *inkp | F15 |
| *inkq | F16 |
| *inkr | F17 |
| *inks | F18 |
| *inkt | F19 |
| *inku | F20 |
| *inkv | F21 |
| *inkw | F22 |
| *inkx | F23 |
| *inky | F24 |
random number
/if defined(*crtbndrpg)
h dftactgrp(*no)
/endif
h option(*srcstmt)
//==================================================================//
d genrndnum pr ExtProc('CEERAN0')
d 10i 0 Const
d 8f
d 10a Options(*omit)
d rndnbr s 8f
d result s 5p 0
d message s 52a Varying
//==================================================================//
/free
genrndnum(0 : rndnbr : *omit);
result = %int(rndnbr * 6) + 1;
message = 'random number (1..6) is '
+ %char(result);
dsply message;
return;
/end-free
sprintf (textconcatenation)
/if defined(*crtbndrpg)
h dftactgrp(*no)
/endif
h option(*srcstmt)
//==================================================================//
d sprintf pr 10i 0 ExtProc('sprintf')
d * Value
d * Value Options(*string:*nopass)
d * Value Options(*string:*nopass)
d * Value Options(*string:*nopass)
d * Value Options(*string:*nopass)
// ...
d psds sds Qualified
d pgmn *proc
d jobu 10a Overlay(psds:254)
d message s 52a
//==================================================================//
/free
sprintf( %addr(message)
: 'Program %s is used by %s on %s'
: %trim(psds.pgmn)
: %trim(psds.jobu)
: %char(%date())
);
dsply message;
return;
/end-free
