- UID
- 5
- 积分
- 2526
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2002-1-3
- 最后登录
- 1970-1-1
|
发表于 2003-2-23 10:30:15
|
显示全部楼层
这是前帖的反安装程序。反向代码。XD工具箱卸载时执行的代码。

- [FONT=courier new]
- Option Explicit
- ' 这个函数split是为win98的wscript host 1.0定义的,2.0以上的版本vbs中含有这个标准函数
- ' 来自明经通道, 修改成vbscript版本
- Function Split(Str, Delim)
- Dim tokens(), pos, i
- pos = InStr(1, Str, Delim, vbTextCompare)
- i = 0
- Do While pos > 0
- ReDim Preserve tokens(i)
- tokens(i) = Mid(Str, 1, pos - 1)
- If tokens(i) = Delim Then tokens(i) = ""
- Str = Mid(Str, pos + Len(Delim))
- i = i + 1
- pos = InStr(1, Str, Delim, vbTextCompare)
- Loop
- If Len(Str) > 0 Then
- ReDim Preserve tokens(i)
- tokens(i) = Str
- End If
- Split = tokens
- End Function
- Const AcadID = "AutoCAD.Application.15"
- Dim AcadApp, AcadPrefiles, AcadDoc, FSO, CurrentDir
- Dim AcadWorking, AcadSearchPath, PathArray, TempStr, XDMenuGroup
- ' ----------------------------------------Start AutoCAD
- On Error Resume Next 'Track Error
- AcadWorking = true
- Set AcadApp = GetObject(,AcadID)
- If Err Then
- Err.Clear
- Set AcadApp = CreateObject(AcadID)
- If Err Then ' 当前的autocad版本没装
- WScript.Quit()
- End If
- AcadApp.visible = false
- AcadApp.WindowState = 2
- AcadWorking = false
- End If
- On Error Goto 0 ' Clear Error Track
- ' -----------------------------------------AutoCAD Launched
- Set AcadPrefiles = AcadApp.Preferences.Files
- Set AcadDoc = AcadApp.ActiveDocument
- Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
- CurrentDir = FSO.GetParentFolderName(WScript.scriptFullName)
- CurrentDir = FSO.GetParentFolderName(CurrentDir)
- AcadSearchPath = AcadPrefiles.SupportPath
- PathArray = Split(AcadSearchPath, ";")
- ' AcadApp.ActiveDocument.SendCommand "(load ""XDUnLoadMenu"")" & vbCr
- On Error Resume Next
- Set XDMenuGroup = AcadApp.MenuGroups.item("XDSoft")
- if not Err then XDMenuGroup.Unload
- AcadApp.UnloadARX("xdrx_api15.arx")
- On Error Goto 0
- AcadSearchPath = ""
- For Each TempStr In PathArray
- If (UCase(TempStr)<>UCase(CurrentDir)) And _
- (UCase(TempStr)<>UCase(CurrentDir & "\LISP")) And _
- (UCase(TempStr)<>UCase(CurrentDir & "\BIN")) And _
- (UCase(TempStr)<>UCase(CurrentDir & "\LIB")) And _
- (UCase(TempStr)<>UCase(CurrentDir & "\SYS")) Then
- If AcadSearchPath = "" Then
- AcadSearchPath = TempStr
- Else
- AcadSearchPath = AcadSearchPath & ";" & TempStr
- End If
- End If
- Next
- AcadPrefiles.SupportPath = AcadSearchPath
- if not AcadWorking Then
- AcadApp.quit
- End if
- [/FONT]
|
|