Altium Designer脚本系统数据提取
Altium Designer脚本系统中自带的接口信息在安装目录下的ScriptingSystem.dll文件中，此文件的功能类似于VBA软件的类型库(OLE Type library)文件，里面包括当前版本脚本系统支持的接口、接口成员、常数、类型等信息，Altium Designer并没有介绍此文件如何打开，如何获取此文件中的全部接口信息。使用二进制文件查看工具，发现在脚本系统中的接口都是可以直接找到，接口名称信息是保存在此文件中的。
此文件为二进制文件，先使用二进制文件查看工具打开ScriptingSystem.dll文件，搜索ISch_Port等字符串，在接口名称字符串的字符间是连续的，其他的接口名称也可使用相同的方式进行查找。
如果要将此二进制文件中的全部接口名称提取出来，直接提取是不方便的，脚本系统对于读取和处理二进制文件支持性不太好，就需要将二进制信息转换成ASCII字符信息，再将得到的ASCII字符信息中非可见字符信息删除，即可得到全部的连续的单词字符串，这些字符串信息是包括接口、成员函数、属性、方法、常数等信息。将全部文本复制到脚本文件中，接口名称的颜色自动变成灰色，可将全部的接口提取出来。
参考程序如下，由于ScriptingSystem.dll文件大小为16M，转换成ASCII字符串为32M，在Altium Designer脚本中处理32M文件时，直接将32M的数据作为一个字符串进行处理，处理的时间大于24h，非常耗时。在程序中将32M文件，分割成2000个文件，这样一个文件的大小只有17KB，这样处理起来就块多了，由于生成的文件较多会多次读写硬盘，将内存虚拟成一个磁盘，将程序文件和ScriptingSystem.dll文件复制进虚拟磁盘中，这样就提升程序的执行效率，可在50秒左右执行完毕。
程序编写花费2周时间，程序优化花费2周，对于其他对于大文件的字符串文件处理也可参考此方法，将一个大文件分割成若干个小文件，可以极大的提高程序的执行效率。
Option Explicit
Call Main()
Sub Main()
Dim MilliSeconds_Start
Dim MilliSeconds_End
Dim Str_List_Temp
Dim Str_List_New
Dim Str_Temp
Dim Str_New
Dim Str_Folder_Path
Dim Str_File_Path
Dim Num_Length
Dim I
Dim Str_Temp1
Str_New = ""
Const Num_File_Count = 2000'拆分文件数量
MilliSeconds_Start = GetMilliSecondTime'
Str_Folder_Path = CreateObject("Scripting.FileSystemObject").GetParentFolderName(Client.CurrentView.OwnerDocument.FileName)
Str_Folder_Path = CreateObject("Scripting.FileSystemObject").GetParentFolderName(Str_Folder_Path)
Str_File_Path = Str_Folder_Path & "\新建文件夹\ScriptingSystem.dll"
If FileExists(Str_File_Path) Then
Set Str_List_Temp = TStringList.Create
Set Str_List_New = TStringList.Create
Str_Temp = ReadBinary(Str_File_Path)
Str_List_Temp.Text = Str_Temp
Str_List_Temp.SaveToFile(Str_Folder_Path & "\ScriptingSystem.txt")
Str_List_Temp.Text =""
Num_Length = Len(Str_Temp)/2
For I = 0 To (Num_File_Count-1)'对数据进行拆分成多个文件,确保每个文件均为双字节
If I<>(Num_File_Count-1) Then
Str_Temp1 = Mid(Str_Temp,Num_Length/Num_File_Count*2*I+1,Num_Length/Num_File_Count*2)
Str_List_Temp.Text = Str_Temp1
Str_List_Temp.SaveToFile(Str_Folder_Path & "\ScriptingSystem_" & CStr(I) & ".txt")
Else
Str_Temp1 = Mid(Str_Temp,Num_Length/Num_File_Count*2*I+1, Len(Str_Temp)-Num_Length/Num_File_Count*2*I+1)
Str_List_Temp.Text = Str_Temp1
Str_List_Temp.SaveToFile(Str_Folder_Path & "\ScriptingSystem_" & CStr(I) & ".txt")
End If
Next
For I = 0 To (Num_File_Count-1)'处理单个文件
Str_File_Path = Str_Folder_Path & "\ScriptingSystem_" & CStr(I) & ".txt"
If FileExists(Str_File_Path) Then
Call Deal_Single_File(Str_File_Path)
Else
MsgBox "单个文件不存在"
End If
Next
For I = 0 To (Num_File_Count-1)'将单个文件组合到一个文件中
Str_File_Path = Str_Folder_Path & "\ScriptingSystem_" & CStr(I) & ".txt"
If FileExists(Str_File_Path) Then
Str_List_Temp.LoadFromFile(Str_File_Path)
Str_List_New.Add(Str_List_Temp.Text)
Call Delete_File(Str_File_Path)'删除文件
Else
MsgBox "单个文件不存在"
End If
Next
Str_File_Path = Str_Folder_Path & "\ScriptingSystem.txt"
Call Delete_File(Str_File_Path)'删除文件
Str_List_New.Text = Str_List_Sorted(Str_List_New.Text)
Str_List_New.SaveToFile(Str_Folder_Path & "\ScriptingSystem_Text.txt")
MilliSeconds_End = GetMilliSecondTime
MsgBox "花费的时间为：" & formatnumber((MilliSeconds_End - MilliSeconds_Start)/1000,2) & "秒" '显示运行的秒数
Else
MsgBox "文件不存在"
End If
End Sub
Sub Delete_File(Str_File_Path)
If FileExists(Str_File_Path) Then'如果文件存在
DeleteFile(Str_File_Path)
End If
End Sub
'对单个文件进行处理
Sub Deal_Single_File(Str_File_Path)
Dim Str_List_Temp
Dim Str_List_New
Dim I
Dim Str_Temp
Dim Count
Dim Num_Length
Dim Num_Temp
Dim Str_New
Dim GUIMan
Set GUIMan = Client.GUIManager
If FileExists(Str_File_Path) Then
Set Str_List_Temp = TStringList.Create
Set Str_List_New = TStringList.Create
Str_List_Temp.LoadFromFile(Str_File_Path)
Str_Temp = Str_List_Temp.Text
Str_Temp = Replace(Str_Temp,vbCrLf,"")
Num_Length = Len(Str_Temp)/2
For I = 1 To Num_Length
Num_Temp = CLng("&H"& Mid(Str_Temp,I*2-1,2))
If (Num_Temp<=126 And Num_Temp=>32) Then
Str_New = Str_New & Chr(Num_Temp)
Else
Str_New = Str_New & vbCrLf
End If
' If (I Mod 1000 = 0) Then
' Call GUIMan.StatusBar_SetState(1,Str_File_Path & " " & CStr(formatnumber((I+1)/Num_Length,4)*100) & "%")
' Call GUIMan.UpdateInterfaceState
' End If
Next
Call GUIMan.StatusBar_SetState(1,Str_File_Path)
Call GUIMan.UpdateInterfaceState
Str_New = Replace(Str_New," ",vbCrLf)
Str_New = Replace(Str_New,"!",vbCrLf)
Str_New = Replace(Str_New,"""",vbCrLf)
Str_New = Replace(Str_New,"#",vbCrLf)
Str_New = Replace(Str_New,"$",vbCrLf)
Str_New = Replace(Str_New,"%",vbCrLf)
Str_New = Replace(Str_New,"&",vbCrLf)
Str_New = Replace(Str_New,"'",vbCrLf)
Str_New = Replace(Str_New,"(",vbCrLf)
Str_New = Replace(Str_New,")",vbCrLf)
Str_New = Replace(Str_New,"*",vbCrLf)
Str_New = Replace(Str_New,"+",vbCrLf)
Str_New = Replace(Str_New,",",vbCrLf)
Str_New = Replace(Str_New,"-",vbCrLf)
Str_New = Replace(Str_New,".",vbCrLf)
Str_New = Replace(Str_New,"/",vbCrLf)
Str_New = Replace(Str_New,":",vbCrLf)
Str_New = Replace(Str_New,";",vbCrLf)
Str_New = Replace(Str_New,"<",vbCrLf)
Str_New = Replace(Str_New,"=",vbCrLf)
Str_New = Replace(Str_New,">",vbCrLf)
Str_New = Replace(Str_New,"?",vbCrLf)
Str_New = Replace(Str_New,"@",vbCrLf)
Str_New = Replace(Str_New,"[",vbCrLf)
Str_New = Replace(Str_New,"\",vbCrLf)
Str_New = Replace(Str_New,"]",vbCrLf)
Str_New = Replace(Str_New,"^",vbCrLf)
'Str_New = Replace(Str_New,"_",vbCrLf)'
Str_New = Replace(Str_New,"`",vbCrLf)
Str_New = Replace(Str_New,"{",vbCrLf)
Str_New = Replace(Str_New,"|",vbCrLf)
Str_New = Replace(Str_New,"}",vbCrLf)
Str_New = Replace(Str_New,"~",vbCrLf)
'Str_New = Replace(Str_New,"_",vbCrLf)'
Str_New = Replace(Str_New,"0",vbCrLf)
Str_New = Replace(Str_New,"1",vbCrLf)
Str_New = Replace(Str_New,"2",vbCrLf)
Str_New = Replace(Str_New,"3",vbCrLf)
Str_New = Replace(Str_New,"4",vbCrLf)
Str_New = Replace(Str_New,"5",vbCrLf)
Str_New = Replace(Str_New,"6",vbCrLf)
Str_New = Replace(Str_New,"7",vbCrLf)
Str_New = Replace(Str_New,"8",vbCrLf)
Str_New = Replace(Str_New,"9",vbCrLf)
Str_List_New.Text = Str_New
Str_List_New.Text = Str_List_Sorted(Str_List_New.Text)
'删除数字
Count = Str_List_New.Count
For I = 0 To Count-1
If IsNumeric(Str_List_New.Strings(I)) Then
Str_List_New.Strings(I) = ""
End If
Next
Str_List_New.SaveToFile(Str_File_Path)
Else
MsgBox "文件不存在"
End If
End Sub
Function ReadBinary(FileName)
Const adTypeBinary = 1
Dim stream, xmldom, node
Set xmldom = CreateObject("Microsoft.XMLDOM")
Set node = xmldom.CreateElement("binary")
node.DataType = "bin.hex"
Set stream = CreateObject("ADODB.Stream")
stream.Type = adTypeBinary
stream.Open
stream.LoadFromFile FileName
node.NodeTypedValue = stream.Read
stream.Close
Set stream = Nothing
ReadBinary = node.Text
Set node = Nothing
Set xmldom = Nothing
End Function
'对字符串进行排序
'如果第一个字符串为空字符串，删去第一行
Function Str_List_Sorted(Str_List_Temp)
Dim Str_List_Sort
Set Str_List_Sort = TStringList.Create
Str_List_Sort.Sorted = True
Str_List_Sort.Text = Str_List_Temp
Str_List_Sort.Sorted = False
If Str_List_Sort.Count>0 Then
If Str_List_Sort.Strings(0) = "" Then
Str_List_Sort.Delete(0)
End If
End If
Str_List_Sorted = Str_List_Sort.Text
End Function
