帕斯卡方言是什么?它做了什么?

时间:2012-11-13 14:48:55

标签: progress-4gl openedge

我正在调查混合shell脚本,perl脚本,C代码和一个名为'rekening.p'的好奇文件的混乱。

/*--------------------------------------------------------------------------------
  File:        rekening.p
  Description: Bepalen 868-nummer dossier
  History:     nabn - 16/04/2004 - Citrix Implementatie (verwijderen van copy-fsk)
               jedf - 17/02/2010 - F2009/030 (Aanpassingen voor DBC)
               jedf - 20/12/2010 - F2010/024 (Noor)
               Pefl - 22/02/2012 - F2012/002 Sequence aanpassing + controle
--------------------------------------------------------------------------------*/
/* Parameters */
DEFINE INPUT  PARAMETER iHerv     AS INTEGER    NO-UNDO.
DEFINE INPUT  PARAMETER cParam    AS CHARACTER  NO-UNDO.
DEFINE OUTPUT PARAMETER cDosNr    AS CHARACTER  NO-UNDO.

/* Variabelen */
DEFINE VARIABLE iZetelNr    AS INTEGER   NO-UNDO INIT 0.
DEFINE VARIABLE dDosNr      AS DECIMAL   NO-UNDO.
DEFINE VARIABLE cBron       AS CHARACTER NO-UNDO INIT "":u.
DEFINE VARIABLE cPrefix     AS CHARACTER NO-UNDO INIT "":u.
DEFINE VARIABLE cMailParams AS CHARACTER NO-UNDO INIT "":u EXTENT 20.

DEFINE VARIABLE pvRestIn                AS INTEGER                    NO-UNDO.
DEFINE VARIABLE pvSeqNaamTx             AS CHARACTER                  NO-UNDO.

ASSIGN
  cParam = REPLACE(cParam, ",":u, ";":u)
  cParam = TRIM(cParam)
  cBron  = CAPS(ENTRY(1, cParam, ";":u))
  NO-ERROR.

IF NUM-ENTRIES(cParam, ";":u) >= 2
THEN ASSIGN
  cPrefix = CAPS(ENTRY(2, cParam, ";":u))
  NO-ERROR.

/* Zet sequence naam voor controle. */
CASE cPrefix:
    WHEN "934":u   THEN ASSIGN pvSeqNaamTx = 'seq-banknr-noor':U.
    WHEN "93489":u THEN ASSIGN pvSeqNaamTx = 'seq-banknr-auxircs':U.
    OTHERWISE CASE cBron:
        WHEN "DBC":u THEN .
        OTHERWISE CASE iHerv:
            WHEN 1 THEN ASSIGN pvSeqNaamTx = 'seq-banknr':U.
            WHEN 2 THEN ASSIGN pvSeqNaamTx = 'seq-bankfinnr':U.
            WHEN 3 THEN ASSIGN pvSeqNaamTx = 'seq-banknr':U.
            WHEN 4 THEN ASSIGN pvSeqNaamTx = 'seq-banknr-vd':U.
            WHEN 5 THEN ASSIGN pvSeqNaamTx = 'seq-banknr-cr':U.
            WHEN 6 THEN ASSIGN pvSeqNaamTx = 'seq-cbk':U.
        END CASE.
    END CASE.
END CASE.

IF LENGTH(pvSeqNaamTx) > 0
THEN DO:
  FIND FIRST fsk._sequence NO-LOCK
       WHERE fsk._sequence._Seq-name = pvSeqNaamTx
       NO-ERROR.
  IF  AVAILABLE fsk._sequence
  AND fsk._sequence._Seq-Max  <> ?
  AND fsk._sequence._Cycle-OK  = FALSE
  THEN DO:
    ASSIGN
      pvRestIn = DYNAMIC-CURRENT-VALUE(pvSeqNaamTx, 'fsk':U)
  . /* ff voor de debug. */
      pvRestIn = (fsk._sequence._Seq-Max - DYNAMIC-CURRENT-VALUE(pvSeqNaamTx, 'fsk':U)) / fsk._sequence._Seq-Incr
      .
    IF pvRestIn < 500
    THEN DO:
      ASSIGN
        cMailParams[1] = pvSeqNaamTx
        cMailParams[2] = STRING(pvRestIn)
    .
  RUN programs/RootMail.p
    (INPUT '868':U
    ,INPUT cMailParams
    ).


    END.
  END.
END.

CASE cPrefix:
    WHEN "934":u   THEN ASSIGN cDosNr = "9348":u + STRING(NEXT-VALUE(seq-banknr-noor   , fsk), "999999":u).
    WHEN '93489':U THEN ASSIGN cDosNr = '9348':U + STRING(NEXT-VALUE(seq-banknr-auxircs, fsk), '999999':U).
    OTHERWISE CASE cBron:
        WHEN "DBC":u THEN DO:
            ASSIGN iZetelNr = INTEGER(ENTRY(2, cParam, ";":u)) NO-ERROR.

            /* Waarschuwing sturen via e-mail dat 868-reeks bijna vol is */
            IF   CURRENT-VALUE(seq-banknr-dbc-fr, fsk) >= 49500             /* 868330 - 868334 = Franstalige klanten      */
              OR CURRENT-VALUE(seq-banknr-dbc-nl, fsk) >= 99500 THEN DO:    /* 868335 - 868339 = Nederlandstalige klanten */
                ASSIGN cMailParams[1] = (IF (iZetelNr = 0) THEN "330":u
                                                           ELSE "335":u).
                RUN programs/RootMail.p(INPUT "868":u,
                                        INPUT cMailParams).
            END.

            CASE iZetelNr:
                WHEN 0 THEN ASSIGN cDosNr = "86833":u + STRING(NEXT-VALUE(seq-banknr-dbc-fr, fsk), "99999":u).
                WHEN 1 THEN ASSIGN cDosNr = "86833":u + STRING(NEXT-VALUE(seq-banknr-dbc-nl, fsk), "99999":u).
            END CASE.
        END.
        OTHERWISE CASE iHerv:
            WHEN 1 THEN ASSIGN cDosNr = "8686":u + STRING(NEXT-VALUE(seq-banknr, fsk), "999999":u).
            WHEN 2 THEN ASSIGN cDosNr = "8685":u + STRING(NEXT-VALUE(seq-bankfinnr, fsk), "999999":u).
            WHEN 3 THEN ASSIGN cDosNr = "8686":u + STRING(NEXT-VALUE(seq-banknr, fsk), "999999":u).
            WHEN 4 THEN ASSIGN cDosNr = "8688":u + STRING(NEXT-VALUE(seq-banknr-vd, fsk), "999999":u).
            WHEN 5 THEN ASSIGN cDosNr = "8689":u + STRING(NEXT-VALUE(seq-banknr-cr, fsk), "999999":u).
            WHEN 6 THEN ASSIGN cDosNr = "8687":u + STRING(NEXT-VALUE(seq-cbk, fsk), "999999":u).
        END CASE.
    END CASE.
END CASE.


/* Bepalen controlenummer */
ASSIGN dDosNr = DEC(cDosNr).
DO WHILE dDosNr > 2100000000:
    ASSIGN dDosNr = dDosNr - 970000000.
END.
IF dDosNr MOD 97 = 0
    THEN ASSIGN cDosNr = cDosNr + "97":u.
    ELSE ASSIGN cDosNr = cDosNr + STRING(dDosNr MOD 97, "99":u).

有人知道这是否是某种Pascal方言? 对于额外的积分,它有什么作用?

提前致谢。

2 个答案:

答案 0 :(得分:4)

这是PROGRESS,目前也称为OpenEdge高级商务语言。

另见http://en.wikipedia.org/wiki/OpenEdge_Advanced_Business_Language

答案 1 :(得分:1)

是的,这确实是Progress ABL。

名称rekening.p是荷兰名称,评论也是荷兰语。变量cBron可以解释为cSource(bron = source)。

此计划的主要原因是返回新的发票编号。

它接收2个输入参数,其中包含有关业务/客户的一些信息(noor / auxircs)。根据该信息,正确的序列用于返回下一个(新的)可用号码。

相关问题