在COBOL中查找子字符串的索引

Question

我想要查找一个特定子字符串在一个字符串中出现的位置。 例如，在字符串“green eggs and ham”中查找子字符串“green”应该返回1，但在“green eggs and green ham”中应该返回1和14。 我应该如何做？ 编辑1：更改措辞，使位置从1开始，而不是0。 编辑2：我可以在以下片段中找到第一个实例作为WS-POINTER。

 MOVE 1 TO  WS-POINTER

 UNSTRING WS-STRING(1:WS-STRING-LEN)
  DELIMITED BY LT-MY-DELIMITER
  INTO WS-STRING-GARBAGE                             
  WITH POINTER WS-POINTER
 END-UNSTRING                   

- Thalecress

---

如果你正在寻找一个单独的COBOL动词（语句）来完成这个任务，我认为你可能会很失望。原生的COBOL并不擅长处理子字符串 :-( - NealB

COBOL标准以及语言在过去的多年中已经更新了很多次，但是这样基本的功能却没有被添加进来...让你不禁想知道这些委员会上的人在想什么！ - NoChance

Answer 1

据我所知，COBOL没有用于查找字符串中某个字符串位置的语句，因此需要手动完成。然而，COBOL确实有一种语句可以计算一个字符串在另一个字符串中出现的次数： INSPECT string TALLYING counter FOR ALL search-string

以下是一个在OpenCOBOL中运行的示例程序（请参见OpenCobol.org）：

   IDENTIFICATION DIVISION.
   PROGRAM-ID. OCCURRENCES.

   ENVIRONMENT DIVISION.
   INPUT-OUTPUT SECTION.
   FILE-CONTROL.

   DATA DIVISION.
   FILE SECTION.

   WORKING-STORAGE SECTION.
   01  TEST-STRING-1                    PIC X(30)
       VALUE 'green eggs and ham'.
   01  TEST-STRING-2                    PIC X(30)
       VALUE 'green eggs and green ham'.
   01  TEST-STRING                      PIC X(30).
   01  SEARCH-STRING                    PIC X(05)
       VALUE 'green'.
   01  MATCH-COUNT                      PIC 9.
   01  SEARCH-INDEX                     PIC 99.
   01  MATCH-POSITIONS.
       05  MATCH-POS                    PIC 99 OCCURS 9 TIMES.

   PROCEDURE DIVISION.
   MAIN.
       MOVE TEST-STRING-1 TO TEST-STRING
       PERFORM FIND-MATCHES

       MOVE TEST-STRING-2 TO TEST-STRING
       PERFORM FIND-MATCHES

       STOP RUN
       .

   FIND-MATCHES.
       MOVE ZERO TO MATCH-COUNT 
       INSPECT TEST-STRING TALLYING MATCH-COUNT
           FOR ALL SEARCH-STRING.
       DISPLAY 'FOUND ' MATCH-COUNT ' OCCURRENCE(S) OF '
           SEARCH-STRING ' IN:'
       DISPLAY TEST-STRING
       DISPLAY 'MATCHES FOUND AT POSITIONS: ' WITH NO ADVANCING
       PERFORM VARYING SEARCH-INDEX FROM 1 BY 1
           UNTIL SEARCH-INDEX = 30
           IF TEST-STRING (SEARCH-INDEX:5) = SEARCH-STRING
               DISPLAY SEARCH-INDEX ' ' WITH NO ADVANCING
       END-PERFORM
       DISPLAY ' '
       DISPLAY ' '
       .

- Valdis Grinbergs

---

"UNTIL SEARCH-INDEX = 30" 是不好的。您有一个30字节的字段。一旦达到27，您就会在表格之外查找。我不知道OpenCobol如何“对齐”01s，但是使用IBM Enterprise Cobol和32个字段长度，如果第一个字符的第32个字符为“g”，并且第二个字符的前四个字符为“reen”，则会获得一个“击中”。 - Bill Woodger

Answer 2

MOVE 1 TO  WS-POINTER

UNSTRING WS-STRING(1:WS-STRING-LEN)
 DELIMITED BY LT-MY-DELIMITER
 INTO WS-STRING-GARBAGE                             
 WITH POINTER WS-POINTER
END-UNSTRING  

你询问如何使用上述内容来处理后续字符串。

可以使用两种方式使用 UNSTRING 来获取所需的计数。一种是使用多个接收字段和 COUNT-IN，另一种是使用多次执行 UNSTRING，并每次使用前一个 UNSTRING 的 POINTER 值。

您需要考虑分隔符的长度。但是，最终您将得到“非直观”的代码，每次有人采用该程序时都必须“理解”它。

相反，使用“子字符串”处理 OCCURS DEPENDING ON 或 reference-modification（接受答案中介绍的方法）是一项简单的任务。

您 必须 确保不要“超出字段末尾”，通过在 count + length-of-delimiter = max-length-of-string-to-search 时结束搜索。

- Bill Woodger

Answer 3

你可以在IBM i上使用QCLSCAN

 77  QCLSCAN-SRCHLEN          PIC S9(3)     COMP-3.           
 77  QCLSCAN-STARTPOS         PIC S9(3)     COMP-3.           
 77  QCLSCAN-PATLEN           PIC S9(3)     COMP-3.           
 77  QCLSCAN-XLATE            PIC X(01)     VALUE "0".        
 77  QCLSCAN-TRIM             PIC X(01)     VALUE "0".        
 77  QCLSCAN-WILDCARD         PIC X(01)     VALUE LOW-VALUES. 
 77  QCLSCAN-FOUNDPOS         PIC S9(3)     COMP-3.           
 ...
 ...
     MOVE LENGTH OF WRK-ACCT-NBR TO QCLSCAN-SRCHLEN 
     MOVE     1                  TO QCLSCAN-STARTPOS
     MOVE     9                  TO QCLSCAN-PATLEN  
     MOVE "0"                    TO QCLSCAN-XLATE   
     MOVE "0"                    TO QCLSCAN-TRIM    
     MOVE "?"                    TO QCLSCAN-WILDCARD
     CALL "QCLSCAN" USING  WRK-ACCT-NBR             
                           QCLSCAN-SRCHLEN          
                           QCLSCAN-STARTPOS         
                           EMPLOYEE-SSN-9X          
                           QCLSCAN-PATLEN           
                           QCLSCAN-XLATE            
                           QCLSCAN-TRIM             
                           QCLSCAN-WILDCARD         
                           QCLSCAN-FOUNDPOS         
     IF QCLSCAN-FOUNDPOS > ZERO                     
* Found data in position QCLSCAN-FOUNDPOS
     ELSE
* Found no match
     END-IF

- Dennis