[求助]自动删除代码注释？

wang1999

自动删除代码注释？

我想用一个函数，功能是全部删除MDB文件中所有代码中注释。

记得半年前有看到关于［自动删除代码注释］讨论，当时不屑一顾，认为不实用，没搭理。想不到今天却要用到！

请大家帮忙提供这方面的代码。谢谢！

hi-wzj

没必要，因为程序编译成mde时注释并不被编译进去，没有影响的。

wang1999

我太将了还是自己做了一个!

wang1999

Sub Test1()

    Dim obj As Object, mdl As Object, i As Integer

    Debug.Print Application.Modules.Count

    For i = 0 To Application.Modules.Count - 1

        Debug.Print Application.Modules(i).Name

        DelComment Application.Modules(i).Name

    Next

End Sub

Sub DelComment(ModuleName As String)

    Dim intS1 As Integer, intS2 As Integer

    Dim i As Integer, j As Integer

    Dim ReVal As String, strLine As String

    For j = Modules(ModuleName).CountOfLines To 1 Step -1

        intS1 = 0: intS2 = 0

        strLine = Modules(ModuleName).Lines(j, 1)

        If IsEmptyString(strLine) Or Left(LTrim(strLine), 1) = "'" Then

            Modules(ModuleName).DeleteLines j, 1

        Else

            For i = 1 To Len(strLine)

                ReVal = Mid(strLine, i, 1)

                If ReVal = """" Then

                    intS2 = intS2 + 1

                    intS1 = False

                ElseIf ReVal = "'" Then

                    intS1 = True

                End If

                If ((intS2 / 2) - (intS2 \ 2) = 0) Or intS2 = 0 Then

                    If intS1 = True Then

                        Do Until i = Len(strLine) + 1

                            Mid(strLine, i) = " "

                            i = i + 1

                        Loop

                        Modules(ModuleName).ReplaceLine j, strLine

                        Exit For

                    End If

                End If

            Next

        End If

    Next j

End Sub

wang1999

今天搞了一下午,钻进了死胡同,搞老半天,搞了两个类似的,这个最好了.运行了一下,把我四十三个模块,全部都一毛没有!没有任何问题!看看上面的,我不小心,也都扫了,又需要重写注释了所以在运行前一定要作好备份工作.

wang1999

刚少了一个函数,补上,大家试试Public Function IsEmptyString(CharacterString As String) As Boolean

    Dim blnEmpty As Boolean, i As Integer

    If CharacterString = "" Then

        blnEmpty = True

    Else

        For i = 1 To Len(CharacterString)

            If Mid(CharacterString, i, 1) = " " Then

                blnEmpty = True

            Else

                blnEmpty = False

                Exit For

            End If

        Next

    End If

    IsEmptyString = blnEmpty

End Function

zipgirl

好方法！不知可直接用MODULES的FIND、DELETE方法吗？[em01]

wang1999

可惜MODULE对象中没有提供这两个方法由于前次不小心全部把注释删除了，前几天全部重新补上，好惨呀！所以在删除工程中所有代码时，我特加入了两条提示信息，以防再次误删！编写目的：其实大家在平时没有必要删除注释，只我因为太喜欢注释，一般一半代码中都有一半的注释，因为前次我帮做经销商的老弟写了半年多的数据库完成了，发现库文件比较大，前台文件经过ACCESS自身压缩后就有4M多，压缩后也有1M多，只因为我老弟还用老猫上网，速度太慢，所以才萌生将注释全部删除，减少体积。其实，删除所有注释后，数据大小也没变多少，目的也没有达到多少！（因为文本文件经过压缩后本身就非常非常小的）这里重新贴出注释好的代码，只供大家作学习参考（因为注释太重要了，平时最好不用这个）'--------------------------------------------------

'Purpose:   删除当前工程中所有模块中的注释

'Information:

'       修改:   王林    2004/10/12      说明:

Private Sub DelAllModulesCodeComent()

    Dim Reval As Integer, i As Integer

    Reval = MsgBox("在删除当前工程中所有注释前，请一定先备份好你的数据库，否则执行删除注释后，是不可恢复的！" & vbNewLine & _

                   "您确认要删除所有注释吗？", vbInformation + vbOKCancel + vbDefaultButton2, C_MessageTitle)

    If Reval = vbOK Then

        Reval = MsgBox("再次提醒：执行删除注释后，是不可恢复的！请确认已经备份好你的数据库！" & vbNewLine & _

                       "您继续执行删除所有的注释吗？", vbInformation + vbOKCancel + vbDefaultButton2, C_MessageTitle)

        If Reval = vbOK Then

            For i = 0 To Application.Modules.Count - 1

                DelComment Application.Modules(i).Name

            Next

        End If

    End If

End Sub'----------------------------------------------------------------------------------------------------

'Function:  DelCodeComment           --中文名 删除代码注释

'Purpose:   将指定模块中的代码注释全部删除掉

'Input:     输入参数

'       [in]    ModuleName            -- 标准模块或类模块的名称

'Output:    None

'Content:   None

'Information:

'       编写:   王林    2004/10/07      说明:

'       修改:   王林    2004/10/10      说明:补上之前被删除的注册

'----------------------------------------------------------------------------------------------------

Public Function DelCodeComment(ModuleName As String)

    Dim blnS1 As Integer, intS2 As Boolean          '[intS2]一行代码中["]字符的数量

    Dim i As Integer, j As Integer

    Dim Reval As String, strLine As String

    For j = Modules(ModuleName).CountOfLines To 1 Step -1

        blnS1 = 0: intS2 = 0                        '新行中复位值

        strLine = Modules(ModuleName).Lines(j, 1)

        If IsEmptyString(strLine) Or Left(LTrim(strLine), 1) = "'" Then    '当前行如为[']开头或者全为空字符串，则直接删除行

            Modules(ModuleName).DeleteLines j, 1

        Else

            For i = 1 To Len(strLine)

                Reval = Mid(strLine, i, 1)

                If Reval = """" Then                '当出现["]字符时，表示当前行之前的[']不为注释符

                    intS2 = intS2 + 1

                    blnS1 = False

                ElseIf Reval = "'" Then             '当出现[']字符时，表示为代码注释的开始

                    blnS1 = True

                    '当[intS2]为双数时，[blnS1]以为True 表示是注释的开始；否则不是注释的开始

                    If ((intS2 / 2) - (intS2 \ 2) = 0) Or intS2 = 0 Then

                        Do Until i = Len(strLine) + 1                       '用空字符串填充，注释行后的字符串

                            Mid(strLine, i) = "1 "

                            i = i + 1

                        Loop                        '用不注释新行替换，替换含有注释的当前行

                        Modules(ModuleName).ReplaceLine j, strLine

                        Exit For

                    End If

                End If

            Next

        End If

    Next j

End Function'--------------------------------------------------

'Function:  IsEmptyString           --中文名

'Purpose:   检查字符串值是否全部都是空字符串

'Input:     输入参数

'       [in]    CharacterString            -- 要检查的字符串值

'Output:    IsEmptyString

zipgirl

非也,提供了,不过那个DELETE 应该是DELETELINES(好象是这样)不过对所有MODULE操作的话可能要用到APPLICATION.CURRENTPROJECT.ALLMODULES吧set mdl=modules(mdlname)mdl.find strsearch,startlines,startrows,endlines,endrows  返回的可是strsearch(尤其是"'"这样的符号)的开始行列与结束行列号耶,这么详细还不能操作吗??(英语不好,可能你也看得懂)我想了一下,用FOR I=1 TO  COUNTOFLINES循环应该可对整个MDL内容进行操作吧,你说呢?顺便对那个检测是否为空字符串的函数想了一个函数,很好的,给你看看DIM I AS LONG,X() AS BYTEIsEmptyString=FALSE'先默认为假FOR I=1 TO UBOUND(STRCONV(YOURSTR,VBFROMUNICODE))IF M(I)<>SPACE的CODE(你去查一下吧) THEN   IsEmptyString=TRUE'发现非空字符则为真  EXIT FUNCTIONEND IF试试看?挺好的

zipgirl

在单位那台电脑上我写过一个FNDRPLC(查找与替换)函数,运行通过.过天记得的话 & 找得到的话,给你看看,代码不长