-
Ja die hatte ich auch verwendet. Ich hatte sie nur falsch erweitert. Anstatt 63P0 mit 31 im overlay hatte ich 63P0 mit 32 im overlay.
Jetzt gehts.
-
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
-
Wenn du dann dein ZonedHelpX noch auf 62 definierst...
-
Moin,
Noch mal ne andere Sache in dem Zusammenhang.
Obwohl die Datei TESTJRNETR, welche zum Zwischenspeichern der UB-Daten genutzt wird, inzwischen auf REUSEDLT(*YES) steht werden die gelöschten Datensätze scheinbar nicht überschrieben, sondern es werden immer nur mehr.
Werden die gelöschten Sätze nicht überschrieben, wenn schreiben und löschen die ganze Zeit derselbe Job macht?
Gibt es eine andere Möglichkeit die Datei klein zu halten?
-
Ich habe die Datei jetzt per SQL angelegt und auch das write auf SQL umgestellt. Dann geht es.
PHP-Code:
CREATE TABLE testjrnetr
(DATEN CHAR(32766) NOT NULL WITH DEFAULT)
NOT LOGGED INITIALLY
VOLATILE
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