-
Hier mal der Code, falls jemand es noch mal brauchen kann.
ACHTUNG: Bislang keine Fehlerverarbeitung eingebaut!
PHP-Code:
H main(Main)
H DFTACTGRP(*NO)
DMain PR extpgm('TESTJRN')
DJournalDaten...
D likeds(DS_JournalDaten)
DJournalCommunication...
D likeds(DS_JournalCommunication)
DINT_DatenvergleichAenderung...
D PR 32767A
D varying
DINP_Bibliothek 10A
DINP_Tabelle 10A
DINT_PruefeZahl...
D PR 99A
DINP_Zahl...
D 63P 0 const
DINP_Nachkommastellen...
D 10I 0
DDS_JournalDaten...
D Ds DS bei ENTFMT(*Type2)
D JOENTL 5S 0 Entry Length
D JOSEQN 10S 0 Sequence Number
D JOCODE 1A Journal Code
D JOENTT 2A Entry Type
D JODATE 6A Datum
D JOTIME 6S 0 Zeit
D JOJOB 10A Jobname
D JOUSER 10A Username
D JONBR 6S 0 Jobnummer
D JOPGM 10A Programmname
D JOOBJ 10A Objektname
D JOLIB 10A Objektbibliothek
D JOMBR 10A Member Name
D JOCTRR 10S 0 Count/RRN
D JOFLAG 1A Flag
D JOCCID 10S 0 Commit Cycle ID
D JOUSPF 10A User Profile
D JOSYNM 8A System Name
D JOINCDAT 1A Incomplete data
D JOMINESD 1A Minimized Entry
D JORES 18A Reserved
D JODTA 32767A Entry-Specific Data
DDS_JournalCommunication...
D Ds DS Für die Kommunik.
D mit dem RCVJRNE-Bef.
D JOCTL 1A
D JOENTAVL 1A
D JOENTPAS 1A
PMain B
D PI
DJournalDaten...
D likeds(DS_JournalDaten)
DJournalCommunication...
D likeds(DS_JournalCommunication)
*-- JOCTL - journal control: ------------------------------------------**
DNoEnt c '0'
DSngEnt c '1'
DBlkEnt c '2'
DRcvChgEnd c '3'
DBegBlkMod c '28'
DEndRcvJrnE c '9'
*-- JOCODE - journal code:
DRcdTyp c 'R'
DDS_Daten E DS extname('TESTJRNETR')
DChangedData S 100000A inz
D varying
/free
If JournalCommunication.JOCTL = SngEnt And
JournalDaten.JOCODE = RcdTyp;
//Journaleintrags-Art verarbeiten
Select;
When JournalDaten.JOENTT = 'UB';
//Daten lt. Journal in Datei abspeichern für späteren
//Vergleich mit UP-Satz
Daten = JournalDaten.JODTA;
exec sql
insert into testjrnetr values(:DS_Daten);
When JournalDaten.JOENTT = 'UP';
//UP-Satz in Datei abspeichern für Vergleich
Daten = JournalDaten.JODTA;
exec sql
insert into testjrnetr values(:DS_Daten);
//UB-Satz und UP-Satz miteinander vergleichen
ChangedData = INT_DatenvergleichAenderung(
JournalDaten.JOLIB:JournalDaten.JOOBJ);
if ChangedData <> *blanks;
//TODO
endif;
exec sql
delete from testjrnetr;
When JournalDaten.JOENTT = 'PT'
Or JournalDaten.JOENTT = 'PX';
When JournalDaten.JOENTT = 'DL';
EndSl;
endif;
If %Shtdn;
JOCTL = EndRcvJrnE;
Endif;
/end-free
P E
PINT_DatenvergleichAenderung...
P B
D PI 32767A
D varying
DINP_Bibliothek 10A
DINP_Tabelle 10A
DETESTJRNETR E DS extname('TESTJRNETR')
DDS_DatenUB DS likeds(ETESTJRNETR)
DDS_DatenUP DS likeds(ETESTJRNETR)
DAnzahlSpalten S 10I 0 inz
//DS für die Rückgabe aus syscolumns
DSpalten DS qualified
D dim(999)
D Name 10A
D Typ 8A
D Laenge 10I 0
D Speicher 10I 0
D Genauigkeit 10I 0
D Nachkommastellen...
D 10I 0
//DS für Datenformat 'P' (Typ: DECIMAL)
DPackedDS DS
D Packed 63P 0 inz
DPackedHelpDS DS
D PackedHelpNum 63P 0 inz
D PackedHelpX 31 overlay(PackedHelpNum)
//DS für Datenformat 'S' (Typ: NUMERIC)
DZonedDS DS
D Zoned 63S 0 inz
DZonedHelpDS DS
D ZonedHelpNum 63S 0 inz
D ZonedHelpX 62 overlay(ZonedHelpNum)
//Verschiedene Zähler
DPosition S 5S 0 inz
DPositionAdd S 5S 0 inz
Di S 10I 0 inz
//Felder für den Vergleich von UB- und UP-Sätzen
DDatenUB S 32767A inz
D varying
DDatenUP S 32767A inz
D varying
//Rückgabewert
DOut_Ergebnis S 32767A inz
D varying
/free
exec sql
declare Datencursor Cursor for
select daten
from testjrnetr;
exec sql
open Datencursor;
exec sql
fetch next from Datencursor
into :DS_DatenUB ;
exec sql
fetch next from Datencursor
into :DS_DatenUP ;
exec sql
close Datencursor;
exec sql
select count(*)
into :AnzahlSpalten
from syscolumns
where system_table_name = :INP_Tabelle
and system_table_schema = :INP_Bibliothek;
exec sql
declare Spaltencursor Cursor for
select system_column_name,
data_type,
length,
storage,
case when numeric_precision is null
then 0
else numeric_precision end,
case when numeric_scale is null
then 0
else numeric_scale end
from syscolumns
where system_table_name = :INP_Tabelle
and system_table_schema = :INP_Bibliothek
order by ordinal_position;
exec sql
open Spaltencursor;
exec sql
fetch next from Spaltencursor
for :AnzahlSpalten rows
into :Spalten;
exec sql
close Spaltencursor;
Position = 1;
for i = 1 to AnzahlSpalten;
Select;
//Variante Character
When Spalten(i).Typ = 'CHAR' or Spalten(i).Typ = 'VARCHAR';
PositionAdd = Spalten(i).Speicher;
DatenUB = %subst(DS_DatenUB :Position:Spalten(i).Laenge);
DatenUP = %subst(DS_DatenUP :Position:Spalten(i).Laenge);
if DatenUB <> DatenUP;
if DatenUB = *blanks;
DatenUB = 'leer';
endif;
if DatenUP = *blanks;
DatenUP = 'leer';
endif;
OUT_Ergebnis = %trim(OUT_Ergebnis)
+ 'Feld: '
+ %trim(Spalten(i).Name)
+ ' ~ Alt: '
+ %trim(DatenUB)
+ ' ~ Neu: '
+ %trim(DatenUP)
+ ' |';
endif;
//Variante Numeric(Packed)
When Spalten(i).Typ = 'DECIMAL';
PositionAdd = Spalten(i).Speicher;
evalr PackedDS =
PackedHelpX + %subst(DS_DatenUB :Position:Spalten(i).Speicher);
DatenUB =
INT_PruefeZahl(%dec(Packed):Spalten(i).Nachkommastellen);
evalr PackedDS =
PackedHelpX + %subst(DS_DatenUP :Position:Spalten(i).Speicher);
DatenUP =
INT_PruefeZahl(%dec(Packed):Spalten(i).Nachkommastellen);
if DatenUB <> DatenUP;
OUT_Ergebnis = %trim(OUT_Ergebnis)
+ 'Feld: '
+ %trim(Spalten(i).Name)
+ ' ~ Alt: '
+ %trim(DatenUB)
+ ' ~ Neu: '
+ %trim(DatenUP)
+ ' |';
endif;
//Variante Numeric(Zoned)
When Spalten(i).Typ = 'NUMERIC';
PositionAdd = Spalten(i).Speicher;
evalr ZonedDS =
ZonedHelpX + %subst(DS_DatenUB :Position:Spalten(i).Speicher);
DatenUB =
INT_PruefeZahl(%dec(Zoned):Spalten(i).Nachkommastellen);
evalr ZonedDS =
ZonedHelpX + %subst(DS_DatenUP :Position:Spalten(i).Speicher);
DatenUP =
INT_PruefeZahl(%dec(Zoned):Spalten(i).Nachkommastellen);
if DatenUB <> DatenUP;
OUT_Ergebnis = %trim(OUT_Ergebnis)
+ 'Feld: '
+ %trim(Spalten(i).Name)
+ ' ~ Alt: '
+ %trim(DatenUB)
+ ' ~ Neu: '
+ %trim(DatenUP)
+ ' |';
endif;
//Varianten Date und Time
When Spalten(i).Typ = 'DATE'
or Spalten(i).Typ = 'TIME';
PositionAdd = Spalten(i).Speicher;
DatenUB = %subst(DS_DatenUB :Position:Spalten(i).Laenge);
DatenUP = %subst(DS_DatenUP :Position:Spalten(i).Laenge);
if DatenUB <> DatenUP;
OUT_Ergebnis = %trim(OUT_Ergebnis)
+ 'Feld: '
+ %trim(Spalten(i).Name)
+ ' ~ Alt: '
+ %trim(DatenUB)
+ ' ~ Neu: '
+ %trim(DatenUP)
+ ' |';
endif;
//Variante Timestamp
When Spalten(i).Typ = 'TIMESTMP';
//Länge ist Fest 26. Lt. syscolums sind Länge und Speicher 10.
PositionAdd = 26;
DatenUB = %subst(DS_DatenUB:Position:26);
DatenUP = %subst(DS_DatenUP:Position:26);
if DatenUB <> DatenUP;
OUT_Ergebnis = %trim(OUT_Ergebnis)
+ 'Feld: '
+ %trim(Spalten(i).Name)
+ ' ~ Alt: '
+ %trim(DatenUB)
+ ' ~ Neu: '
+ %trim(DatenUP)
+ ' |';
endif;
Other;
PositionAdd = Spalten(i).Speicher;
//ACHTUNG: Hier kann es evtl. zu Problemen kommen mit der Länge des Feldes
//Ähnlich wie bei TIMESTMP.
//TODO
EndSl;
Position = Position + PositionAdd;
endfor;
return OUT_Ergebnis;
/end-free
P E
PINT_PruefeZahl B
D PI 99A
DINP_Zahl...
D 63P 0 const
DINP_Nachkommastellen...
D 10I 0
DOUT_Text S 99A inz
Di S 10I 0 inz
DDivisor S 63S 0 inz(1)
DGanzzahl S 63S 0 inz
DKommazahl S 63S 0 inz
/free
if INP_Nachkommastellen = 0;
OUT_Text = %char(INP_Zahl);
else;
for i = 1 to INP_Nachkommastellen;
Divisor = Divisor * 10;
endfor;
Ganzzahl = INP_Zahl/Divisor;
Kommazahl = INP_Zahl-(Ganzzahl*Divisor);
OUT_Text = %char(Ganzzahl) + ','
+ %char(Kommazahl);
endif;
return OUT_Text;
/end-free
P E
Similar Threads
-
By RLurati in forum IBM i Hauptforum
Antworten: 5
Letzter Beitrag: 12-06-06, 08:16
-
By Frank Schuman in forum IBM i Hauptforum
Antworten: 5
Letzter Beitrag: 14-08-01, 19:29
Berechtigungen
- Neue Themen erstellen: Nein
- Themen beantworten: Nein
- You may not post attachments
- You may not edit your posts
-
Foren-Regeln
|
Erweiterte Foren Suche
Google Foren Suche
Forum & Artikel
Update eMail
AS/400 / IBM i
Server Expert Gruppen
Unternehmens IT
|
Kategorien online Artikel
- Big Data, Analytics, BI, MIS
- Cloud, Social Media, Devices
- DMS, Archivierung, Druck
- ERP + Add-ons, Business Software
- Hochverfügbarkeit
- Human Resources, Personal
- IBM Announcements
- IT-Karikaturen
- Leitartikel
- Load`n`go
- Messen, Veranstaltungen
- NEWSolutions Dossiers
- Programmierung
- Security
- Software Development + Change Mgmt.
- Solutions & Provider
- Speicher – Storage
- Strategische Berichte
- Systemmanagement
- Tools, Hot-Tips
Auf dem Laufenden bleiben
|
![[NEWSboard IBMi Forum]](images/duke/nblogo.gif)
[User]
Mit Zitat antworten
Bookmarks