-
Für alle die Probleme mit der Sommerzeitumstellung haben, hier ein Programm, welches alles automatisch tut.
Im Kopf der Source steht eine kurze Beschreibung.
Die Zeitgrenzen letzter Sonntag/Monat 03 bzw. erster Sonntag/Monat 10 gelten für Mitteleuropäische-Zeitzone !!!
Da der AS/400-Scheduler nichts anderes unterstützt, muß der Job jeden Sonntag um 02:00:00 Uhr laufen.
Code:
SETDST_DE: PGM
/******************************************************************************/
/* NAME - SETDST_DE */
/* FUNCTION - PERFORM AUTOMATIC DAYLIGHT SAVINGS TIME ADJUSTMENTS. */
/* */
/* NOTE - PROGRAM SHOULD BE COMPILED WITH USRPRF(*OWNER), AND */
/* THE OWNER SHOULD HAVE AUTHORITY TO CHGSYSVAL QHOUR */
/* - OR - */
/* THE JOB SCHEDULE ENTRY SHOULD NAME A USER THAT HAS */
/* AUTHORITY TO CHGSYSVAL QHOUR. */
/* */
/* ===>>> DATE OF LAST MODS. : 2002/03/25 */
/* */
/* TAKEN FROM: MIDRANGE COMPUTING, DECEMBER 1997, PAGE 13. */
/* (FROM DAVID HUMMELL, MODIFICATION OF PROGRAM BY LORI NESJE) */
/* FURTHER MODS BY NEIL PALMER, DPS CANADA LTD. */
/* */
/* ADD TO SYSTEM JOB SCHEDULER AS FOLLOWS (SUBSTITUTE VALID USER): */
/* ADDJOBSCDE JOB(AUTO_DST) CMD(CALL PGM(QGPL/SETDST_DE)) + */
/* FRQ(*MONTHLY) SCDDATE(*NONE) SCDDAY(*SUN) + */
/* SCDTIME(020000) RELDAYMON(*LAST) + */
/* JOBQ(QSYSNOMAX) USER(????) TEXT('DAYLIGHT + */
/* SAVINGS TIME ADJUSTMENT PROGRAM') */
/* */
/******************************************************************************/
DCL VAR(&MONTH) TYPE(*CHAR) LEN(2)
DCL VAR(&HOUR) TYPE(*CHAR) LEN(2)
DCL VAR(&DAY) TYPE(*CHAR) LEN(2)
DCL VAR(&DOW) TYPE(*CHAR) LEN(4)
DCL VAR(&HOUR#) TYPE(*DEC) LEN(2 0)
DCL VAR(&UTCOFFSET) TYPE(*CHAR) LEN(5)
DCL VAR(&UTCOFFSET#) TYPE(*DEC) LEN(5 0)
DCL VAR(&CHANGED) TYPE(*LGL) VALUE('0')
RTVSYSVAL SYSVAL(QMONTH) RTNVAR(&MONTH)
RTVSYSVAL SYSVAL(QHOUR) RTNVAR(&HOUR)
RTVSYSVAL SYSVAL(QDAY) RTNVAR(&DAY)
RTVSYSVAL SYSVAL(QUTCOFFSET) RTNVAR(&UTCOFFSET)
RTVSYSVAL SYSVAL(QDAYOFWEEK) RTNVAR(&DOW)
/* IF THIS IS NOT SUNDAY THEN THE AS/400 WAS DOWN ON SUNDAY */
/* TIME MAY HAVE BEEN SET MANUALLY. */
/* SEND MESSAGE TO SYSTEM OPERATOR TO CHECK THE TIME */
IF COND(&DOW *NE '*SUN') THEN(DO)
IF COND(&MONTH = '03' *OR (&MONTH = '04' *AND +
&DAY < '15') *OR &MONTH = '10' *OR +
(&MONTH = '11' *AND &DAY < '15')) THEN(DO)
SNDPGMMSG MSG('Der Job zur Anpassung der Sommer- / +
Winterzeit ist nicht am letzten Sonntag +
im März / Oktober gelaufen. Bitte stellen +
Sie die Systemwerte QHOUR und QUTCOFFSET +
manuell ein. !!!') TOMSGQ(*SYSOPR)
GOTO CMDLBL(END)
ENDDO
ENDDO
CHGVAR VAR(&HOUR#) VALUE(&HOUR)
CHGVAR VAR(&UTCOFFSET#) VALUE(&UTCOFFSET)
IF COND(&MONTH = '03' *AND &UTCOFFSET = +
'+0100') THEN(DO)
CHGVAR VAR(&HOUR#) VALUE(&HOUR# +1)
CHGVAR VAR(&UTCOFFSET#) VALUE(&UTCOFFSET# +100)
CHGVAR VAR(&CHANGED) VALUE('1')
ENDDO
IF COND(&MONTH = '10' *AND &UTCOFFSET = +
'+0200') THEN(DO)
CHGVAR VAR(&HOUR#) VALUE(&HOUR# -1)
CHGVAR VAR(&UTCOFFSET#) VALUE(&UTCOFFSET# -100)
CHGVAR VAR(&CHANGED) VALUE('1')
ENDDO
IF COND(&CHANGED = '1') THEN(DO)
CHGVAR VAR(&HOUR) VALUE(&HOUR#)
CHGSYSVAL SYSVAL(QHOUR) VALUE(&HOUR)
CHGVAR VAR(&UTCOFFSET) VALUE(&UTCOFFSET#)
IF COND(&UTCOFFSET# >= 0) THEN(CHGVAR +
VAR(&UTCOFFSET) VALUE('+' *CAT +
%SST(&UTCOFFSET 2 4)))
CHGSYSVAL SYSVAL(QUTCOFFSET) VALUE(&UTCOFFSET)
SNDPGMMSG MSG('Der Job zur Anpassung der Sommer- / +
Winterzeit hat folgende Werte verändert : +
' *CAT 'QHOUR = ' *CAT &HOUR *CAT '; +
QUTCOFFSET = ' *CAT &UTCOFFSET *CAT ' +
!!!') TOMSGQ(*SYSOPR)
ENDDO
END:
[Dieser Beitrag wurde von Sven Schneider am 01. April 2003 editiert.]
Similar Threads
-
By lossin in forum IBM i Hauptforum
Antworten: 13
Letzter Beitrag: 18-12-06, 10:17
-
By BN78 in forum IBM i Hauptforum
Antworten: 1
Letzter Beitrag: 21-11-06, 11:32
-
By schatte in forum IBM i Hauptforum
Antworten: 4
Letzter Beitrag: 07-11-06, 18:23
-
By erzengel in forum IBM i Hauptforum
Antworten: 3
Letzter Beitrag: 07-04-06, 10:46
-
By chera in forum IBM i Hauptforum
Antworten: 4
Letzter Beitrag: 14-02-02, 14:47
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
|
Bookmarks