CoderHelper 是怎样实现添加模块信息以及函数说明信息的?
CoderHelper 是怎样实现添加模块信息以及函数说明信息的?
首先,你需要知道,本程序的基本思路!在添加时本程序模仿了ini的读写方式.也救生步说在代码中先定好字段位置,如:"'********************版权信息********************" 就是一个字段.接着,以字段的基础上定位键的位置.那么"'*隶属工程:"就时一个键 后面的字符就时键的值.然后,只要编写好怎样定位.那么.就很简单了!下面是其调用模块中的代码.以下代码实现了向模块中添加信息.而操作代码窗口中的代码的代码将是我所给你的代码:
'********************版权信息********************
'*隶属工程: CoderHelper
'*模块名称: modMark
'*模块描述:
'*成员个数: 2
'*代码行数: 67
'*声明行数: 14
'*创建时间: 2005-8-10 19:24:05(创建人:MysticBoy)
'*修改时间: 2005-8-10 19:37:33(修改人:MysticBoy)
'*代码说明:
'*版权说明: 版权所有(c) ?-2005 Mysticsoft.
'* 保留所有权
'***********************************************
Option Explicit
Public Sub SetCopyRightInfs(ObjVBC As VBComponent)
Dim lc As Long
On Error Resume Next
Dim tmp1x As String
With pjtMark
.ObjVBComponent = ObjVBC
lc = .FindMark("版权信息")
If frmAddIn.cbsALSGC.Value = 1 Then .WriteKey "版权信息", "隶属工程:", MVBI.ActiveVBProject.Name, lc, 1
If frmAddIn.cbsAMKM.Value Then .WriteKey "版权信息", "模块名称:", ObjVBC.Name, lc, 2
tmp1x = .ReadKey("版权信息", "模块描述:", lc)
If tmp1x = "" Then
If frmAddIn.cbsAMKMS.Value = 1 Then .WriteKey "版权信息", "模块描述:", ObjVBC.Description, lc, 3
Else
ObjVBC.Description = tmp1x
If frmAddIn.cbsAMKMS.Value = 1 Then .WriteKey "版权信息", "模块描述:", ObjVBC.Description, lc, 3
End If
If frmAddIn.cbsDMHS.Value = 1 Then
.WriteKey "版权信息", "成员个数:", CStr(ObjVBC.CodeModule.Members.Count), lc, 4
.WriteKey "版权信息", "代码行数:", CStr(ObjVBC.CodeModule.CountOfLines), lc, 5
.WriteKey "版权信息", "声明行数:", CStr(ObjVBC.CodeModule.CountOfDeclarationLines), lc, 6
End If
If .ReadKey("版权信息", "创建时间:", lc) = "" Then
.WriteKey "版权信息", "创建时间:", CStr(Now) + "(创建人:" + UserName + ")", lc, 7
End If
.WriteKey "版权信息", "修改时间:", CStr(Now) + "(修改人:" + UserName + ")", lc, 8
If frmAddIn.cbsADMSM.Value = 1 Then
If .ReadKey("版权信息", "代码说明:", lc) = "" Then
.WriteKey "版权信息", "代码说明:", "", lc, 9
End If
End If
Dim tmptxt As String
tmptxt = frmAddIn.txtABQSM.Text
tmptxt = Replace(tmptxt, "%YEAR", CStr(Year(Now)))
tmptxt = Replace(tmptxt, "&COMPANY", GetCompanyName)
.WriteKey "版权信息", "版权说明:", tmptxt, lc, 10
.WriteKey "版权信息", " 保留所有权 ", "", lc, 11
.WriteKey "版权信息", "**********************************************", "", lc, 12
If frmAddIn.cbsDMHS.Value = 1 Then
.WriteKey "版权信息", "成员个数:", CStr(ObjVBC.CodeModule.Members.Count), lc, 4
.WriteKey "版权信息", "代码行数:", CStr(ObjVBC.CodeModule.CountOfLines), lc, 5
.WriteKey "版权信息", "声明行数:", CStr(ObjVBC.CodeModule.CountOfDeclarationLines), lc, 6
End If
WriteLine "[" + ObjVBC.Name + "]的版权信息已编辑!" + IIf(err.Number <> 0, vbNewLine + "伴随错误:" & err.Number & err.Description + vbNewLine, "") & Now
End With
End Sub
Sub SetCopyrightinfToPjt(Pjt As VBProject)
Dim n As Long
For n = 1 To Pjt.VBComponents.Count
SetCopyRightInfs Pjt.VBComponents(n)
DoEvents
Next n
WriteLine "[" + Pjt.Name + "]内的" & n & "个代码模块版权信息被编辑!" & Now
End Sub
以下代码实现了在一个代码窗口中添加其方法的说明信息.
Option Explicit
Public Sub AddMethodInfs(objCmt As VBComponent)
Dim n As Long
Dim mb As Member
Dim cm As CodeModule
Set cm = objCmt.CodeModule
On Error GoTo errH
For n = 1 To objCmt.CodeModule.Members.Count
Set mb = objCmt.CodeModule.Members(n)
If mb.Type = vbext_mt_Event Or mb.Type = vbext_mt_Method Then
If frmAddIn.cbsMethods(5).Value = 1 And cm.ProcCountLines(mb.Name, vbext_pk_Proc) < frmAddIn.udMethodMixline.Value Then
WriteLine "模块[" + cm.Parent.Name + "]的成员[" + mb.Name + "]有" & cm.ProcCountLines(mb.Name, vbext_pk_Proc) & _
"行代码,小于您限制的" & frmAddIn.udMethodMixline.Value & "行,因此不编写说明信息!", vbRed
Else
AddInfsToMethod mb, cm
WriteLine "模块[" + cm.Parent.Name + "]的成员[" + mb.Name + "]说明信息处理完成!", vbBlue
End If
End If
Next n
errH:
If err.Number <> 0 Then
WriteLine "为模块[" + cm.Parent.Name + "]进行一次性添加说明信息时出现错误:" + vbNewLine + "错误内容:" + err.Description
End If
End Sub
Public Sub AddInfsToMethod(mb As Member, cm As CodeModule)
Dim loc As Long, txtLine As String
Dim txtMark As String
On Error GoTo errH
txtLine = GetProcLine(mb, cm) '找到函数头
If IsAPI(txtLine) = True Then
WriteLine "检测到[" + mb.Name + "]是API,不建议为API编写说明信息.重要API请手动编写!", vbRed
Exit Sub
End If
pjtMark.ObjVBComponent = cm.Parent
txtMark = "成员[" + mb.Name + "]说明信息"
With pjtMark
loc = .FindMark(txtMark)
loc = IIf(loc = 0, GetMbLoc(cm, txtCode:=txtLine), loc) '找到函数头所在位置
'新加条目在这里加
'~~~~~~~~~~~~~~~~
'==================================
.WriteKey txtMark, Left("*****************************************" + _
"************************************************************" + _
"************************************************************", 53 + Len(mb.Name)), "", loc
If frmAddIn.cbsMethods(3).Value = 1 Then
'===============================================
Dim tm3x As String
tm3x = .ReadKey(txtMark, "功能说明:", loc)
If tm3x = "" Then
.WriteKey txtMark, "功能说明:", "", loc
End If
End If
'====================================================
If frmAddIn.cbsMethods(1).Value = 1 Then
Dim pl As String
pl = GetProcLine(mb, cm, True)
Dim xxpp1 As String
Dim xps As String
xps = GetMethodReturn(pl)
xxpp1 = .ReadKey(txtMark, xps, loc)
If Trim(xxpp1) <> "" Then
.WriteKey txtMark, xxpp1, "<在此键入说明>", loc
End If
xps = GetMethodInputs(pl)
xxpp1 = .ReadKey(txtMark, "输入参数:", loc)
If xxpp1 = "" And xps <> "" Then
.WriteKey txtMark, "输入参数:", "参数名称 说明" + GetMethodInputs(pl), loc
End If
End If
'==============================================
If frmAddIn.cbsMethods(2).Value = 1 Then
Dim tm1x As String
tm1x = .ReadKey(txtMark, "成员描述:", loc)
If tm1x = "" Then
tm1x = mb.Description
Else
mb.Description = tm1x
End If
.WriteKey txtMark, "成员描述:", mb.Description, loc
End If
'===================================================
If frmAddIn.cbsMethods(4).Value = 1 Then
Dim tm2x As String
tm2x = .ReadKey(txtMark, "HelpCtID:", loc)
If CInt(tm2x + ".0") = 0 Then
tm2x = mb.HelpContextID
Else
mb.HelpContextID = tm2x
End If
.WriteKey txtMark, "HelpCtID:", mb.HelpContextID, loc
End If
'============================================================
If frmAddIn.cbsMethods(0).Value = 1 Then
.WriteKey txtMark, "成员类型:", GetMethodText(mb), loc
End If
'===================================================
If frmAddIn.cbsMethods(6).Value = 1 Then
.WriteKey txtMark, "代码编辑:", Now & "(" + UserName + ")", loc
End If
End With
errH:
If err.Number <> 0 Then
WriteLine "为模块[" + cm.Parent.Name + "]的成员[" + mb.Name + "]添加说明信息时出现错误:" + vbNewLine + "错误内容:" + err.Description
End If
End Sub
Public Function GetMethodReturn(txtCode As String, Optional txtWith As String = "'* ")
Dim n As Long
If InStr(txtCode, "Sub ") > 0 Then
GetMethodReturn = "函数返回:"
ElseIf InStr(txtCode, "Property Get ") > 0 Then
GetMethodReturn = "属性返回:"
End If
End Function
Function GetMethodInputs(txtCode As String, Optional txtWith As String = "'* ") As String
Dim ary() As String, xx1
Dim txt1 As String
Dim ret As String
Dim tmp1 As String
On Error GoTo errH
txt1 = Mid(txtCode, InStr(txtCode, "(") + 1)
txt1 = Mid(txt1 + " ", 1, InStr(txt1, ")") - 1)
ary = Split(txt1, ",")
'
For Each xx1 In ary
xx1 = Trim(xx1)
xx1 = Replace(xx1, "ByVal ", "")
xx1 = Replace(xx1, "ByRef ", "")
tmp1 = Left(xx1, InStr(xx1, " "))
If xx1 <> "" And tmp1 = "" Then
tmp1 = xx1
End If
If tmp1 = "Optional " Then
tmp1 = Trim(Right(xx1, Len(xx1) - Len(tmp1)))
tmp1 = Left(tmp1, InStr(tmp1, " ")) + "[此参数可选]"
End If
tmp1 = vbNewLine + txtWith + tmp1
ret = ret + tmp1
Next
errH:
GetMethodInputs = ret
End Function
Function GetMethodText(mb As Member)
Dim ret As String
On Error GoTo errH
If InStr(mb.Name, "_") > 0 Then
Dim xxs() As String
xxs = Split(mb.Name, "_")
ret = "对象[" + xxs(0) + "]的[" + xxs(1) + "]事件"
ElseIf mb.Type = vbext_mt_Method Then
ret = IIf((mb.Scope = vbext_Friend), "友员方法", IIf((mb.Scope = vbext_Private), "私有方法", "公有方法"))
ElseIf mb.Type = vbext_mt_Property Then
ret = IIf((mb.Scope = vbext_Friend), "友员属性", IIf((mb.Scope = vbext_Private), "私有属性", "公有属性"))
End If
errH:
GetMethodText = ret
End Function
Public Function GetMbLoc(cm As CodeModule, Optional mb As Member, Optional txtCode As String = "") As Long
Dim tmp1 As String, n1 As Long, n2 As Long
On Error GoTo errH
If txtCode = "" Then
tmp1 = GetProcLine(mb, cm)
Else
tmp1 = txtCode
End If
GetMbLoc = IIf(cm.Find(tmp1, n1, n2, n2, n2), n1, 0)
errH:
GetMbLoc = n1
End Function
Function GetProcLine(mb As Member, cm As CodeModule, Optional FullCode As Boolean = False) As String
Dim ary() As String, xx, ok As Boolean
Dim tmp1 As String, n1 As Long, n2 As Long
On Error GoTo errH
tmp1 = cm.Lines(cm.ProcStartLine(mb.Name, vbext_pk_Proc), cm.CountOfLines)
ary = Split(tmp1, vbNewLine)
ok = False
Dim txtmp As String
For Each xx In ary
If ok = False Then
If InStr(xx, "Sub ") > 0 Or InStr(xx, "Function ") > 0 Or InStr(xx, "Property ") > 0 Then
If InStr(xx, mb.Name) > 0 Then
If Right(Trim(xx), 1) = "_" And FullCode = True Then '
ok = True
txtmp = Left(xx, InStr(xx, "_") - 1)
Else
GetProcLine = xx
Exit Function
End If
End If
End If
Else
If Right(Trim(xx), 1) = "_" Then
ok = True
txtmp = txtmp + Left(xx, InStr(xx, "_") - 1)
Else
txtmp = txtmp + xx
GetProcLine = txtmp
Exit Function
End If
End If
Next xx
errH:
End Function
Public Function IsAPI(mbCode As String) As Boolean
'Print IsAPI("Private Declare Function GetVersionEx Lib ""kernel32"" Alias ""GetVersionExA"" (lpVersionInformation As OSVERSIONINFO) As Long")
'True
On Error Resume Next
IsAPI = InStr(mbCode, "Declare ") > 0 And InStr(mbCode, " Lib ") > 0
End Function
INI中有写键的函数,也就有读键的代码.以下是全部代码.您可以做以参考.注意:以下代码是经过调试合格的代码.无须修改即可使用.此代码仅仅在你编写向代码中添加代码的注释信息的程序时使用.代码的调用效率要求非常高的.如果你的读写一个字段.建议在可选参数中直接给字段位置lngLocMark 给你值,这样程序就不再重复调用查找字段的代码.
Option Explicit
Public ObjVBC As VBComponent
Public Sub WriteKey(txtMark As String, txtKey As String, txtValue As String, Optional lngLocMark As Long = 0, Optional KeyIndex As Long = -1)
Dim lc As Long
On Error GoTo errH
Dim txtText As String
txtText = txtValue
Dim lcx As Long
Dim xx1 As Long, xx2 As Long
xx1 = FindMark(txtMark)
lc = IIf(lngLocMark = 0, xx1, lngLocMark)
If lc = 0 Or xx1 = 0 Then
lc = IIf(lc = 0, 1, lc)
ObjVBC.CodeModule.InsertLines lc, "'********************" + txtMark + "********************"
DoEvents
End If
If KeyIndex <= 0 Then
lcx = FindKey(txtMark, txtKey, lc)
Else
If Left(ObjVBC.CodeModule.Lines(lc + KeyIndex, 1), 2) = "'*" Then
lcx = KeyIndex
Else
lcx = FindKey(txtMark, txtKey, lc)
End If
End If
If lcx = 0 Then
KeyIndex = IIf(KeyIndex = -1 Or KeyIndex = 0, 1, KeyIndex)
ObjVBC.CodeModule.InsertLines lc + KeyIndex, "'*" + txtKey + " " + txtValue
Exit Sub
DoEvents
lcx = KeyIndex
End If
Dim xxc As Long
xxc = FindKey(txtMark, txtKey, lc + lcx - 1)
If xxc = 0 Then
lcx = lcx
Else
lcx = xxc
End If
DoEvents
ObjVBC.CodeModule.ReplaceLine lcx, "'*" + txtKey + " " + txtValue
DoEvents
errH:
If err.Number <> 0 Then
End If
End Sub
Public Function ReadKey(txtMark As String, txtKey As String, Optional mklc As Long = 0) As String
Dim lc As Long
If mklc = 0 Then
lc = FindMark(txtMark)
Else
lc = mklc
End If
If lc > 0 Then
lc = FindKey(txtMark, txtKey, lc)
If lc > 0 Then
ReadKey = Trim(Mid(ObjVBC.CodeModule.Lines(lc, 1), Len(txtKey) + 3))
End If
End If
End Function
Public Function KillKey(txtMark, txtKey As String)
ObjVBC.CodeModule.DeleteLines FindKey(txtMark, txtKey), 1
End Function
Public Function KillMark(txtMark As String)
ObjVBC.CodeModule.DeleteLines FindMark(txtMark), 1
End Function
Public Function FindKey(ByVal txtMark As String, txtKey As String, Optional locMark As Long = 0) As Long
Dim n As Long
Dim lc As String
If locMark = 0 Then
lc = FindMark(txtMark)
Else
lc = locMark
End If
Dim txt As String
Do
lc = lc + 1
DoEvents
txt = Trim(ObjVBC.CodeModule.Lines(lc, 1))
If Left(txt, Len(txtKey) + 2) = Trim("'*" + txtKey) Then
FindKey = lc
Exit Function
End If
DoEvents
Loop Until Left(txt, 2) <> "'*"
'FindKey
End Function
Public Function FindMark(ByVal txtMark As String) As Long
Dim n As Long
On Error Resume Next
txtMark = "'********************" + txtMark + "********************"
Dim nx As Long, nx1 As Long, nx2 As Long
ObjVBC.CodeModule.Find txtMark, n, nx, nx1, nx2
FindMark = n
End Function
Public Property Get ObjVBComponent() As VBComponent
Set ObjVBComponent = ObjVBC
End Property
Public Property Let ObjVBComponent(ByVal vNewValue As VBComponent)
Set ObjVBC = vNewValue
End Property
CoderHelper 是怎样实现添加模块信息以及函数说明信息的?相关推荐
- 【信息保护论】信息保护面临的风险与对应的安全策略
上接前文:信息保护与密码学 混合密码Hybrid Cryptosystem 单向哈希函数 抗碰撞特性Collision Resistance 哈希函数发展史 哈希函数面临的攻击 MAC(Message ...
- linux更新模块,Linux下Nginx的安装、升级及动态添加模块
系统基于ubuntu server 14.04.4 amd64 安装 第一步 下载并解压Nginx压缩包 从Nginx官网下载Nginx,或者在Linux上执行wget http://nginx.or ...
- Spring Boot和多模块项目–添加模块特定的属性文件
你好! 在本文中,我将向您展示几种如何在Spring Boot项目中添加模块特定的属性文件的方法. 它将介绍使属性文件可识别配置文件的手动方法以及可识别配置文件的半自动方法. 我的Github帐户上发 ...
- IntelliJ IDEA 如何知道项目中的模块数据_如何从项目源中选择模块加入当前项目中（添加模块）_如何移除项目中的模块（移除模块/删除模块）
文章目录 IDEA 如何获取项目的模块数据 从项目源中选择模块加入当前项目中 如何移除项目中的模块 方式一,选择模块的根目录(Content Root),鼠标右键 Remove 方式二,打开[项目结构 ...
- mysql添加映射模块_iis7.5中让html与shtml一样支持include功能(添加模块映射)
刚开始弄得时候,发现了很多错误,其实很简单,参考shtm原来的设置就可以了 前提条件: ServerSideIncludeModule的安装: 在安装iis的时候选择上该服务("在服务端包含 ...
- Cuyahoga 添加模块
Cuyahoga 国外的开源CMS一般都是基于模块设计的 ,好处是可以随意定制自己的页面和模块,这样在以后的应用中就能够灵活的满足变化的功能需求. 一个模块齐全的CMS如DNN , Rainbow就可 ...
- Android Studio(8)---为新设备添加模块
为新设备添加模块 模块为应用程序的源代码,资源文件和应用程序级别设置提供容器,例如模块级构建文件和Android清单文件.每个模块都可以独立构建,测试和调试. Android Studio使用模块可以 ...
- 会议记录管理系统(4) - 会议记录添加模块
1.会议记录添加模块概述 系统正常登录后,每一个用户都有权利添加新的会议,供本部门成员和其他部门成员阅读浏览. 2.会议记录信息验证技术 向数据库中添加新会议记录时,系统必须保证用户提交的信息不为空. ...
- 向Android系统中添加模块及产品流程
添加Android模块 一.基础知识: (1)在Android系统中,编译都是以模块(而不是文件)作为单位的,每个模块都有一个唯一的名称: (2)为了将模块编译到Android系统中,每个模块都需 ...
- python打开文件报错无效序列_黑马python入门(4)：python基础(序列，异常，操作文件，模块包，日志调试信息)
序列 str声明:test_str="abcedf" 也可以保留字符串里面的格式来 test_str=""" \r\n测试标题 hello world ...
最新文章
- net start mysql 提示：服务名无效 请键入NET HELPING 2185以获得更多的帮助的问题
- javascript:为string类添加三个成员，实现去左，右，及所有空格
- [转]软件保护之注册算法篇
- 优达学城深度学习（之四）——jupyter notebook
- 【caffe】 Check failed: error == cudaSuccess (30 vs. 0) unknown error
- 修改disk驱动监控文件系统的IO特征
- 5.Linux性能诊断 --- 追踪技术
- VMware项目虚拟机IP修改说明
- 点滴记录笔记_持续更新
- 5G网络5G技术初探
- 报错: error in ./node_modules/@vueuse/core/index.mjs
- 机器学习笔记（六）-神经网络：概述
- win10小喇叭出现红叉，解决办法（转）
- 微信防封链接服务器,微信防红防封真的存在吗？
- 单片机叮咚c语言,单片机试验19“叮咚”门铃
- 2023ACP世界大赛-AI时代下，艺术教育者论坛
- 余弦定理和新闻的分类（TF-IDF+余弦相似度）
- 【Java】List集合去重的方式
- 整型数组处理算法（十一）请实现一个函数：线段重叠(性能优化)。[风林火山]
- MySQL使用什么关键字添加唯一约束_MySQL使用____关键字添加唯一约束。