Altium Designer腳本系統(tǒng)數(shù)據(jù)提取
? ? ? ? Altium Designer腳本系統(tǒng)中自帶的接口信息在安裝目錄下的ScriptingSystem.dll文件中，此文件的功能類似于VBA軟件的類型庫(OLE?Type library)文件，里面包括當(dāng)前版本腳本系統(tǒng)支持的接口、接口成員、常數(shù)、類型等信息，Altium Designer并沒有介紹此文件如何打開，如何獲取此文件中的全部接口信息。使用二進(jìn)制文件查看工具，發(fā)現(xiàn)在腳本系統(tǒng)中的接口都是可以直接找到，接口名稱信息是保存在此文件中的。
? ? ? ? 此文件為二進(jìn)制文件，先使用二進(jìn)制文件查看工具打開ScriptingSystem.dll文件，搜索ISch_Port等字符串，在接口名稱字符串的字符間是連續(xù)的，其他的接口名稱也可使用相同的方式進(jìn)行查找。
? ? ? ?如果要將此二進(jìn)制文件中的全部接口名稱提取出來，直接提取是不方便的，腳本系統(tǒng)對(duì)于讀取和處理二進(jìn)制文件支持性不太好，就需要將二進(jìn)制信息轉(zhuǎn)換成ASCII字符信息，再將得到的ASCII字符信息中非可見字符信息刪除，即可得到全部的連續(xù)的單詞字符串，這些字符串信息是包括接口、成員函數(shù)、屬性、方法、常數(shù)等信息。將全部文本復(fù)制到腳本文件中，接口名稱的顏色自動(dòng)變成灰色，可將全部的接口提取出來。
? ? ? 參考程序如下，由于ScriptingSystem.dll文件大小為16M，轉(zhuǎn)換成ASCII字符串為32M，在Altium Designer腳本中處理32M文件時(shí)，直接將32M的數(shù)據(jù)作為一個(gè)字符串進(jìn)行處理，處理的時(shí)間大于24h，非常耗時(shí)。在程序中將32M文件，分割成2000個(gè)文件，這樣一個(gè)文件的大小只有17KB，這樣處理起來就塊多了，由于生成的文件較多會(huì)多次讀寫硬盤，將內(nèi)存虛擬成一個(gè)磁盤，將程序文件和ScriptingSystem.dll文件復(fù)制進(jìn)虛擬磁盤中，這樣就提升程序的執(zhí)行效率，可在50秒左右執(zhí)行完畢。
? ? ? 程序編寫花費(fèi)2周時(shí)間，程序優(yōu)化花費(fèi)2周，對(duì)于其他對(duì)于大文件的字符串文件處理也可參考此方法，將一個(gè)大文件分割成若干個(gè)小文件，可以極大的提高程序的執(zhí)行效率。
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'拆分文件數(shù)量
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)'對(duì)數(shù)據(jù)進(jìn)行拆分成多個(gè)文件,確保每個(gè)文件均為雙字節(jié)
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)'處理單個(gè)文件
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 "單個(gè)文件不存在"
End If
Next
For I = 0 To (Num_File_Count-1)'將單個(gè)文件組合到一個(gè)文件中
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 "單個(gè)文件不存在"
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 "花費(fèi)的時(shí)間為：" & formatnumber((MilliSeconds_End - MilliSeconds_Start)/1000,2) & "秒" '顯示運(yùn)行的秒數(shù)
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
'對(duì)單個(gè)文件進(jìn)行處理
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)
'刪除數(shù)字
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
'對(duì)字符串進(jìn)行排序
'如果第一個(gè)字符串為空字符串，刪去第一行
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
