[CDR 2017-2021] YinkaMacs: Collection of CorelDraw Macro Tools 2019

[_MBK_]

подозреваю что для вынимания превьюшек в модуле Recent Files

Ну в приведенном мною месте просто версия CDR определяется

 

[dastin]

лог установки
Create folder: C:\Documents and Settings\***\Start Menu\Programs\YinkaMacs
Create shortcut: C:\Documents and Settings\***\Start Menu\Programs\YinkaMacs\Uninstall YinkaMacs.lnk
Output folder: C:\Program Files\YinkaMacs
Created uninstaller: C:\Program Files\YinkaMacs\Uninstall YinkaMacs.exe
============== CorelDRAW X5 ====================
Output folder: C:\Documents and Settings\***\Application Data\Corel\CorelDRAW Graphics Suite X5\Draw\GMS
Output folder: C:\Documents and Settings\***\Application Data\Corel\CorelDRAW Graphics Suite X5\Draw\GMS
Extract: YinkaMacs.gms
Extract: 7-zip32.dll
Extract: UNZIPD32.DLL
Extract: Yicon.bmp
Completed


в автозагрузку, реестр ничего больше не прописалось
в описании упоминается, что
The macro collection will load after startup

 

[_MBK_]

Я имею в виду что после установки макроса при каждом запуске корела выполняется некий загадочный код из ThisMacroStorage, открыть который у меня не получилось

 

[dastin]

некий загадочный код из ThisMacroStorage

чувствую что самовар нам скоро начистят ... но опасения стоит развеять всё же ... ничего там военного ИМХО ...

Спойлер: авекплезир

Private Sub GlobalMacroStorage_DocumentAfterSave(ByVal doc As Document, ByVal SaveAs As Boolean, ByVal filename As String)
recentf doc
RemoveDupX doc
End Sub
Private Sub GlobalMacroStorage_DocumentClose(ByVal doc As Document)
If doc.FilePath = "" Then Exit Sub
recentf doc
RemoveDupX doc
End Sub
Private Sub GlobalMacroStorage_DocumentBeforeSave(ByVal doc As Document, ByVal SaveAs As Boolean, ByVal filename As String)
On Error Resume Next
If ActiveWindow Is Nothing Then Exit Sub
If ActiveWindow.ActiveView Is Nothing Then Exit Sub
If doc Is Nothing Then Exit Sub
With ActiveWindow.ActiveView
Dim i&
If Not doc.ActivePage Is Nothing Then i = doc.ActivePage.indeX
doc.Properties("LastView", 0) = i
doc.Properties("LastView", 1) = doc.FromUnits(.OriginX, cdrInch)
doc.Properties("LastView", 2) = doc.FromUnits(.OriginY, cdrInch)
doc.Properties("LastView", 3) = .Zoom
End With
End Sub
Private Sub GlobalMacroStorage_DocumentOpen(ByVal doc As Document, ByVal filename As String)
recentf doc
RemoveDups
DocLastViewLoad doc
End Sub
Private Sub GlobalMacroStorage_Start()
RemoveDups
YinkaMac.YinkaMacs
MacroButton
End Sub
Sub RemoveDupX(doc As Document)
Dim filename As String, MyData As String, MyResult As String, i As Long, MyLines As Variant
Dim Kept As Long, Lost As Long
If doc.FilePath = "" Then Exit Sub
filename = Environ$("appdata") & "\Corel\" & VersionMajor & " History.txt"
If Not FileThere(filename) Then Exit Sub
    Open filename For Input As #1
    MyData = Input(LOF(1), 1)
    Close #1
    MyResult = vbCrLf
    MyLines = Split(MyData, vbCrLf)
    For i = UBound(MyLines) To 0 Step -1
        If InStr(1, MyResult, vbCrLf & MyLines(i) & vbCrLf, vbTextCompare) = 0 And MyLines(i) <> "" Then
            MyResult = vbCrLf & MyLines(i) & MyResult
            Kept = Kept + 1
        Else
            Lost = Lost + 1
        End If
    Next i
Open filename For Output As #1
MyResult = Replace(Replace(Trim(Replace(Replace(MyResult, " ", "@"), vbCrLf, " ")), " ", vbCrLf), "@", " ")
Print #1, MyResult
Close #1
End Sub
Private Sub RemoveDups()
Dim filename As String, MyData As String, MyResult As String, i As Long, MyLines As Variant, doc As Document
Dim Kept As Long, Lost As Long
filename = Environ$("appdata") & "\Corel\" & VersionMajor & " History.txt"
If Not FileThere(filename) Then Exit Sub
    Open filename For Input As #1
    MyData = Input(LOF(1), 1)
    Close #1
    MyResult = vbCrLf
    MyLines = Split(MyData, vbCrLf)
    For i = UBound(MyLines) To 0 Step -1
        If InStr(1, MyResult, vbCrLf & MyLines(i) & vbCrLf, vbTextCompare) = 0 And MyLines(i) <> "" Then
            MyResult = vbCrLf & MyLines(i) & MyResult
            Kept = Kept + 1
        Else
            Lost = Lost + 1
        End If
    Next i
Open filename For Output As #1
MyResult = Replace(Replace(Trim(Replace(Replace(MyResult, " ", "@"), vbCrLf, " ")), " ", vbCrLf), "@", " ")
Print #1, MyResult
Close #1
End Sub
Private Function checkButton() As Boolean
Dim k&
For k = 1 To FrameWork.CommandBars("Standard").Controls.Count
If (FrameWork.CommandBars("Standard").Controls.Item(k).DescriptionText = "Yinka.YinkaMac.YinkaMacs") Or (FrameWork.CommandBars("Standard").Controls.Item(k).DescriptionText = "Yinka's Macros") Then
checkButton = True
Exit Function
End If
Next
checkButton = False
End Function
Private Sub MacroButton()
If Not checkButton Then
With FrameWork.CommandBars("Standard").Controls.AddCustomButton _
("2cc24a3e-fe24-4708-9a74-9c75406eebcd", "Yinka.YinkaMac.YinkaMacs", 70, False)
.SetCustomIcon XFilePath(Application.VBE.VBProjects("Yinka").filename) & "yIcon.bmp"
.ToolTipText = "Yinka's Macros"
.DescriptionText = "Yinka's Macros"
.Caption = "Yinka's Macros"
End With
End If
End Sub

 

[_MBK_]

Это и все? А как у тебя получилось?