Summary 16.10.2025

adressen/adressenImpl.cls

@@ -17,6 +17,7 @@ USING OpenEdge.Web.WebHandler FROM PROPATH.
 USING OpenEdge.Web.WebResponseWriter FROM PROPATH.
 USING Progress.Json.ObjectModel.JsonObject FROM PROPATH.
 USING Progress.Json.ObjectModel.JsonArray FROM PROPATH.
+
 USING src.ch.adprime.gemis.WebHandlerUtilities FROM PROPATH.
 USING utilities.utilitiesHandler FROM PROPATH.
 
@@ -758,6 +759,7 @@ CLASS adressenImpl INHERITS WebHandler:
             oJsonArray:Add(oJsonData).
             
             oJsonArray:WRITE(lcJsonString, FALSE).
+            oJsonData:WRITE(lcJsonString, FALSE).
             MESSAGE 'JsonArray = ' STRING(lcJsonString).
 
             MESSAGE 'lcString Rückgabe: ' + STRING(lcJsonString).

adressen/getFileDictImpl.cls

@@ -0,0 +1,130 @@
+ 
+/*------------------------------------------------------------------------
+   File        : adresse_dict
+   Purpose     : 
+   Syntax      : 
+   Description : 
+   Author(s)   : walter.riechsteiner
+   Created     : Thu Jun 26 13:56:20 CEST 2025
+   Notes       : 
+ ----------------------------------------------------------------------*/
+ 
+BLOCK-LEVEL ON ERROR UNDO, THROW.
+
+USING OpenEdge.Core.String FROM PROPATH.
+USING OpenEdge.Net.HTTP.IHttpResponse FROM PROPATH.
+USING OpenEdge.Net.HTTP.StatusCodeEnum FROM PROPATH.
+USING OpenEdge.Web.IWebRequest FROM PROPATH.
+USING OpenEdge.Web.WebHandler FROM PROPATH.
+USING OpenEdge.Web.WebResponseWriter FROM PROPATH.
+USING Progress.Json.ObjectModel.JsonObject FROM PROPATH.
+USING Progress.Json.ObjectModel.JsonArray FROM PROPATH.
+USING src.ch.adprime.gemis.WebHandlerUtilities FROM PROPATH.
+USING src.ch.adprime.gemis.ErrorMessage FROM PROPATH.
+
+CLASS getFileDIctImpl INHERITS WebHandler: 
+
+    DEFINE TEMP-TABLE tFileDIct
+        SERIALIZE-NAME 'fields'
+        FIELD cName   AS CHARACTER SERIALIZE-NAME 'name' 
+        FIELD cType   AS CHARACTER SERIALIZE-NAME 'type'
+        FIELD iLaenge AS INTEGER   SERIALIZE-NAME 'width'
+        .
+    /*------------------------------------------------------------------------------
+     Purpose:
+     Notes:
+    ------------------------------------------------------------------------------*/
+
+    METHOD OVERRIDE PROTECTED INTEGER HandleGet (INPUT poRequest AS IWebRequest ):
+        DEFINE VARIABLE oResponse       AS IHttpResponse     NO-UNDO.         
+        DEFINE VARIABLE oWriter         AS WebResponseWriter NO-UNDO.
+        DEFINE VARIABLE oError          AS ErrorMessage      NO-UNDO.
+        DEFINE VARIABLE oBody           AS String            NO-UNDO.
+        DEFINE VARIABLE oJsonResponse   AS JsonObject        NO-UNDO.
+        DEFINE VARIABLE lDebug          AS LOGICAL           NO-UNDO.
+        DEFINE VARIABLE cDefautlCharSet AS CHARACTER         NO-UNDO INIT 'UTF-8'.
+           
+        DEFINE VARIABLE cCorralationID  AS CHARACTER         NO-UNDO.
+        DEFINE VARIABLE cContent-Type   AS CHARACTER         NO-UNDO.
+        DEFINE VARIABLE htFileDIct      AS HANDLE            NO-UNDO.
+        DEFINE VARIABLE oJsonArray      AS JsonArray         NO-UNDO.
+        DEFINE VARIABLE lcJsonInhalt    AS LONGCHAR          NO-UNDO.
+        DEFINE VARIABLE ii              AS INTEGER           NO-UNDO.
+        DEFINE VARIABLE cFileName       AS CHARACTER         NO-UNDO.
+        DEFINE VARIABLE cFelder         AS CHARACTER         NO-UNDO.
+        
+        cFileName = poRequest:URI:GetQueryValue("File").
+        MESSAGE 'File-Name = ' cFileName.
+        
+        FIND FIRST AnaDat._File NO-LOCK 
+            WHERE AnaDat._File._File-Name = cFileName NO-ERROR.
+        FOR EACH AnaDat._Field OF AnaDat._File:
+            CREATE tFileDIct.
+            ASSIGN
+                tFileDIct.cName   = AnaDat._Field._Field-Name
+                tFileDIct.cType   = REPLACE(AnaDat._Field._Data-Type, '-', '_')
+                tFileDIct.iLaenge = 10.
+            CASE AnaDat._Field._Data-Type:
+                WHEN 'logical' THEN 
+                    tFileDIct.cType   = 'checkbox'.
+                WHEN 'character' THEN 
+                    tFileDIct.cType   = 'text'.
+                WHEN 'integer' THEN 
+                    tFileDIct.cType   = 'number'.
+                WHEN 'logical' THEN 
+                    tFileDIct.cType   = 'checkbox'.
+            END CASE.
+        END.
+        htFileDIct = TEMP-TABLE tFileDIct:DEFAULT-BUFFER-HANDLE.
+                 
+        cContent-Type = "application/json".
+           
+        oError = NEW ErrorMessage().
+        oError:lDebug = lDebug.
+          
+        oJsonResponse = NEW JsonObject().
+        htFileDIct:WRITE-JSON('JsonObject', oJsonResponse).
+        
+        oJsonResponse:WRITE(lcJsonInhalt, FALSE).
+        /*        ii = INDEX(lcJsonInhalt, '[').                 */
+        /*        lcJsonInhalt = SUBSTRING(lcJsonInhalt, ii).    */
+        /*                                                       */
+        /*        ii = R-INDEX(lcJsonInhalt, ']').               */
+        /*        lcJsonInhalt = SUBSTRING(lcJsonInhalt, 01, ii).*/
+
+        MESSAGE "GetHandler".
+          
+//        oBody = NEW String(oJsonResponse:GetJsonText()).         
+        oBody = NEW String(lcJsonInhalt).         
+        WebHandlerUtilities:createHttpResponse(INPUT INTEGER(StatusCodeEnum:OK), INPUT oBody, INPUT cContent-Type, INPUT cDefautlCharSet, INPUT cCorralationID, OUTPUT oResponse).
+//        oResponse:SetHeader(HttpHeaderBuilder:Build(cHeaderCorralationID):Value(cCorralationID):Header).
+           
+        oWriter = NEW WebResponseWriter(oResponse).
+        oWriter:Open(). 
+        oWriter:Close(). 
+            
+        RETURN 0.
+        
+        CATCH e AS Progress.Lang.Error:
+
+        END CATCH.
+
+        FINALLY:
+
+        END FINALLY.
+
+    END METHOD.
+
+    METHOD OVERRIDE PROTECTED INTEGER HandleNotAllowedMethod(INPUT poRequest AS IWebRequest):
+        DEFINE VARIABLE result AS INTEGER NO-UNDO.
+        MESSAGE "HandleNotAllowedMethod called" VIEW-AS ALERT-BOX.
+        RETURN result.
+    END METHOD.
+
+    METHOD OVERRIDE PROTECTED INTEGER HandleNotImplemented(INPUT poRequest AS IWebRequest):
+        DEFINE VARIABLE result AS INTEGER NO-UNDO.
+        MESSAGE "HandleNotImplemented called" VIEW-AS ALERT-BOX.
+        RETURN result.
+    END METHOD.
+
+END CLASS.

adressen/isWorking.cls

@@ -0,0 +1,28 @@
+ 
+ /*------------------------------------------------------------------------
+    File        : isWorking
+    Purpose     : 
+    Syntax      : 
+    Description : 
+    Author(s)   : walter.riechsteiner
+    Created     : Mon Jun 23 17:46:00 CEST 2025
+    Notes       : 
+  ----------------------------------------------------------------------*/
+
+USING Progress.Lang.*.
+
+BLOCK-LEVEL ON ERROR UNDO, THROW.
+
+CLASS isWorking FINAL: 
+
+    /*------------------------------------------------------------------------------
+     Purpose:
+     Notes:
+    ------------------------------------------------------------------------------*/
+
+    CONSTRUCTOR PUBLIC isWorking (  ):
+        SUPER ().
+        
+    END CONSTRUCTOR.
+
+END CLASS.

isWorkingImpl.cls

@@ -0,0 +1,266 @@
+ 
+/*------------------------------------------------------------------------
+   File        : adresse_dict
+   Purpose     : 
+   Syntax      : 
+   Description : 
+   Author(s)   : walter.riechsteiner
+   Created     : Thu Jun 26 13:56:20 CEST 2025
+   Notes       : 
+ ----------------------------------------------------------------------*/
+ 
+BLOCK-LEVEL ON ERROR UNDO, THROW.
+
+USING OpenEdge.Core.String FROM PROPATH.
+USING OpenEdge.Net.HTTP.IHttpResponse FROM PROPATH.
+USING OpenEdge.Net.HTTP.StatusCodeEnum FROM PROPATH.
+USING OpenEdge.Web.IWebRequest FROM PROPATH.
+USING OpenEdge.Web.WebHandler FROM PROPATH.
+USING OpenEdge.Web.WebResponseWriter FROM PROPATH.
+USING Progress.Json.ObjectModel.JsonObject FROM PROPATH.
+USING Progress.Json.ObjectModel.JsonArray FROM PROPATH.
+USING src.ch.adprime.gemis.WebHandlerUtilities FROM PROPATH.
+USING src.ch.adprime.gemis.ErrorMessage FROM PROPATH.
+
+CLASS isWorkingImpl INHERITS WebHandler: 
+
+    DEFINE TEMP-TABLE tFileDIct
+        SERIALIZE-NAME 'fields'
+        FIELD cName   AS CHARACTER SERIALIZE-NAME 'name' 
+        FIELD cType   AS CHARACTER SERIALIZE-NAME 'type'
+        FIELD iLaenge AS INTEGER   SERIALIZE-NAME 'width'
+        .
+    /*------------------------------------------------------------------------------
+     Purpose:
+     Notes:
+    ------------------------------------------------------------------------------*/
+
+    METHOD OVERRIDE PROTECTED INTEGER HandleGet (INPUT poRequest AS IWebRequest ):
+        DEFINE VARIABLE oResponse       AS IHttpResponse     NO-UNDO.         
+        DEFINE VARIABLE oWriter         AS WebResponseWriter NO-UNDO.
+        DEFINE VARIABLE oError          AS ErrorMessage      NO-UNDO.
+        DEFINE VARIABLE oBody           AS String            NO-UNDO.
+        DEFINE VARIABLE oJsonResponse   AS JsonObject        NO-UNDO.
+        DEFINE VARIABLE lDebug          AS LOGICAL           NO-UNDO.
+        DEFINE VARIABLE cDefautlCharSet AS CHARACTER         NO-UNDO INIT 'UTF-8'.
+           
+        DEFINE VARIABLE cCorralationID  AS CHARACTER         NO-UNDO.
+        DEFINE VARIABLE cContent-Type   AS CHARACTER         NO-UNDO.
+        DEFINE VARIABLE htFileDIct      AS HANDLE            NO-UNDO.
+        DEFINE VARIABLE oJsonArray      AS JsonArray         NO-UNDO.
+        DEFINE VARIABLE lcJsonInhalt    AS LONGCHAR          NO-UNDO.
+        DEFINE VARIABLE ii              AS INTEGER           NO-UNDO.
+        DEFINE VARIABLE cFileName       AS CHARACTER         NO-UNDO.
+        DEFINE VARIABLE cFelder         AS CHARACTER         NO-UNDO.
+        
+/*        cFileName = poRequest:URI:GetQueryValue("File").                       */
+/*        MESSAGE 'File-Name = ' cFileName.                                      */
+/*                                                                               */
+/*        FIND FIRST AnaDat._File NO-LOCK                                        */
+/*            WHERE AnaDat._File._File-Name = cFileName NO-ERROR.                */
+/*        FOR EACH AnaDat._Field OF AnaDat._File:                                */
+/*            CREATE tFileDIct.                                                  */
+/*            ASSIGN                                                             */
+/*                tFileDIct.cName   = AnaDat._Field._Field-Name                  */
+/*                tFileDIct.cType   = REPLACE(AnaDat._Field._Data-Type, '-', '_')*/
+/*                tFileDIct.iLaenge = 10.                                        */
+/*            CASE AnaDat._Field._Data-Type:                                     */
+/*                WHEN 'logical' THEN                                            */
+/*                    tFileDIct.cType   = 'checkbox'.                            */
+/*                WHEN 'character' THEN                                          */
+/*                    tFileDIct.cType   = 'text'.                                */
+/*                WHEN 'integer' THEN                                            */
+/*                    tFileDIct.cType   = 'number'.                              */
+/*                WHEN 'logical' THEN                                            */
+/*                    tFileDIct.cType   = 'checkbox'.                            */
+/*            END CASE.                                                          */
+/*        END.                                                                   */
+/*        htFileDIct = TEMP-TABLE tFileDIct:DEFAULT-BUFFER-HANDLE.               */
+/*                                                                               */
+        cContent-Type = "plain/text".
+           
+        oError = NEW ErrorMessage().
+        oError:lDebug = lDebug.
+          
+/*        oJsonResponse = NEW JsonObject().                  */
+/*        htFileDict:WRITE-JSON('JsonObject', oJsonResponse).*/
+/*                                                           */
+/*        oJsonResponse:WRITE(lcJsonInhalt, FALSE).          */
+        /*        ii = INDEX(lcJsonInhalt, '[').                 */
+        /*        lcJsonInhalt = SUBSTRING(lcJsonInhalt, ii).    */
+        /*                                                       */
+        /*        ii = R-INDEX(lcJsonInhalt, ']').               */
+        /*        lcJsonInhalt = SUBSTRING(lcJsonInhalt, 01, ii).*/
+
+        MESSAGE "GetHandler".
+          
+//        oBody = NEW String(oJsonResponse:GetJsonText()).         
+        oBody = NEW String('GET OK').         
+        WebHandlerUtilities:createHttpResponse(INPUT INTEGER(StatusCodeEnum:OK), INPUT oBody, INPUT cContent-Type, INPUT cDefautlCharSet, INPUT cCorralationID, OUTPUT oResponse).
+//        oResponse:SetHeader(HttpHeaderBuilder:Build(cHeaderCorralationID):Value(cCorralationID):Header).
+           
+        oWriter = NEW WebResponseWriter(oResponse).
+        oWriter:Open(). 
+        oWriter:Close(). 
+            
+        RETURN 0.
+        
+        CATCH e AS Progress.Lang.Error:
+
+        END CATCH.
+
+        FINALLY:
+
+        END FINALLY.
+
+    END METHOD.
+
+    METHOD OVERRIDE PROTECTED INTEGER HandlePost(INPUT poRequest AS IWebRequest):
+        DEFINE VARIABLE oResponse    AS IHttpResponse     NO-UNDO.
+        DEFINE VARIABLE oWriter      AS WebResponseWriter NO-UNDO.
+        DEFINE VARIABLE oJsonData    AS JsonObject        NO-UNDO.
+        DEFINE VARIABLE lcJsonString AS LONGCHAR          NO-UNDO.
+        
+        DEFINE VARIABLE lRetVal      AS LOGICAL           NO-UNDO.
+        
+        DEFINE VARIABLE hbttMandant  AS HANDLE            NO-UNDO.
+        DEFINE VARIABLE cGetHtml     AS CHARACTER         NO-UNDO.
+        DEFINE VARIABLE lcHTML       AS LONGCHAR          NO-UNDO.
+        DEFINE VARIABLE cDatei       AS CHARACTER         NO-UNDO.
+        DEFINE VARIABLE ii           AS INTEGER           NO-UNDO.
+        DEFINE VARIABLE lAdmin       AS LOGICAL           NO-UNDO.
+        DEFINE VARIABLE oInput       AS JsonObject        NO-UNDO.
+
+        MESSAGE "Entering HandlePost" VIEW-AS ALERT-BOX.
+        
+/*        lRetVal = WebHandlerUtilities:getJsonFromRequest(INPUT poRequest, OUTPUT oJsonData) NO-ERROR.       */
+/*        oJsonData:WRITE(lcJsonString, FALSE).                                                               */
+/*        //                                                                                                  */
+/*        //  Input-Daten (Steuersatz) aus JsonObject lesen und in ttInput füllen                             */
+/*        //                                                                                                  */
+/*        EMPTY TEMP-TABLE ttInput    .                                                                       */
+/*        hbttInput = TEMP-TABLE ttInput:DEFAULT-BUFFER-HANDLE.                                               */
+/*        oInput    = NEW JsonObject().                                                                       */
+/*        oInput    = oJsonData:GetJsonObject('ttInput').                                                     */
+/*        lRetVal   = hbttInput:READ-JSON ('JsonObject', oInput).                                             */
+/*                                                                                                            */
+/*        FIND FIRST ttInput.                                                                                 */
+/*        cAktion = ttInput.action.                                                                           */
+/*                                                                                                            */
+/*        outilitiesHandler = NEW utilitiesHandler().                                                         */
+/*                                                                                                            */
+/*        DO WHILE lRetVal:                                                                                   */
+/*            hbttInput    = TEMP-TABLE ttInput   :DEFAULT-BUFFER-HANDLE.                                     */
+/*            hbttMandant  = TEMP-TABLE ttMandant :DEFAULT-BUFFER-HANDLE.                                     */
+/*                                                                                                            */
+/*            MESSAGE 'Inputdaten gelesen mit returncode ' lRetVal.                                           */
+/*            IF NOT lRetVal THEN LEAVE.                                                                      */
+/*                                                                                                            */
+/*            FIND FIRST ttInput.                                                                             */
+/*                                                                                                            */
+/*            IF ttInput.action = 'first' THEN                                                                */
+/*            DO:                                                                                             */
+/*                EMPTY TEMP-TABLE ttMandant.                                                                 */
+/*                FOR EACH Mandant NO-LOCK                                                                    */
+/*                    WHERE Mandant.Zustand = TRUE:                                                           */
+/*                    CREATE  ttMandant.                                                                      */
+/*                    ASSIGN                                                                                  */
+/*                        ttMandant.Mandant     = Mandant.Firma                                               */
+/*                        ttMandant.Bezeichnung = Mandant.Name.                                               */
+/*                /*                    ttMandant.choose      = (IF Mandant = '2000' THEN '1' ELSE '0').*/    */
+/*                END.                                                                                        */
+/*                                                                                                            */
+/*                oJsonData = NEW JsonObject().                                                               */
+/*                hbttMandant:WRITE-JSON('JsonObject', oJsonData).                                            */
+/*                oJsonData:WRITE(lcJsonString, TRUE).                                                        */
+/*            END.                                                                                            */
+/*                                                                                                            */
+/*            IF ttInput.action = 'anmelden' THEN                                                             */
+/*            DO:                                                                                             */
+/*                oJsonData:WRITE(lcJsonString, FALSE).                                                       */
+/*                                                                                                            */
+/*                FIND FIRST ttInput.                                                                         */
+/*                                                                                                            */
+/*                IF INDEX(ttInput.benutzer, '_Admin') > 0 THEN                                               */
+/*                DO:                                                                                         */
+/*                    ttInput.benutzer = REPLACE(ttInput.benutzer, '_Admin', '').                             */
+/*                    lAdmin = TRUE.                                                                          */
+/*                END.                                                                                        */
+/*                                                                                                            */
+/*                IF NOT lAdmin THEN                                                                          */
+/*                DO:                                                                                         */
+/*                    FIND Benutzer NO-LOCK                                                                   */
+/*                        WHERE Benutzer.Firma    = ttInput.mandant                                           */
+/*                        AND   Benutzer.Benutzer = ttInput.benutzer                                          */
+/*                        AND   Benutzer.Kennwort = ttInput.password NO-ERROR.                                */
+/*                END.                                                                                        */
+/*                ELSE                                                                                        */
+/*                DO:                                                                                         */
+/*                    FIND FIRST Benutzer NO-LOCK                                                             */
+/*                        WHERE Benutzer.Firma    = ttInput.mandant                                           */
+/*                        AND   Benutzer.Benutzer = ttInput.benutzer NO-ERROR.                                */
+/*                END.                                                                                        */
+/*                IF NOT AVAILABLE (Benutzer) THEN                                                            */
+/*                DO:                                                                                         */
+/*                    outilitiesHandler:getErrorMessage(INPUT '1990', INPUT 1, INPUT '', OUTPUT lcJsonString).*/
+/*                                                                                                            */
+/*                    oResponse = NEW OpenEdge.Web.WebResponse().                                             */
+/*                    oResponse:StatusCode  = INTEGER(StatusCodeEnum:OK).                                     */
+/*                    oResponse:ContentType = "application/json;charset=utf-8".                               */
+/*                    oWriter = NEW WebResponseWriter(oResponse).                                             */
+/*                    oWriter:Open().                                                                         */
+/*                    MESSAGE 'lcString Rückgabe: ' + STRING(lcJsonString) VIEW-AS ALERT-BOX.                 */
+/*                    oWriter:Write(lcJsonString).                                                            */
+/*                    oWriter:Close().                                                                        */
+/*                    RETURN -1.                                                                              */
+/*                END.                                                                                        */
+/*                                                                                                            */
+/*                ttInput.action = 'return'.                                                                  */
+/*                ttInput.link   = 'gemis_start.html'.                                                        */
+/*                ttInput.sprcd  = STRING(Benutzer.Sprcd).                                                    */
+/*                                                                                                            */
+/*                lcJsonString = ''.                                                                          */
+/*                DO ii = 1 TO hbttInput:NUM-FIELDS:                                                          */
+/*                    lcJsonString = lcJsonString                                                             */
+/*                        + (IF lcJsonString = '' THEN '' ELSE ', ')                                          */
+/*                        + QUOTER(hbttInput:BUFFER-FIELD(ii):NAME)                                           */
+/*                        + ': '                                                                              */
+/*                        + QUOTER(hbttInput:BUFFER-FIELD(ii):BUFFER-VALUE).                                  */
+/*                END.                                                                                        */
+/*                lcJsonString = CHR(123) + lcJsonString + chr(125).                                          */
+/*                MESSAGE 'Return-Daten nach füllen aus ttInput ' STRING(lcJsonString).                       */
+/*            END.                                                                                            */
+/*            LEAVE.                                                                                          */
+/*        END.                                                                                                */
+
+        oResponse = NEW OpenEdge.Web.WebResponse().
+        oResponse:StatusCode = INTEGER(StatusCodeEnum:OK).
+        oResponse:ContentType = "plain/text;charset=utf-8".
+        oWriter = NEW WebResponseWriter(oResponse).
+        oWriter:Open().
+        MESSAGE 'POST is working' + STRING(lcJsonString) VIEW-AS ALERT-BOX.
+        oWriter:Write('POST is working').
+        oWriter:Close().
+
+        MESSAGE "Exiting HandlePost" VIEW-AS ALERT-BOX.
+
+        CATCH e AS Progress.Lang.Error:
+            MESSAGE "Exception occurred: " + e:GetMessage(1) VIEW-AS ALERT-BOX ERROR BUTTONS OK.
+            RETURN -1.
+        END CATCH.
+        
+    END METHOD.
+
+    METHOD OVERRIDE PROTECTED INTEGER HandleNotAllowedMethod(INPUT poRequest AS IWebRequest):
+        DEFINE VARIABLE result AS INTEGER NO-UNDO.
+        MESSAGE "HandleNotAllowedMethod called" VIEW-AS ALERT-BOX.
+        RETURN result.
+    END METHOD.
+
+    METHOD OVERRIDE PROTECTED INTEGER HandleNotImplemented(INPUT poRequest AS IWebRequest):
+        DEFINE VARIABLE result AS INTEGER NO-UNDO.
+        MESSAGE "HandleNotImplemented called" VIEW-AS ALERT-BOX.
+        RETURN result.
+    END METHOD.
+
+END CLASS.