Task: Strip block comments








VB: 






Dim t As String 
Dim s() As Byte 
Dim j As Integer 
Dim SourceLength As Integer 
Dim flag As Boolean
Private Sub Block_Comment(sOpBC As String, sClBC As String)
    
    flag = False
    Do While j < SourceLength - 2
        Select Case s(j)
            Case Asc(Left(sOpBC, 1))
                If s(j + 1) = Asc(Right(sOpBC, 1)) Then
                    
                    j = j + 2
                    Block_Comment sOpBC, sClBC
                End If
            Case Asc(Left(sClBC, 1))
                If s(j + 1) = Asc(Right(sClBC, 1)) Then
                    
                    flag = True
                    j = j + 2
                    Exit Do
                End If
                
            Case Else
        End Select
        j = j + 1
    Loop
    If Not flag Then MsgBox "Error, missing close block comment delimeter"
End Sub
Private Sub String_Literal()
    
    flag = False
    Do While j < SourceLength - 2
        If s(j) = Asc("""") Then
            If s(j + 1) = Asc("""") Then
                
                t = t + Chr(s(j))
                j = j + 1
            Else
                
                flag = True
                t = t + Chr(s(j))
                j = j + 1
                Exit Do
            End If
        End If
        t = t + Chr(s(j))
        j = j + 1
    Loop
    If Not flag Then MsgBox "Error, missing closing string delimeter"
End Sub
Private Sub Other_Text(Optional sOpBC As String = "/*", Optional sClBC As String = "*/")
    If Len(sOpBC) <> 2 Then
        MsgBox "Error, open block comment delimeter must be 2" & _
        " characters long, got " & Len(sOpBC) & " characters"
        Exit Sub
    End If
    If Len(sClBC) <> 2 Then
        MsgBox "Error, close block comment delimeter must be 2" & _
        " characters long, got " & Len(sClBC) & " characters"
        Exit Sub
    End If
    Do While j < SourceLength - 1
        Select Case s(j)
            Case Asc(""""):
                t = t + Chr(s(j))
                j = j + 1
                String_Literal
            Case Asc(Left(sOpBC, 1))
                If s(j + 1) = Asc(Right(sOpBC, 1)) Then
                    
                    j = j + 2
                    Block_Comment sOpBC, sClBC
                Else
                    t = t + Chr(s(j))
                    j = j + 1
                End If
            Case Else
                t = t + Chr(s(j))
                j = j + 1
        End Select
    Loop
    If j = SourceLength - 1 Then t = t + Chr(s(j))
End Sub
Public Sub strip_block_comment()
    Dim n As String
    n = n & "/**" & vbCrLf
    n = n & "* Some comments /*NESTED COMMENT*/" & vbCrLf
    n = n & "* longer comments here that we can parse." & vbCrLf
    n = n & "*" & vbCrLf
    n = n & "* Rahoo" & vbCrLf
    n = n & "*/" & vbCrLf
    n = n & "mystring = ""This is the """"/*"""" open comment block mark.""" & vbCrLf
    
    
    
    n = n & "function subroutine() {" & vbCrLf
    n = n & "a = /* inline comment */ b + c ;" & vbCrLf
    n = n & "}" & vbCrLf
    n = n & "/*/ <-- tricky /*NESTED*/ comments */" & vbCrLf
    n = n & "" & vbCrLf
    n = n & "/**" & vbCrLf
    n = n & "* Another comment." & vbCrLf
    n = n & "*/" & vbCrLf
    n = n & "function something() {" & vbCrLf
    n = n & "}"
    s = StrConv(n, vbFromUnicode)
    j = 0
    t = ""
    SourceLength = Len(n)
    Other_Text 
    Debug.Print "Original text:"
    Debug.Print String$(60, "-")
    Debug.Print n & vbCrLf
    Debug.Print "Text after deleting comment blocks, preserving string literals:"
    Debug.Print String$(60, "-")
    Debug.Print t
End Sub



Fortran:       SUBROUTINE UNBLOCK(THIS,THAT)	
Copies from file INF to file OUT, record by record, except skipping null output records.
       CHARACTER*(*) THIS,THAT	
       INTEGER LOTS			
       PARAMETER (LOTS = 6666)		
       CHARACTER*(LOTS) ACARD,ALINE	
       INTEGER LC,LL,L		
       INTEGER L1,L2		
       INTEGER NC,NL		
       LOGICAL BLAH		
       INTEGER MSG,KBD,INF,OUT		
       COMMON /IODEV/MSG,KBD,INF,OUT	
        NC = 0		
        NL = 0		
        BLAH = .FALSE.	
Chug through the input.
   10   READ(INF,11,END = 100) LC,ACARD(1:MIN(LC,LOTS))	
   11   FORMAT (Q,A)		
        NC = NC + 1		
        IF (LC.GT.LOTS) THEN	
          WRITE (MSG,12) NC,LC,LOTS	
   12     FORMAT ("Record ",I0," has length ",I0,"
          LC = LOTS			
        END IF			
Chew through ACARD according to mood.
        LL = 0		
        L2 = 0		
   20   L1 = L2 + 1	
        IF (L1.LE.LC) THEN	
          L2 = L1		
          IF (BLAH) THEN	
   21       IF (L2 + LEN(THAT) - 1 .LE. LC) THEN	
              IF (ACARD(L2:L2 + LEN(THAT) - 1).EQ.THAT) THEN	
                BLAH = .FALSE.		
                L2 = L2 + LEN(THAT) - 1	
                GO TO 20		
              END IF		
              L2 = L2 + 1	
              GO TO 21		
            END IF	
           ELSE		
   22       IF (L2 + LEN(THIS) - 1 .LE. LC) THEN	
              IF (ACARD(L2:L2 + LEN(THIS) - 1).EQ.THIS) THEN	
                BLAH = .TRUE.		
                L = L2 - L1		
                ALINE(LL + 1:LL + L) = ACARD(L1:L2 - 1)	
                LL = LL + L		
                L2 = L2 + LEN(THIS) - 1	
                GO TO 20		
              END IF		
              L2 = L2 + 1	
              GO TO 22		
            END IF	
            L = LC - L1 + 1	
            ALINE(LL + 1:LL + L) = ACARD(L1:LC)	
            LL = LL + L		
          END IF	
        END IF	
Cast forth some output.
        IF (LL.GT.0) THEN	
          WRITE (OUT,23) ALINE(1:LL)	
   23     FORMAT (">",A,"<") 		
          NL = NL + 1			
        END IF        		
        GO TO 10	
Completed.
  100   WRITE (MSG,101) NC,NL	
  101   FORMAT (I0," read, ",I0," written.")
      END       

      PROGRAM TEST
      INTEGER MSG,KBD,INF,OUT
      COMMON /IODEV/MSG,KBD,INF,OUT
      KBD = 5
      MSG = 6
      INF = 10
      OUT = 11
      OPEN (INF,FILE="Source.txt",STATUS="OLD",ACTION="READ")
      OPEN (OUT,FILE="Src.txt",STATUS="REPLACE",ACTION="WRITE")

      CALL UNBLOCK("/*","*/")

      END