git.psu.edu will be upgraded to 14.4.4 and booted on the latest kernel Thursday 12/9 between 9:00 and 10:00pm. Please let us know if this schedule poses a problem. More information on the git.psu.edu Yammer group.

Commit f8a78923 authored by Rusty Myers's avatar Rusty Myers
Browse files

Updating code to use CFPrefs through TTsSmartPreferences and macoslib.

parent 67917cd3
#tag BuildAutomation Begin BuildStepList Linux Begin BuildProjectStep Build End End Begin BuildStepList Mac OS X Begin IDEScriptBuildStep SaveProject , AppliesTo = 0 DoCommand "SaveFile" End Begin BuildProjectStep Build End Begin IDEScriptBuildStep UnDock , AppliesTo = 0 Dim AppLocation as String = CurrentBuildAppName + ".app" AppLocation = AppLocation.ReplaceAll( " ", "\ " ) AppLocation = CurrentBuildLocation + "/" + AppLocation //@ More cocoa info.plist keys here: // https://developer.apple.com/library/ios/documentation/general/Reference/InfoPlistKeyReference/Articles/CocoaKeys.html Call DoShellCommand("/usr/bin/defaults write " + AppLocation + "/Contents/Info ""LSBackgroundOnly"" -bool ""true""") End Begin IDEScriptBuildStep tarProject , AppliesTo = 0 /// Set Variables dim packageLoc, res, tarname as string tarname = "Idle-Logout.tar.bz2" packageLoc = "/Users/rzm102/Documents/_Programing/Git/IdleLogout/" print "Build Location: "+CurrentBuildLocation 'if CurrentBuildLocation="/Users/rzm102/Documents/_Programing/Git/IdleLogout/Builds\ \-\ psuIdleLogout.rbvcp/OS\ X\ 64\ bit" then ' '// Tar up folder 'res = DoShellCommand _ '("cd "+CurrentBuildLocation+"; /usr/bin/tar -c --exclude='.svn' -vjf "+tarname+" *") 'if res = "" then 'print "Results: "+res 'end '// Delete old tar '// print "rm "+packageLoc+tarname 'res = DoShellCommand _ '("rm "+packageLoc+tarname) ' '// Move tar to luggage folder '// print "mv "+CurrentBuildLocation+"/"+tarname+" "+packageLoc '// res = DoShellCommand _ '("mv "+CurrentBuildLocation+"/"+tarname+" "+packageLoc) ' '// Make package '// res = DoShellCommand _ '("cd "+packageLoc+"; make pkg; open "+packageLoc) '// print res 'else '// print "Not on rusty's mac. Skipping pkg creation" '//print CurrentBuildLocation//print "Build Location: "+CurrentBuildLocation 'end End End Begin BuildStepList Windows Begin BuildProjectStep Build End End #tag EndBuildAutomation
\ No newline at end of file
#tag BuildAutomation Begin BuildStepList Linux Begin BuildProjectStep Build End End Begin BuildStepList Mac OS X Begin IDEScriptBuildStep SaveProject , AppliesTo = 0 DoCommand "SaveFile" End Begin BuildProjectStep Build End Begin IDEScriptBuildStep UnDock , AppliesTo = 0 Dim AppLocation as String = CurrentBuildAppName + ".app" AppLocation = AppLocation.ReplaceAll( " ", "\ " ) AppLocation = CurrentBuildLocation + "/" + AppLocation //@ More cocoa info.plist keys here: // https://developer.apple.com/library/ios/documentation/general/Reference/InfoPlistKeyReference/Articles/CocoaKeys.html Call DoShellCommand("/usr/bin/defaults write " + AppLocation + "/Contents/Info ""LSBackgroundOnly"" -bool ""true""") End Begin IDEScriptBuildStep tarProject , AppliesTo = 0 /// Set Variables dim packageLoc, res, tarname as string tarname = "Idle-Logout.tar.bz2" packageLoc = "/Users/rzm102/Documents/_Programing/Git/IdleLogout/" //print "Build Location: "+CurrentBuildLocation 'if CurrentBuildLocation="/Users/rzm102/Documents/_Programing/Git/IdleLogout/Builds\ \-\ psuIdleLogout.rbvcp/OS\ X\ 64\ bit" then ' '// Tar up folder 'res = DoShellCommand _ '("cd "+CurrentBuildLocation+"; /usr/bin/tar -c --exclude='.svn' -vjf "+tarname+" *") 'if res = "" then 'print "Results: "+res 'end '// Delete old tar '// print "rm "+packageLoc+tarname 'res = DoShellCommand _ '("rm "+packageLoc+tarname) ' '// Move tar to luggage folder '// print "mv "+CurrentBuildLocation+"/"+tarname+" "+packageLoc '// res = DoShellCommand _ '("mv "+CurrentBuildLocation+"/"+tarname+" "+packageLoc) ' '// Make package '// res = DoShellCommand _ '("cd "+packageLoc+"; make pkg; open "+packageLoc) '// print res 'else '// print "Not on rusty's mac. Skipping pkg creation" '//print CurrentBuildLocation//print "Build Location: "+CurrentBuildLocation 'end End End Begin BuildStepList Windows Begin BuildProjectStep Build End End #tag EndBuildAutomation
\ No newline at end of file
......
This diff is collapsed.
#tag Class Protected Class TTsSmartPreferences #tag Method, Flags = &h0 Shared Function AppSupportFolder(appName as String, createIfMissing as Boolean = true) As FolderItem // Return: // nil -> app folder invalid or can't be created // otherwise -> test for .Exists if createIfMissing=false was passed if appName = "" then // App Name must be specified raise new RuntimeException end dim f as FolderItem = SpecialFolder.ApplicationData if f = nil or not f.Exists then break System.DebugLog "Can't locate app data folder" return nil end if f = f.Child(appName) if not f.Exists then if not createIfMissing then return f end f.CreateAsFolder if not f.Exists then break System.DebugLog "Can't create App data folder at: "+f.AbsolutePath return nil end if end if if not f.Directory then break System.DebugLog "App data folder not a dir at: "+f.AbsolutePath return nil end if return f End Function #tag EndMethod #tag Method, Flags = &h21 Private Shared Function arrayFromBoolean(a() as Boolean) As Variant() dim var() as Variant for each v as Variant in a var.Append v next return var End Function #tag EndMethod #tag Method, Flags = &h21 Private Shared Function arrayFromDate(a() as Date) As Variant() dim var() as Variant for each v as Variant in a var.Append v next return var End Function #tag EndMethod #tag Method, Flags = &h21 Private Shared Function arrayFromDouble(a() as Double) As Variant() dim var() as Variant for each v as Variant in a var.Append v next return var End Function #tag EndMethod #tag Method, Flags = &h21 Private Shared Function arrayFromInteger(a() as Integer) As Variant() dim var() as Variant for each v as Variant in a var.Append v next return var End Function #tag EndMethod #tag Method, Flags = &h21 Private Shared Function arrayFromLong(a() as Int64) As Variant() dim var() as Variant for each v as Variant in a var.Append v next return var End Function #tag EndMethod #tag Method, Flags = &h21 Private Shared Function arrayFromObject(a() as Object) As Variant() dim var() as Variant for each v as Variant in a var.Append v next return var End Function #tag EndMethod #tag Method, Flags = &h21 Private Shared Function arrayFromSingle(a() as Single) As Variant() dim var() as Variant for each v as Variant in a var.Append v next return var End Function #tag EndMethod #tag Method, Flags = &h21 Private Shared Function arrayFromString(a() as String) As Variant() dim var() as Variant for each v as Variant in a var.Append v next return var End Function #tag EndMethod #tag Method, Flags = &h21 Private Sub Constructor() // use the other one! End Sub #tag EndMethod #tag Method, Flags = &h0 Sub Constructor(applicationName as String, alwaysUseAppSupportFolder as Boolean = false) mUseAppSupportFolder = not TargetMacOS or alwaysUseAppSupportFolder mAppName = applicationName if mUseAppSupportFolder then mPrefsDict = new Dictionary syncPrefsFile() end End Sub #tag EndMethod #tag Method, Flags = &h1 Protected Sub Destructor() if me.IsDirty then me.Sync end End Sub #tag EndMethod #tag Method, Flags = &h0 Sub Remove(key as String) if mUseAppSupportFolder then if mPrefsDict.HasKey (key) then mPrefsDict.Remove (key) mIsDirty = true end if else #if TargetMacOS CFPreferences.Value(key) = nil #endif end if End Sub #tag EndMethod #tag Method, Flags = &h0 Sub Sync(forced as Boolean = false) if forced or me.IsDirty then if mUseAppSupportFolder then syncPrefsFile() else #if TargetMacOS call CFPreferences.Sync() #endif end if end End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub syncPrefsFile() // This gets used only when mUseAppSupportFolder=true dim f as FolderItem = AppSupportFolder(mAppName, me.IsDirty) if f = nil or not f.Exists then return f = f.Child("Preferences.plist") if me.IsDirty then // write changes to disk if not mPrefsDict.SaveXML (f, true) then break System.DebugLog "Can't save prefs at: "+f.AbsolutePath return else mIsDirty = false end else // read latest state from disk if f.Exists and not mPrefsDict.LoadXML (f) then break System.DebugLog "Can't read prefs at: "+f.AbsolutePath return end end End Sub #tag EndMethod #tag Method, Flags = &h21 Private Function toCFType(v as Variant) As CFType // Throws an UnsupportedFormatException if it contains objects it can't convert dim newv as CFType select case v.Type case v.TypeBoolean newv = CFBoolean.Get(v.BooleanValue) case v.TypeInteger newv = CFNumber(v.Int64Value) case v.TypeDouble, v.TypeSingle newv = CFNumber(v.DoubleValue) case v.TypeString, v.TypeCFStringRef newv = CFString(v.StringValue) case v.TypeObject if v.ObjectValue isA Dictionary then dim d as Dictionary = v dim cfd as new CFMutableDictionary for each key as String in d.Keys dim value as Variant = d.Value(key) cfd.Value(CFString(key)) = toCFType(value) next newv = cfd elseif v.ObjectValue isA CFType then newv = CFType(v.ObjectValue) else raise new UnsupportedFormatException end if else if v.IsArray then // this is ugly - we have to do an individual loop for each possible type of the elems in the array dim ar() as Variant select case v.ArrayElementType case Variant.TypeBoolean ar = arrayFromBoolean (v) case Variant.TypeString ar = arrayFromString (v) case Variant.TypeDate ar = arrayFromDate (v) case Variant.TypeDouble ar = arrayFromDouble (v) case Variant.TypeInteger ar = arrayFromInteger (v) case Variant.TypeLong ar = arrayFromLong (v) case Variant.TypeSingle ar = arrayFromSingle (v) case Variant.TypeObject ar = arrayFromObject (v) end select dim cfa as new CFMutableArray(ar.Ubound+1) for each value as Variant in ar cfa.Append toCFType (value) next newv = cfa else // not supported yet raise new UnsupportedFormatException end if end select return newv Exception exc as RuntimeException break raise new UnsupportedFormatException End Function #tag EndMethod #tag Method, Flags = &h0 Sub Value(key as String, assigns v as Variant) if mUseAppSupportFolder then if not mPrefsDict.HasKey (key) or mPrefsDict.Value (key) <> v then mPrefsDict.Value (key) = v mIsDirty = true end if else #if TargetMacOS dim oldv as CFType = CFType(CFPreferences.Value (key)) dim newv as CFType newv = toCFType (v) if oldv = nil then // value not in prefs yet CFPreferences.Value(key) = CFPropertyList(newv) elseif not (newv.Equals(oldv)) then CFPreferences.Value(key) = CFPropertyList(newv) else // not changed return end if #endif end if End Sub #tag EndMethod #tag Method, Flags = &h0 Function Value(key as String, default as Variant) As Variant if mUseAppSupportFolder then return mPrefsDict.Lookup (key, default) else #if TargetMacOS return CFPreferences.VariantValue (key, default) #endif end End Function #tag EndMethod #tag Method, Flags = &h0 Function ValueAsArray(name as String) As Variant() dim result() as Variant dim v as Variant = me.Value(name, nil) if v = nil then return result elseif v.IsArray then return v else break // wrong type - what now? // let's return nil - the caller must check this! end if End Function #tag EndMethod #tag Method, Flags = &h0 Function ValueAsDict(name as String) As Dictionary dim v as Variant = me.Value(name, nil) if v = nil then return new Dictionary elseif v.Type = Variant.TypeObject and v.ObjectValue isA Dictionary then return v else break // wrong type - what now? // let's return nil - the caller must check this! end if End Function #tag EndMethod #tag Note, Name = About App Preferences for OS X, Windows and Linux It's "smart" because it only writes to CFPreferences if the set value is actually different from the current prefs value, hence avoiding dirtying the prefs unnecessarily. Written by Thomas Tempelmann for the public domain. This is part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag Note, Name = How to use Create one instance of this class and store it in a global variable or in a property of the App class. To create, pass the app's name to the Constructor. That name is used on Windows and Linux to locate the App specific folder in which the "Preferences.plist" file is then created. To access preference values, use the Value() functions. To set a preference: prefs.Value ("EnableSomething") = true To read a preference, you must also pass a default value that's returned if the preference hasn't been set yet: if prefs.Value ("EnableSomething", false) then // the option "EnableSomething" is 'true' ... To add a dictionary to the prefs, do something like this: dim dictValues as new Dictionary dictValues.Value ("a key") = "a value") prefs.Value ("the dictionary") = dictValues You can get the Dictionary back using the Value function just the same: dim dictValues as Dictionary = prefs.Value ("the dictionary") Same goes for Arrays of Strings, Booleans and Integers. Use the Sync function to read the latest values from disk, and write any changes to disk. Call this after you've made changes to preferences, to make sure the changes are saved right away. If you don't call Sync, they get written to disk when your program quits. #tag EndNote #tag Note, Name = Known Issues This class relies on the XMLDictionary module which, in turn, relies on the native Dictionary whose keys are not case-sensitive. As such, existing Preference keys that differ only in case will not be handled properly. #tag EndNote #tag Note, Name = Requirements For Mac OS, the entire "CoreFoundation" module with contained classes needs to be added, available here: https://github.com/macoslib/macoslib/ Also, Keven Ballard's "XMLDictionary" is needed (should be included) #tag EndNote #tag ComputedProperty, Flags = &h0 #tag Getter Get if mUseAppSupportFolder then return mIsDirty else #if TargetMacOS return CFPreferences.Dirty #endif end End Get #tag EndGetter IsDirty As Boolean #tag EndComputedProperty #tag Property, Flags = &h21 #tag Note This is unused on OSX when using CFPreferences, i.e. when mUseAppSupportFolder=false #tag EndNote Private mAppName As String #tag EndProperty #tag Property, Flags = &h21 #tag Note This is unused on OSX when using CFPreferences, i.e. when mUseAppSupportFolder=false #tag EndNote Private mIsDirty As Boolean #tag EndProperty #tag Property, Flags = &h21 #tag Note This is unused on OSX when using CFPreferences, i.e. when mUseAppSupportFolder=false #tag EndNote Private mPrefsDict As Dictionary #tag EndProperty #tag Property, Flags = &h21 Private mUseAppSupportFolder As Boolean #tag EndProperty #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="IsDirty" Group="Behavior" Type="Boolean" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Class #tag EndClass
\ No newline at end of file
This diff is collapsed.
#tag Module Protected Module ATSForFonts #tag Note, Name = About This is part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag Constant, Name = kATSOptionFlagsComposeFontPostScriptName, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kATSOptionFlagsDefault, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Constant, Name = kATSOptionFlagsUseDataFork, Type = Double, Dynamic = False, Default = \"768", Scope = Public #tag EndConstant #tag Constant, Name = kATSOptionFlagsUseDataForkAsResourceFork, Type = Double, Dynamic = False, Default = \"256", Scope = Public #tag EndConstant #tag Constant, Name = kATSOptionFlagsUseResourceFork, Type = Double, Dynamic = False, Default = \"512", Scope = Public #tag EndConstant #tag Constant, Name = kInvalidFont, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Constant, Name = kInvalidFontFamily, Type = Double, Dynamic = False, Default = \"&hffffffff", Scope = Public #tag EndConstant #tag Constant, Name = kInvalidGeneration, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Structure, Name = ATSFontMetrics, Flags = &h0 version as UInt32 ascent as Single descent as Single leading as Single avgAdvanceWidth as Single maxAdvanceWidth as Single minLeftSideBearing as Single minRightSideBearing as Single stemWidth as Single stemHeight as Single capHeight as Single xHeight as Single italicAngle as Single underlinePosition as Single underlineThickness as Single #tag EndStructure #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
#tag Class Class ATSFont #tag Method, Flags = &h0 Function File() As FolderItem #if targetMacOS // Added a check the availability of ATSFontGetFileSpecification because // Apple's docs say this is all deprecated in 10.6 in favor of Core Text. static functionsNeedCheck as boolean = true static newFunctionIsAvailable as boolean static oldFunctionIsAvailable as boolean if functionsNeedCheck then newFunctionIsAvailable = System.IsFunctionAvailable( "ATSFontGetFileReference", CarbonLib ) oldFunctionIsAvailable = System.IsFunctionAvailable( "ATSFontGetFileSpecification", CarbonLib ) functionsNeedCheck = false end if if newFunctionIsAvailable then soft declare function ATSFontGetFileReference lib CarbonLib (iFont as UInt32, fsRef as Ptr) as Integer dim ref as new FSRef 'dim theSpec as FSSpec dim OSError as Integer = ATSFontGetFileReference(me, ref) if OSError <> noErr then return nil end if return FileManager.GetFolderItemFromFSRef(ref) elseif oldFunctionIsAvailable then //ATSFontGetFileSpecification is deprecated in Mac OS 10.5. soft declare function ATSFontGetFileSpecification lib CarbonLib (iFont as UInt32, ByRef oFile as FSSpec) as Integer dim theSpec as FSSpec dim OSError as Integer = ATSFontGetFileSpecification(me, theSpec) if OSError <> noErr then return nil end if return FileManager.GetFolderItemFromFSSpec(theSpec) end if return nil #endif End Function #tag EndMethod #tag Method, Flags = &h0 Shared Function FindFromName(name as String) As ATSFont #if targetMacOS soft declare function ATSFontFindFromName lib CarbonLib (iName as CFStringRef, iOptions as UInt32) as UInt32 dim theRef as UInt32 = ATSFontFindFromName(name, kATSOptionFlagsDefault) if theRef <> kInvalidFont then dim theFont as new ATSFont theFont.ATSFontRef = theRef return theFont else return nil end if #endif End Function #tag EndMethod #tag Method, Flags = &h0 Shared Function FindFromPostScriptName(name as String) As ATSFont #if targetMacOS soft declare function ATSFontFindFromPostScriptName lib CarbonLib (iName as CFStringRef, iOptions as UInt32) as UInt32 dim theRef as UInt32 = ATSFontFindFromPostScriptName(name, kATSOptionFlagsDefault) if theRef <> kInvalidFont then dim theFont as new ATSFont theFont.ATSFontRef = theRef return theFont else return nil end if #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function HorizontalMetrics() As ATSFontMetrics #if targetMacOS soft declare function ATSFontGetHorizontalMetrics lib CarbonLib (iFont as UInt32, iOptions as UInt32, ByRef oMetrics as ATSFontMetrics) as Integer dim metrics as ATSFontMetrics dim OSError as Integer = ATSFontGetHorizontalMetrics(me, kATSOptionFlagsDefault, metrics) return metrics // Keep the compiler from complaining #pragma unused OSError #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function Operator_Convert() As UInt32 return me.ATSFontRef End Function #tag EndMethod #tag Method, Flags = &h0 Function VerticalMetrics() As ATSFontMetrics #if targetMacOS soft declare function ATSFontGetVerticalMetrics lib CarbonLib (iFont as UInt32, iOptions as UInt32, ByRef oMetrics as ATSFontMetrics) as Integer dim metrics as ATSFontMetrics dim OSError as Integer = ATSFontGetVerticalMetrics(me, kATSOptionFlagsDefault, metrics) return metrics // Keep the compiler from complaining #pragma unused OSError #endif End Function #tag EndMethod #tag Property, Flags = &h21 Private ATSFontRef As UInt32 #tag EndProperty #tag ComputedProperty, Flags = &h0 #tag Getter Get if me.ATSFontRef = kInvalidFont then return "" end if #if targetMacOS soft declare function ATSFontGetName lib CarbonLib (iFamily as UInt32, iOptions as UInt32, ByRef oName as CFStringRef) as Integer dim theName as CFStringRef dim OSError as Integer = ATSFontGetName(me, kATSOptionFlagsDefault, theName) if OSError = noErr then return theName else return "" end if #endif End Get #tag EndGetter Name As String #tag EndComputedProperty #tag ComputedProperty, Flags = &h0 #tag Getter Get if me.ATSFontRef = kInvalidFont then return "" end if #if targetMacOS soft declare function ATSFontGetPostScriptName lib CarbonLib (iFamily as UInt32, iOptions as UInt32, ByRef oName as CFStringRef) as Integer dim theName as CFStringRef dim OSError as Integer = ATSFontGetPostScriptName(me, kATSOptionFlagsDefault, theName) if OSError = noErr then return theName else return "" end if #endif End Get #tag EndGetter PostScriptName As String #tag EndComputedProperty #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="PostScriptName" Group="Behavior" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Class #tag EndClass
\ No newline at end of file
#tag Class Class ATSFontFamily #tag Method, Flags = &h0 Shared Function FindFromName(name as String) As ATSFontFamily #if targetMacOS soft declare function ATSFontFamilyFindFromName lib CarbonLib (iName as CFStringRef, iOptions as UInt32) as UInt32 dim theRef as UInt32 = ATSFontFamilyFindFromName(name, kATSOptionFlagsDefault) if theRef <> kInvalidFontFamily then dim theFontFamily as new ATSFontFamily theFontFamily.ATSFontFamilyRef = theRef return theFontFamily else return nil end if #endif End Function #tag EndMethod #tag Method, Flags = &h21 Private Function Operator_Convert() As UInt32 return me.ATSFontFamilyRef End Function #tag EndMethod #tag Property, Flags = &h21 Private ATSFontFamilyRef As UInt32 #tag EndProperty #tag ComputedProperty, Flags = &h0 #tag Getter Get if me.ATSFontFamilyRef = kInvalidFontFamily then return "" end if #if targetMacOS soft declare function ATSFontFamilyGetName lib CarbonLib (iFamily as UInt32, iOptions as UInt32, ByRef oName as CFStringRef) as Integer dim theName as CFStringRef dim OSError as Integer = ATSFontFamilyGetName(me.ATSFontFamilyRef, kATSOptionFlagsDefault, theName) if OSError = noErr then return theName else return "" end if #endif End Get #tag EndGetter Name As String #tag EndComputedProperty #tag ComputedProperty, Flags = &h0 #tag Getter Get #if targetMacOS soft declare function ATSFontFamilyGetQuickDrawName lib CarbonLib (iFamily as UInt32, oName as Ptr) as Integer dim qdName as new MemoryBlock(256) dim OSError as Integer = ATSFontFamilyGetQuickDrawName(me.ATSFontFamilyRef, qdName) return DefineEncoding(qdName.PString(0), Encodings.MacRoman) // Keep the compiler from complaining #pragma unused OSError #endif End Get #tag EndGetter QuickDrawName As String #tag EndComputedProperty #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="QuickDrawName" Group="Behavior" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Class #tag EndClass
\ No newline at end of file
#tag Module Protected Module AppearanceManager #tag Method, Flags = &h1 Protected Function ThemeColor(ID as integer) As Color #if targetMacOS then Const depth = 32 soft declare Function GetThemeBrushAsColor lib CarbonLib (inColor as Integer, inDepth as Short, inColorDev as Boolean, outColor as Ptr) as Integer dim colorPtr as New MemoryBlock(6) dim OSErr as Integer = GetThemeBrushAsColor(ID, depth, true, colorPtr) If OSErr = 0 then Return RGB(colorPtr.UShort(0)\255, colorPtr.UShort(2)\255, colorPtr.UShort(4)\255) else ' return RED in case of an error return &cFF0000 end #else #pragma unused ID #endif End Function #tag EndMethod #tag Note, Name = About This is part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag Enum, Name = ThemeBrushConstants, Type = Integer, Flags = &h0 kDialogBackgroundActive = 1 kDialogBackgroundInactive = 2 kAlertBackgroundActive = 3 kAlertBackgroundInactive = 4 kModelessDialogBackgroundActive = 5 kModelessDialogBackgroundInactive = 6 kUtilityWindowBackgroundActive = 7 kUtilityWindowBackgroundInactive = 8 kListViewSortColumnBackground = 9 kListViewBackground = 10 kIconLabelBackground = 11 kListViewSeparator = 12 kChasingArrows = 13 kDragHilite = 14 kDocumentWindowBackground = 15 kFinderWindowBackground = 16 kScrollBarDelimiterActive = 17 kScrollBarDelimiterInactive = 18 kFocusHighlight = 19 kPopupArrowActive = 20 kPopupArrowPressed = 21 kPopupArrowInactive = 22 kAppleGuideCoachmark = 23 kIconLabelBackgroundSelected = 24 kStaticAreaFill = 25 kActiveAreaFill = 26 kButtonFrameActive = 27 kButtonFrameInactive = 28 kButtonFaceActive = 29 kButtonFaceInactive = 30 kButtonFacePressed = 31 kButtonActiveDarkShadow = 32 kButtonActiveDarkHighlight = 33 kButtonActiveLightShadow = 34 kButtonActiveLightHighlight = 35 kButtonInactiveDarkShadow = 36 kButtonInactiveDarkHighlight = 37 kButtonInactiveLightShadow = 38 kButtonInactiveLightHighlight = 39 kButtonPressedDarkShadow = 40 kButtonPressedDarkHighlight = 41 kButtonPressedLightShadow = 42 kButtonPressedLightHighlight = 43 kBevelActiveLight = 44 kBevelActiveDark = 45 kBevelInactiveLight = 46 kBevelInactiveDark = 47 kNotificationWindowBackground = 48 kMovableModalBackground = 49 kSheetBackgroundOpaque = 50 kDrawerBackground = 51 kToolbarBackground = 52 kSheetBackgroundTransparent = 53 kMenuBackground = 54 kMenuBackgroundSelected = 55 kListViewOddRowBackground = 56 kListViewEvenRowBackground = 57 kListViewColumnDivider = 58 kSheetBackground = 50 kBlack = -1 kWhite = -2 kPrimaryHighlightColor = -3 kSecondaryHighlightColor = -4 kAlternatePrimaryHighlightColor = -5 #tag EndEnum #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
#tag Module Protected Module AppleEvents #tag Method, Flags = &h0 Function PrintDesc(extends ae as AppleEvent, getReply as boolean = false) As string #if TargetMacOS Soft declare function AEPrintDescToHandle lib CarbonLib (theEvent as integer, hdl as Ptr) as integer Soft declare sub DisposeHandle lib CarbonLib (hdl as ptr) dim myHandle as MemoryBlock dim err as integer dim mb as MemoryBlock dim result as string //Will hold the pointer to the data myHandle = New MemoryBlock( 4 ) if getReply then err = AEPrintDescToHandle( ae.ReplyPtr, myHandle ) else err = AEPrintDescToHandle( ae.Ptr, myHandle ) end if if err<>0 then return "" //Check for error //Get the data mb = myHandle.Ptr( 0 ) mb = mb.Ptr( 0 ) result = mb.CString( 0 ) DisposeHandle myHandle.Ptr(0) //We must free the handle to get memory back return result #else #pragma unused ae #pragma unused getReply #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function RawData(extends ae as AppleEvent, param as string, byref type as string, inReply as boolean = false) As MemoryBlock //Get a binary data param in the reply AppleEvent #if TargetMacOS declare function AEGetParamPtr lib CarbonLib (AEPtr as integer, AEKeyword as OSType, inType as OSType, byref outType as OSType, data as Ptr, maxSize as integer, byref actSize as integer) as short dim data as MemoryBlock dim err as integer dim oType as OSType dim aSize as integer dim paramSize as integer dim paramType as string dim p as integer ae.SizeAndTypeOfParam( param, true, paramSize, paramType ) if paramType="" then //No parameter with this key return nil end if data = new MemoryBlock( paramSize ) //Get the data if inReply then p = ae.ReplyPtr else p = ae.Ptr end if err = AEGetParamPtr( p, param, type, oType, data, data.Size, aSize ) if err<>0 then return nil else //Update the actual type and return the data type = oType return data.StringValue( 0, aSize ) end if #else #pragma unused ae #pragma unused param #pragma unused type #pragma unused inReply #endif End Function #tag EndMethod #tag Method, Flags = &h0 Sub RawData(extends ae as AppleEvent, param as string, type as string, inReply as boolean = false, assigns data as MemoryBlock) //Add some binary data as a reply AppleEvent parameter #if TargetMacOS declare function AEPutParamPtr lib CarbonLib (AEPtr as integer, AEKey as OSType, dType as OSType, data as Ptr, dsize as integer) as short dim err as integer dim p as integer if inReply then p = ae.ReplyPtr else p = ae.Ptr end if err = AEPutParamPtr( p, param, type, data, data.size ) #else #pragma unused ae #pragma unused param #pragma unused type #pragma unused inReply #pragma unused data #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Sub SizeAndTypeOfParam(extends ae as AppleEvent, param as string, inReply as boolean, byref size as integer, byref type as string) //Get the size and type of one parameter. Set inReply to true if you want to access the reply AppleEvent #if TargetMacOS declare function AESizeOfParam lib CarbonLib (evnt as integer, AEKeyword as OSType, byref oDesc as OSType, byref oSize as integer) as short dim err as integer dim oDesc as OSType dim oSize as integer if inReply then err = AESizeOfParam( ae.replyptr, param, oDesc, oSize ) else err = AESizeOfParam( ae.ptr, param, oDesc, oSize ) end if if err<>0 then //We get a -1701 error if there is no parameter with this keyword type = "" size = 0 else type = oDesc size = oSize end if #else #pragma unused ae #pragma unused param #pragma unused inReply #pragma unused size #pragma unused type #endif End Sub #tag EndMethod #tag Note, Name = About This is part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag Constant, Name = typeFSRef, Type = String, Dynamic = False, Default = \"fsrf", Scope = Public #tag EndConstant #tag Constant, Name = typeStyledUnicodeText, Type = String, Dynamic = False, Default = \"sutx", Scope = Public #tag EndConstant #tag Structure, Name = AEDesc, Flags = &h0 descriptorType as OSType dataHandle as Ptr #tag EndStructure #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
#tag Module Protected Module AttachedPropertiesModule #tag Method, Flags = &h0 Function AttachedProperty(extends o as Object, key as String) As Variant //Get the stored value dim dict as Dictionary dict = FindDictionaryForObject( o, false ) if dict=nil OR NOT dict.HasKey( key ) then dim e as new KeyNotFoundException e.Message = "This AttachedProperty does not exist" raise e end if return dict.Value( key ) End Function #tag EndMethod #tag Method, Flags = &h0 Sub AttachedProperty(extends o as Object, key as string, assigns value as Variant) //Attach a key/value pair to the given object dim dict as Dictionary dict = FindDictionaryForObject( o, true ) dict.Value( key ) = value End Sub #tag EndMethod #tag Method, Flags = &h0 Function AttachedPropertyGetAll(extends o as Object, createIfNecessary as Boolean = false) As Dictionary //Get all the stored value as a Dictionary return FindDictionaryForObject( o, createIfNecessary ) End Function #tag EndMethod #tag Method, Flags = &h0 Function AttachedPropertyLookup(extends o as Object, key as String, defaultValue as variant, storeDefault as Boolean = false) As Variant //Get the stored value or default value (which is stored if storeDefault is true) dim dict as Dictionary dict = FindDictionaryForObject( o, storeDefault ) if dict=nil then return defaultValue end if if NOT dict.HasKey( key ) then if storeDefault then dict.Value( key ) = defaultValue end if return defaultValue else return dict.Value( key ) end if End Function #tag EndMethod #tag Method, Flags = &h0 Sub AttachedPropertyRemove(extends o as Object, key as String, raiseExceptionOnFailure as boolean = false) //Remove an AttachedProperty dim dict as Dictionary dict = FindDictionaryForObject( o, false ) if dict=nil OR NOT dict.HasKey( key ) then if raiseExceptionOnFailure then dim e as new KeyNotFoundException e.Message = "This AttachedProperty does not exist" raise e else return end if end if dict.Remove( key ) End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub CleanUp() //Remove all keys/values which correspond to a destroyed object if Storage=nil then init return end if for i as integer = Storage.Count - 1 downto 0 if WeakRef( Storage.Key( i )).Value = nil then Storage.Remove Storage.Key( i ) end if next End Sub #tag EndMethod #tag Method, Flags = &h21 Private Function FindDictionaryForNSObject(obj as NSObject, createIfNecessary as boolean = false) As Dictionary //Find an existing key CleanUp //Create Storage if necessary and remove AttachedProperties for destroyed objects for i as integer = 0 to NSStorage.Count - 1 if NSStorage.Key( i )=obj.id then return NSStorage.Value( NSStorage.Key( i )) end if next if createIfNecessary then dim dict as new Dictionary NSStorage.Value( obj.id ) = dict return dict else return nil end if End Function #tag EndMethod #tag Method, Flags = &h21 Private Function FindDictionaryForObject(obj as Object, createIfNecessary as boolean = false) As Dictionary //Find an existing key CleanUp //Create Storage if necessary and remove AttachedProperties for destroyed objects dim wr as WeakRef for i as integer = 0 to Storage.Count - 1 if WeakRef( Storage.Key( i )).Value=obj then return Storage.Value( Storage.Key( i )) exit end if next if createIfNecessary then dim dict as new Dictionary wr = new WeakRef( obj ) Storage.Value( wr ) = dict return dict else return nil end if End Function #tag EndMethod #tag Method, Flags = &h21 Private Sub Init() NSStorage = new Dictionary Storage = new Dictionary End Sub #tag EndMethod #tag Method, Flags = &h0 Function NSAttachedProperty(extends o as NSObject, key as String) As Variant //Get the stored value dim dict as Dictionary dict = FindDictionaryForNSObject( o, false ) if dict=nil OR NOT dict.HasKey( key ) then dim e as new KeyNotFoundException e.Message = "This AttachedProperty does not exist" raise e end if return dict.Value( key ) End Function #tag EndMethod #tag Method, Flags = &h0 Sub NSAttachedProperty(extends o as NSObject, key as string, assigns value as Variant) //Attach a key/value pair to the given object dim dict as Dictionary dict = FindDictionaryForNSObject( o, true ) dict.Value( key ) = value End Sub #tag EndMethod #tag Method, Flags = &h0 Function NSAttachedPropertyGetAll(extends o as NSObject, createIfNecessary as Boolean = false) As Dictionary //Get all the stored value as a Dictionary return FindDictionaryForNSObject( o, createIfNecessary ) End Function #tag EndMethod #tag Method, Flags = &h0 Function NSAttachedPropertyLookup(extends o as NSObject, key as String, defaultValue as variant, storeDefault as Boolean = false) As Variant //Get the stored value or default value (which is stored if storeDefault is true) dim dict as Dictionary dict = FindDictionaryForNSObject( o, storeDefault ) if dict=nil then return defaultValue end if if NOT dict.HasKey( key ) then if storeDefault then dict.Value( key ) = defaultValue end if return defaultValue else return dict.Value( key ) end if End Function #tag EndMethod #tag Method, Flags = &h0 Sub NSAttachedPropertyRemove(extends o as NSObject, key as String, raiseExceptionOnFailure as boolean = false) //Remove an AttachedProperty dim dict as Dictionary dict = FindDictionaryForNSObject( o, false ) if dict=nil OR NOT dict.HasKey( key ) then if raiseExceptionOnFailure then dim e as new KeyNotFoundException e.Message = "This AttachedProperty does not exist" raise e else return end if end if dict.Remove( key ) End Sub #tag EndMethod #tag Note, Name = Read Me AttachedProperties allow to attach named values to any object and are deleted when the object they are attached to is destroyed. Each AttachProperty requires a key (as string) to be got or set. Example: dim pict as Picture pict.AttachedProperty( "myProperty" ) = myNewValue NOTE: an AttachedProperty is completely independant of a real Property even if you use the same property name. #tag EndNote #tag Property, Flags = &h21 Private NSStorage As Dictionary #tag EndProperty #tag Property, Flags = &h21 Private Storage As Dictionary #tag EndProperty #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
#tag Module Protected Module BSD #tag Method, Flags = &h1 Protected Function ErrorCode() As Integer #if TargetMacOS declare function libcErrorCode lib libc alias "__error" () as Ptr dim p as Ptr = libcErrorCode() if p = nil then //something bad has happened return 0 end if return p.Int32(0) #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function lstat(path as String) As stat 'The lstat() system call is like stat() except in the case where the named 'file is a symbolic link, in which case lstat() returns information about 'the link, while stat() returns information about the file the link refer- 'ences. #if TargetMacOS declare function lstat lib libc (path as CString, byref buf as stat) as integer dim buf as stat dim result as integer = lstat(path, buf ) if result <> -1 then return buf else raise new BSD.Error(ErrorCode) end if #else #pragma unused path #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function stat(path as String) As stat #if TargetMacOS declare function stat lib libc (path as CString, byref buf as stat) as integer dim buf as stat dim result as integer = stat(path, buf ) if result <> -1 then return buf else raise new BSD.Error(ErrorCode) end if #else #pragma unused path #endif End Function #tag EndMethod #tag Constant, Name = libc, Type = String, Dynamic = False, Default = \"/usr/lib/libc.dylib", Scope = Private #tag EndConstant #tag Structure, Name = stat, Flags = &h1 st_dev as UInt32 st_ino as UInt32 st_mode as UInt16 st_nlink as UInt16 st_uid as UInt32 st_gid as UInt32 st_rdev as UInt32 st_atimespec as timespec st_mtimespec as timespec st_ctimespec as timespec st_size as Int64 st_blocks as Int64 st_blksize as UInt32 st_flags as UInt32 st_gen as UInt32 st_lspare_DONOTUSE as Int32 st_qspare_DONOTUSE(1) as Int64 #tag EndStructure #tag Structure, Name = timespec, Flags = &h1 tv_sec as Int32 tv_nsec as Int32 #tag EndStructure #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
#tag Class Protected Class Error Inherits RuntimeException #tag Method, Flags = &h1000 Sub Constructor(errno as Integer) self.ErrorNumber = errno self.Message = ErrorMessage(errno) End Sub #tag EndMethod #tag Method, Flags = &h21 Private Shared Function ErrorMessage(errorCode as Integer) As String #if TargetMacOS declare function strerror lib libc (errcode as Integer) as Ptr dim errorMsg as MemoryBlock = strerror(errorCode) if errorMsg <> nil then return DefineEncoding(errorMsg.CString(0), Encodings.SystemDefault) else //something bad has happened return "" end if #else #pragma unused errorCode #endif End Function #tag EndMethod #tag ViewBehavior #tag ViewProperty Name="ErrorNumber" Group="Behavior" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Message" Group="Behavior" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Reason" Group="Behavior" Type="Text" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Class #tag EndClass
\ No newline at end of file
#tag Module Protected Module CFArrayExtension #tag Method, Flags = &h0 Function CFStringRefValue(extends theArray as CFArray, index as Integer) As CFStringRef #if TargetMacOS declare function CFGetTypeID lib CarbonLib (cf as Ptr) as UInt32 declare function CFStringGetTypeID lib CarbonLib () as UInt32 declare function CFRetain lib CarbonLib (cf as Ptr) as CFStringRef static StringTypeID as UInt32 = CFStringGetTypeID dim p as Ptr = theArray.Value(index) if CFGetTypeID(p) = StringTypeID then return CFRetain(p) else dim e as new TypeMismatchException e.Message = "Value &h" + Hex(Integer(p)) + " at index " + Str(index) + " has unexpected type " + CFCopyTypeIDDescription(CFGetTypeID(p)) + "." raise e end if #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function CFValue(extends theArray as CFArray, index as Integer) As CFType #if TargetMacOS return CFType.NewObject(theArray.Value(index), not CFType.hasOwnership, kCFPropertyListImmutable) #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function StringValues(extends theArray as CFArray) As String() //New 75% faster implementation. Still sluggish, though. #if TargetMacOS declare sub CFArrayGetValues lib CarbonLib ( theArray as Ptr, range as CFRange, values as Ptr ) declare function CFGetTypeID lib CarbonLib (cf as Ptr) as UInt32 declare function CFStringGetTypeID lib CarbonLib () as UInt32 declare function CFRetain lib CarbonLib (cf as Ptr) as CFStringRef static StringTypeID as UInt32 = CFStringGetTypeID dim p as Ptr dim mb as MemoryBlock dim L() as String mb = new MemoryBlock( SizeOfPointer * theArray.Count ) CFArrayGetValues theArray.Reference, CFRangeMake( 0, theArray.Count ), mb dim lastIndex as Integer = theArray.Count - 1 for index as Integer = 0 to lastIndex p = mb.bsPtrValueFromCArray( index ) if CFGetTypeID( p )=StringTypeID then L.Append CFRetain( p ) else dim e as new TypeMismatchException e.Message = "At least one value is not a string" raise e end if next return L #endif End Function #tag EndMethod #tag Note, Name = location This module sits outside the CoreFoundation module because a nested module cannot have global visibility, which should be necessary for the extension methods to work. #tag EndNote #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
#tag Module Protected Module Carbon #tag Method, Flags = &h1 Protected Function Bundle() As CFBundle return CFBundle.NewCFBundleFromID(BundleID) End Function #tag EndMethod #tag Method, Flags = &h1 Attributes( deprecated ) Protected Function GetSystemVersionFromGestalt() As String // Attention: This is now deprecated because it's returning wrong // results on OSX 10.10 (Yosemite) and also shows a warning // in the Console log. // Use the Is... functions or SystemVersionAsInt instead. #if TargetMacOS dim sys1, sys2, sys3 as Integer dim OK as Boolean = true OK = OK AND System.Gestalt("sys1", sys1) OK = OK AND System.Gestalt("sys2", sys2) OK = OK AND System.Gestalt("sys3", sys3) if OK AND sys1 <> 0 then return Format(sys1,"#")+"."+Format(sys2,"#")+"."+Format(sys3,"#") end if #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function IsLeopard() As Boolean // Tells you if this OS has features of this version // This means that it returns true for later OS versions as well. // If you want to test for a particular version, use SystemVersionAsInt return SystemVersionAsInt >= 100500 End Function #tag EndMethod #tag Method, Flags = &h0 Function IsLion() As Boolean // Tells you if this OS has features of this version // This means that it returns true for later OS versions as well. // If you want to test for a particular version, use SystemVersionAsInt return SystemVersionAsInt >= 100700 End Function #tag EndMethod #tag Method, Flags = &h0 Function IsMavericks() As Boolean // Tells you if this OS has features of this version // This means that it returns true for later OS versions as well. // If you want to test for a particular version, use SystemVersionAsInt return SystemVersionAsInt >= 100900 End Function #tag EndMethod #tag Method, Flags = &h0 Function IsMountainLion() As Boolean // Tells you if this OS has features of this version // This means that it returns true for later OS versions as well. // If you want to test for a particular version, use SystemVersionAsInt return SystemVersionAsInt >= 100800 End Function #tag EndMethod #tag Method, Flags = &h0 Function IsPanther() As Boolean // Tells you if this OS has features of this version // This means that it returns true for later OS versions as well. // If you want to test for a particular version, use SystemVersionAsInt return SystemVersionAsInt >= 100300 End Function #tag EndMethod #tag Method, Flags = &h0 Function IsSnowLeopard() As Boolean // Tells you if this OS has features of this version // This means that it returns true for later OS versions as well. // If you want to test for a particular version, use SystemVersionAsInt return SystemVersionAsInt >= 100600 End Function #tag EndMethod #tag Method, Flags = &h0 Function IsTiger() As Boolean // Tells you if this OS has features of this version // This means that it returns true for later OS versions as well. // If you want to test for a particular version, use SystemVersionAsInt return SystemVersionAsInt >= 100400 End Function #tag EndMethod #tag Method, Flags = &h0 Function IsYosemite() As Boolean // Tells you if this OS has features of this version // This means that it returns true for later OS versions as well. // If you want to test for a particular version, use SystemVersionAsInt return SystemVersionAsInt >= 101000 End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function Languages() As String() dim languagelist as CFArray = CFArray(CFPreferences.Value("AppleLanguages")) dim theList() as String for i as Integer = 0 to languagelist.Count - 1 theList.Append languagelist.CFStringRefValue(i) next return theList End Function #tag EndMethod #tag Method, Flags = &h0 Sub ShowAboutBox(name as String = "", version as String = "", copyright as String = "", description as String = "") dim d as new CFMutableDictionary if name <> "" then d.Value(CFString("HIAboutBoxName")) = CFString(name) end if if version <> "" then d.Value(CFString("HIAboutBoxVersion")) = CFString(version) end if if copyright <> "" then d.Value(CFString("HIAboutBoxCopyright")) = CFString(copyright) end if if description <> "" then d.Value(CFString("HIAboutBoxDescription")) = CFString(description) end if #if targetMacOS soft declare function HIAboutBox lib CarbonLib (inOptions as Ptr) as Integer dim OSError as Integer = HIAboutBox(d) #pragma unused OSError #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Sub SpotlightSearch(searchTerm as String) //opens a Spotlight search window and does the search using searchTerm //if searchTerm = "", a search window is opened #if targetMacOS soft declare function HISearchWindowShow lib "Carbon.framework" (inSearchString as CFStringRef, inOptions as UInt32) as Integer const kNilOptions = 0 dim OSError as Integer = HISearchWindowShow(searchTerm, kNilOptions) return #pragma unused OSError #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Function SystemUIMode() As UIMode #if targetMacOS soft declare sub GetSystemUIMode lib CarbonLib (ByRef mode as UIMode, outOptions as Ptr) dim mode as UIMode GetSystemUIMode mode, nil return mode #endif End Function #tag EndMethod #tag Method, Flags = &h0 Sub SystemUIMode(mode as UIMode, options as UIOptions) #if targetCarbon soft declare function SetSystemUIMode lib CarbonLib (inMode as UIMode, inOptions as UIOptions) as Integer dim OSError as Integer = SetSystemUIMode(mode, options) #pragma unused OSError #else #pragma unused mode #pragma unused options #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Function SystemUIOptions() As UIOptions #if targetMacOS soft declare sub GetSystemUIMode lib CarbonLib (mode as Ptr, ByRef outOptions as UIOptions) dim options as UIOptions GetSystemUIMode nil, options return options #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function SystemVersionAsInt() As Integer // The value returned is scaled up, so that a version like 10.1.2 becomes 100102, i.e. two digits per part. // // This function avoids using floating point, so that a version such as 10.4 doesn't become 10.39999 or something alike, making a test for >=10.4 fail #if TargetMacOS static version as Integer if version = 0 then // Since OSX 10.10, we have to prefer NSProcessInfo's version over Gestalt dim sys1, sys2, sys3 as Integer dim v as NSProcessInfo.OSVersion v = NSProcessInfo.ProcessInfo.OperatingSystemVersion if v.major > 0 then sys1 = v.major sys2 = v.minor sys3 = v.patch else // This OS is older (pre 10.9), so we'll fall back to using Gestalt call System.Gestalt("sys1", sys1) call System.Gestalt("sys2", sys2) call System.Gestalt("sys3", sys3) end if version = 10000 * sys1 + 100 * sys2 + sys3 end if return version #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function SystemVersionAsString() As String // This returns the OS X system version as a String. Use this to display the // system version. // // Careful! // Do not use the returned value to test for particular system versions! // Use SystemVersionAsInt for comparisons instead! // // If you do not obey this rule you will get wrong results if you test for // SystemVersionAsString >= "10.6" // with the actual OS X version being 10.11: Then the string "10.6" will be // greater than "10.11", which is the wrong result for your test. // // Also, this text may be localized in ways you cannot even parse! #if TargetMacOS // Due to the fact that using Gestalt to get the version is not working in OSX 10.10 // any more, we need to use NSProcessInfo now instead: static version as String = NSProcessInfo.ProcessInfo.operatingSystemVersionString return version #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function VersionAsInteger(versionString As String) As Integer // The value returned is scaled up, so that a version like 10.1.2 becomes 100102, i.e. two digits per part. // // This function avoids using floating point, so that a version such as 10.4 doesn't become 10.39999 or something alike, making a test for >=10.4 fail // // CAUTION: This method will ignore anything past the third part of the version. So "1.2.3.4.5" will be treated the same as "1.2.3". dim version as Integer dim parts() as String = versionString.Split(".") if parts.Ubound <> -1 then version = 10000 * parts( 0 ).Val if parts.Ubound > 0 then version = version + 100 * parts( 1 ).Val if parts.Ubound > 1 then version = version + parts( 2 ).Val end if end if end if return version End Function #tag EndMethod #tag Note, Name = About This is part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag Constant, Name = activeFlagBit, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Constant, Name = alphaLockBit, Type = Double, Dynamic = False, Default = \"10", Scope = Public #tag EndConstant #tag Constant, Name = btnStateBit, Type = Double, Dynamic = False, Default = \"7", Scope = Public #tag EndConstant #tag Constant, Name = BundleID, Type = String, Dynamic = False, Default = \"com.apple.Carbon", Scope = Protected #tag EndConstant #tag Constant, Name = CarbonLib, Type = String, Dynamic = False, Default = \"Carbon.framework", Scope = Public #tag EndConstant #tag Constant, Name = cmdKeyBit, Type = Double, Dynamic = False, Default = \"8", Scope = Public #tag EndConstant #tag Constant, Name = controlKeyBit, Type = Double, Dynamic = False, Default = \"12", Scope = Public #tag EndConstant #tag Constant, Name = kInvalidID, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Constant, Name = kNilOptions, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Constant, Name = kUnknownType, Type = String, Dynamic = False, Default = \"\?\?\?\?", Scope = Public #tag EndConstant #tag Constant, Name = kVariableLengthArray, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = noErr, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Constant, Name = optionKeyBit, Type = Double, Dynamic = False, Default = \"11", Scope = Public #tag EndConstant #tag Constant, Name = rightControlKeyBit, Type = Double, Dynamic = False, Default = \"15", Scope = Public #tag EndConstant #tag Constant, Name = rightOptionKeyBit, Type = Double, Dynamic = False, Default = \"14", Scope = Public #tag EndConstant #tag Constant, Name = rightShiftKeyBit, Type = Double, Dynamic = False, Default = \"13", Scope = Public #tag EndConstant #tag Constant, Name = shiftKeyBit, Type = Double, Dynamic = False, Default = \"9", Scope = Public #tag EndConstant #tag Structure, Name = LongDateRec, Flags = &h0 era as Int16 year as Int16 month as Int16 day as Int16 hour as Int16 minute as Int16 second as Int16 dayOfWeek as Int16 dayOfYear as Int16 weekOfYear as Int16 pm as Int16 res1 as Int16 res2 as Int16 res3 as Int16 #tag EndStructure #tag Structure, Name = MacPoint, Flags = &h0 v as Int16 h as Int16 #tag EndStructure #tag Structure, Name = MacRect, Flags = &h0 top as Int16 left as Int16 bottom as Int16 right as Int16 #tag EndStructure #tag Structure, Name = Str255, Flags = &h0 length as Uint8 data as String*255 #tag EndStructure #tag Enum, Name = UIMode, Flags = &h0 Normal = 0 ContentSuppressed = 1 ContentHidden = 2 AllSuppressed = 4 AllHidden = 3 #tag EndEnum #tag Enum, Name = UIOptions, Flags = &h0 AutoShowMenuBar = 1 DisableAppleMenu = 4 DisableProcessSwitch = 8 DisableForceQuit = 16 DisableSessionTerminate = 32 DisableHide = 64 #tag EndEnum #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
#tag Class Class CarbonPasteboard #tag Method, Flags = &h0 Sub Clear() #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardClear lib CarbonLib (ref as Integer) as Integer mLastError = PasteboardClear (mRef) #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Shared Function Clipboard() As CarbonPasteboard return new CarbonPasteboard() End Function #tag EndMethod #tag Method, Flags = &h0 Sub Constructor() // default constructor, returning the main clipboard self.Constructor("com.apple.pasteboard.clipboard") End Sub #tag EndMethod #tag Method, Flags = &h1 Protected Sub Constructor(name as CFStringRef) #if TargetMacOS declare function PasteboardCreate lib CarbonLib (name as CFStringRef, ByRef ref as Integer) as Integer mLastError = PasteboardCreate (name, mRef) if mLastError <> 0 then raise new NilObjectException end if #else #pragma unused name #endif End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub Constructor(pbRef as Integer) #if TargetMacOS mRef = pbRef declare sub CFRetain lib CarbonLib (cf as Integer) CFRetain (mRef) #else #pragma unused pbRef #endif End Sub #tag EndMethod #tag Method, Flags = &h1 Protected Sub Destructor() #if TargetMacOS declare sub CFRelease lib CarbonLib (cf as Integer) CFRelease mRef mRef = 0 #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Shared Function DragPasteboard(dragHandle as Integer) As CarbonPasteboard #if TargetMacOS declare function GetDragPasteboard lib CarbonLib (dragRef as Integer, ByRef pbRefOut as Integer) as Integer dim r as Integer if GetDragPasteboard (dragHandle, r) = 0 then dim pb as CarbonPasteboard = new CarbonPasteboard (r) return pb end #else #pragma unused dragHandle #endif End Function #tag EndMethod #tag Method, Flags = &h0 Shared Function FindPasteboard() As CarbonPasteboard return new CarbonPasteboard("com.apple.pasteboard.find") End Function #tag EndMethod #tag Method, Flags = &h0 Function Handle() As Integer return mRef End Function #tag EndMethod #tag Method, Flags = &h0 Function ItemFlavorData(itemID as Ptr, flavor as String) As MemoryBlock #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardCopyItemFlavorData lib CarbonLib (ref as Integer, id as Ptr, type as CFStringRef, ByRef data as Ptr) as Integer dim d as Ptr mLastError = PasteboardCopyItemFlavorData (mRef, itemID, flavor, d) if mLastError = 0 then dim data as new CFData (d, CFData.hasOwnership) return data.Data end if #else #pragma unused itemID #pragma unused flavor #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function ItemFlavorFlags(itemID as Ptr, flavor as String) As UInt32 #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardGetItemFlavorFlags lib CarbonLib (ref as Integer, id as Ptr, type as CFStringRef, ByRef data as UInt32) as Integer dim d as UInt32 mLastError = PasteboardGetItemFlavorFlags (mRef, itemID, flavor, d) if mLastError = 0 then return d end if #else #pragma unused itemID #pragma unused flavor #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function ItemFlavors(itemID as Ptr) As String() #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardCopyItemFlavors lib CarbonLib (ref as Integer, id as Ptr, ByRef data as Ptr) as Integer dim d as Ptr mLastError = PasteboardCopyItemFlavors (mRef, itemID, d) if mLastError = 0 then dim a as new CFArray (d, CFArray.hasOwnership) return a.StringValues end if #else #pragma unused itemID #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function ItemIdentifier(index_1based as Integer) As Ptr #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardGetItemIdentifier lib CarbonLib (ref as Integer, idx as Integer, ByRef data as Ptr) as Integer dim d as Ptr mLastError = PasteboardGetItemIdentifier (mRef, index_1based, d) if mLastError = 0 then return d else return Ptr(index_1based) end if #else #pragma unused index_1based #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function LastError() As Integer return mLastError End Function #tag EndMethod #tag Method, Flags = &h0 Function PasteLocation() As CFURL #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardCopyPasteLocation lib CarbonLib (ref as Integer, ByRef data as Ptr) as Integer dim d as Ptr mLastError = PasteboardCopyPasteLocation (mRef, d) if mLastError = 0 then dim url as new CFURL (d, CFData.hasOwnership) return url end if #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function PutItemFlavor(itemID as Ptr, flavor as String, data as MemoryBlock, flags as UInt32) As Boolean #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardPutItemFlavor lib CarbonLib (ref as Integer, id as Ptr, flavor as CFStringRef, data as Ptr, flags as UInt32) as Integer mLastError = PasteboardPutItemFlavor (mRef, itemID, flavor, new CFData (data), flags) return mLastError = 0 #else #pragma unused itemID #pragma unused flavor #pragma unused data #pragma unused flags #endif End Function #tag EndMethod #tag Method, Flags = &h0 Sub ResolvePromises() #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardResolvePromises lib CarbonLib (ref as Integer) as Integer mLastError = PasteboardResolvePromises (mRef) #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Function SetPasteLocation(url as CFURL) As Boolean #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardSetPasteLocation lib CarbonLib (ref as Integer, url as Ptr) as Integer mLastError = PasteboardSetPasteLocation (mRef, url.Reference) return mLastError = 0 #else #pragma unused url #endif End Function #tag EndMethod #tag Method, Flags = &h0 Sub Synchronize(ByRef modified as Boolean, ByRef isOwn as Boolean) #if TargetMacOS #pragma DisableBackgroundTasks declare function PasteboardSynchronize lib CarbonLib (ref as Integer) as UInt32 dim n as UInt32 = PasteboardSynchronize (mRef) modified = (n and 1) <> 0 isOwn = (n and 2) <> 0 mLastError = 0 #else #pragma unused modified #pragma unused isOwn #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Shared Function UniquePasteboard() As CarbonPasteboard #if TargetMacOS declare function PasteboardCreate lib CarbonLib (name as Ptr, ByRef ref as Integer) as Integer dim ref as Integer const kPasteboardUniqueName = nil dim err as Integer = PasteboardCreate (kPasteboardUniqueName, ref) if err <> 0 then return nil end if return new CarbonPasteboard (ref) #endif End Function #tag EndMethod #tag Note, Name = About This is part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag ComputedProperty, Flags = &h0 #tag Getter Get #if TargetMacOS declare function PasteboardGetItemCount lib CarbonLib (ref as Integer, ByRef n as UInt32) as Integer dim n as UInt32 mLastError = PasteboardGetItemCount (mRef, n) if mLastError = 0 then return n end if #endif End Get #tag EndGetter ItemCount As Integer #tag EndComputedProperty #tag Property, Flags = &h21 Private mLastError As Integer #tag EndProperty #tag Property, Flags = &h21 Private mRef As Integer #tag EndProperty #tag Constant, Name = kPasteboardFlavorNoFlags, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Constant, Name = kPasteboardFlavorNotSaved, Type = Double, Dynamic = False, Default = \"4", Scope = Public #tag EndConstant #tag Constant, Name = kPasteboardFlavorPromised, Type = Double, Dynamic = False, Default = \"512", Scope = Public #tag EndConstant #tag Constant, Name = kPasteboardFlavorRequestOnly, Type = Double, Dynamic = False, Default = \"8", Scope = Public #tag EndConstant #tag Constant, Name = kPasteboardFlavorSenderOnly, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kPasteboardFlavorSenderTranslated, Type = Double, Dynamic = False, Default = \"2", Scope = Public #tag EndConstant #tag Constant, Name = kPasteboardFlavorSystemTranslated, Type = Double, Dynamic = False, Default = \"256", Scope = Public #tag EndConstant #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="ItemCount" Group="Behavior" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Class #tag EndClass
\ No newline at end of file
#tag Module Protected Module CarbonDragManager #tag DelegateDeclaration, Flags = &h0 Delegate Function DragSendDataProc(type as Integer, refCon as Integer, dragItem as Ptr, dragRef as Ptr) As Integer #tag EndDelegateDeclaration #tag Method, Flags = &h0 Function NewDragRefWithPasteboard(pb as CarbonPasteboard) As DragRef #if TargetMacOS declare function NewDragWithPasteboard lib CarbonLib (pbRef as Integer, ByRef dragRef as Integer) as Integer dim r as Integer if NewDragWithPasteboard (pb.Handle, r) = 0 then if r <> 0 then return new DragRef (r) end end #else #pragma unused pb #endif End Function #tag EndMethod #tag Note, Name = About Provides a replacement for RB's DragItem, which doesn't work fully in Cocoa yet (see <feedback://showreport?report_id=21991>) This is part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag Constant, Name = kDragActionAlias, Type = Double, Dynamic = False, Default = \"2", Scope = Public #tag EndConstant #tag Constant, Name = kDragActionAll, Type = Double, Dynamic = False, Default = \"&hFFFFFFFF", Scope = Public #tag EndConstant #tag Constant, Name = kDragActionCopy, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kDragActionDelete, Type = Double, Dynamic = False, Default = \"32", Scope = Public #tag EndConstant #tag Constant, Name = kDragActionGeneric, Type = Double, Dynamic = False, Default = \"4", Scope = Public #tag EndConstant #tag Constant, Name = kDragActionMove, Type = Double, Dynamic = False, Default = \"16", Scope = Public #tag EndConstant #tag Constant, Name = kDragActionNothing, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Constant, Name = kDragActionPrivate, Type = Double, Dynamic = False, Default = \"8", Scope = Public #tag EndConstant #tag Structure, Name = CGPoint, Flags = &h1 x as Single y as Single #tag EndStructure #tag Structure, Name = EventRecord, Flags = &h1 what as Short message as Integer when as Integer where as Point modifiers as Short #tag EndStructure #tag Structure, Name = Point, Flags = &h1 v as Short h as Short #tag EndStructure #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
#tag Class Protected Class DragRef #tag Method, Flags = &h0 Function AllowableActions() As Integer #if TargetMacOS declare function GetDragAllowableActions lib CarbonLib (ref as Integer, ByRef act as Integer) as Integer dim actions as Integer dim res as Integer = GetDragAllowableActions (mRef, actions) if res <> 0 then break else return actions end #endif End Function #tag EndMethod #tag Method, Flags = &h0 Sub Constructor(ref as Integer) mRef = ref End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub Destructor() #if TargetMacOS declare sub DisposeDrag lib CarbonLib (ref as Integer) if mRef <> 0 then DisposeDrag (mRef) end if #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Function DropDestination() As FolderItem #if TargetMacOS declare function GetDropLocation lib CarbonLib (dragHdl as Integer, outDropLocationAEDesc as Ptr) as Integer declare function AECoerceDesc lib CarbonLib (aeDesc as Ptr, type as OSType, descr_in as Ptr) as Integer declare function AEGetDescData lib CarbonLib (aeDesc as Ptr, data as Ptr, maxSize as Integer) as Integer dim aeDesc as new MemoryBlock(8) dim res as Integer = GetDropLocation (mRef, aeDesc) if res = 0 then dim fsrDesc as new MemoryBlock (8) res = AECoerceDesc (aeDesc, "fsrf", fsrDesc) if res = 0 then dim ref as new MemoryBlock (80) res = AEGetDescData (fsrDesc, ref, ref.Size) if res = 0 then dim r2 as new FSRef (ref) return r2.FolderItem end if end if end if #endif End Function #tag EndMethod #tag Method, Flags = &h0 Sub SetAllowableActions(actions as Integer, isLocal as Boolean) #if TargetMacOS declare function SetDragAllowableActions lib CarbonLib (ref as Integer, act as Integer, loc as Boolean) as Integer dim res as Integer = SetDragAllowableActions (mRef, actions, isLocal) if res <> 0 then break end #else #pragma unused actions #pragma unused isLocal #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Sub SetCGImage(img as CGImage, ofsx as Integer, ofsy as Integer, flags as Integer) #if TargetMacOS declare function SetDragImageWithCGImage lib CarbonLib (ref as Integer, imgRef as Ptr, ByRef ofs as CGPoint, fl as Integer) as Integer dim pt as CGPoint pt.x = ofsx pt.y = ofsy dim res as Integer = SetDragImageWithCGImage (mRef, img.Reference, pt, flags) if res <> 0 then break end #else #pragma unused img #pragma unused ofsx #pragma unused ofsy #pragma unused flags #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Sub SetDragSendProc(proc as DragSendDataProc, ref as Integer) #if TargetMacOS declare function SetDragSendProc lib CarbonLib (dragRef as Integer, proc as Ptr, refCon as Integer) as Integer dim res as Integer = SetDragSendProc (mRef, proc, ref) if res <> 0 then break end #else #pragma unused proc #pragma unused ref #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Function TrackDrag(eventRec as EventRecord, rgn as Ptr) As Integer #if TargetMacOS declare function TrackDrag lib CarbonLib (dragRef as Integer, ByRef ev as EventRecord, theRegion as Ptr) as Integer return TrackDrag (mRef, eventRec, rgn) #else #pragma unused eventRec #pragma unused rgn #endif End Function #tag EndMethod #tag Method, Flags = &h0 Function WasDroppedToTrash() As Boolean #if TargetMacOS declare function GetStandardDropLocation lib CarbonLib (theDrag as Integer, byref outDropLocation as Integer) as Integer ' determine standard location drag item was dropped to dim outDropLocation as Integer call GetStandardDropLocation(mRef, outDropLocation) return outDropLocation = kDragStandardDropLocationTrash #endif End Function #tag EndMethod #tag Note, Name = About This is part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag Property, Flags = &h21 Private mRef As Integer #tag EndProperty #tag Constant, Name = kDragStandardDropLocationTrash, Type = Double, Dynamic = False, Default = \"\'trsh\'", Scope = Private #tag EndConstant #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Class #tag EndClass
\ No newline at end of file
#tag Module Protected Module CarbonEvents #tag Method, Flags = &h0 Function CArray(extends spec() as EventTypeSpec) As MemoryBlock dim m as new MemoryBlock(EventTypeSpec.Size*(1 + UBound(spec))) dim offset as Integer = 0 for i as Integer = 0 to UBound(spec) m.StringValue(offset, EventTypeSpec.Size) = spec(i).StringValue(targetLittleEndian) offset = offset + EventTypeSpec.Size next return m End Function #tag EndMethod #tag Note, Name = About This is part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag Note, Name = types Lots of declarations of things like typeUnicodeText can be found in AEDataModel.h and AEDataModel.r. #tag EndNote #tag Constant, Name = eventNotHandledErr, Type = Double, Dynamic = False, Default = \"-9874", Scope = Public #tag EndConstant #tag Constant, Name = kEventAttributeMonitored, Type = Double, Dynamic = False, Default = \"8", Scope = Public #tag EndConstant #tag Constant, Name = kEventAttributeNone, Type = Double, Dynamic = False, Default = \"0", Scope = Public #tag EndConstant #tag Constant, Name = kEventAttributeUserEvent, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kEventClassCommand, Type = String, Dynamic = False, Default = \"cmds", Scope = Public #tag EndConstant #tag Constant, Name = kEventClassControl, Type = String, Dynamic = False, Default = \"cntl", Scope = Public #tag EndConstant #tag Constant, Name = kEventClassMenu, Type = String, Dynamic = False, Default = \"menu", Scope = Public #tag EndConstant #tag Constant, Name = kEventClassMouse, Type = String, Dynamic = False, Default = \"mous", Scope = Public #tag EndConstant #tag Constant, Name = kEventClassSearchField, Type = String, Dynamic = False, Default = \"srfd", Scope = Public #tag EndConstant #tag Constant, Name = kEventClassTextField, Type = String, Dynamic = False, Default = \"txfd", Scope = Public #tag EndConstant #tag Constant, Name = kEventClassTextInput, Type = String, Dynamic = False, Default = \"text", Scope = Public #tag EndConstant #tag Constant, Name = kEventClassWindow, Type = String, Dynamic = False, Default = \"wind", Scope = Public #tag EndConstant #tag Constant, Name = kEventCommandProcess, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kEventControlDraw, Type = Double, Dynamic = False, Default = \"4", Scope = Public #tag EndConstant #tag Constant, Name = kEventControlGetFocusPart, Type = Double, Dynamic = False, Default = \"8", Scope = Public #tag EndConstant #tag Constant, Name = kEventControlGetNextFocusCandidate, Type = Double, Dynamic = False, Default = \"14", Scope = Public #tag EndConstant #tag Constant, Name = kEventControlGetSizeConstraints, Type = Double, Dynamic = False, Default = \"105", Scope = Public #tag EndConstant #tag Constant, Name = kEventControlSetData, Type = Double, Dynamic = False, Default = \"103", Scope = Public #tag EndConstant #tag Constant, Name = kEventControlSetFocusPart, Type = Double, Dynamic = False, Default = \"7", Scope = Public #tag EndConstant #tag Constant, Name = kEventMenuEnableItems, Type = Double, Dynamic = False, Default = \"8", Scope = Public #tag EndConstant #tag Constant, Name = kEventMouseDown, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kEventMouseDragged, Type = Double, Dynamic = False, Default = \"6", Scope = Public #tag EndConstant #tag Constant, Name = kEventMouseEntered, Type = Double, Dynamic = False, Default = \"8", Scope = Public #tag EndConstant #tag Constant, Name = kEventMouseExited, Type = Double, Dynamic = False, Default = \"9", Scope = Public #tag EndConstant #tag Constant, Name = kEventMouseMoved, Type = Double, Dynamic = False, Default = \"5", Scope = Public #tag EndConstant #tag Constant, Name = kEventMouseUp, Type = Double, Dynamic = False, Default = \"2", Scope = Public #tag EndConstant #tag Constant, Name = kEventMouseWheelMoved, Type = Double, Dynamic = False, Default = \"10", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamAttributes, Type = String, Dynamic = False, Default = \"attr", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamBounds, Type = String, Dynamic = False, Default = \"boun", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamCGContextRef, Type = String, Dynamic = False, Default = \"cntx", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamClickCount, Type = String, Dynamic = False, Default = \"ccnt", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamControlPart, Type = String, Dynamic = False, Default = \"cprt", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamControlRef, Type = String, Dynamic = False, Default = \"crtl", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamDeviceColor, Type = String, Dynamic = False, Default = \"devc", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamDeviceDepth, Type = String, Dynamic = False, Default = \"devd", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamDimensions, Type = String, Dynamic = False, Default = \"dims", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamDirectObject, Type = String, Dynamic = False, Default = \"----", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamEnabled, Type = String, Dynamic = False, Default = \"enab", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamEventRef, Type = String, Dynamic = False, Default = \"evnt", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamGDevice, Type = String, Dynamic = False, Default = \"gdev", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamGrafPort, Type = String, Dynamic = False, Default = \"graf", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamIndex, Type = String, Dynamic = False, Default = \"indx", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMaximumSize, Type = String, Dynamic = False, Default = \"mxsz", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMenuRef, Type = String, Dynamic = False, Default = \"menu", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMinimumSize, Type = String, Dynamic = False, Default = \"mnsz", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMouseButton, Type = String, Dynamic = False, Default = \"mbtn", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMouseChord, Type = String, Dynamic = False, Default = \"chor", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMouseDelta, Type = String, Dynamic = False, Default = \"mdta", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMouseLocation, Type = String, Dynamic = False, Default = \"mloc", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMouseTrackingRef, Type = String, Dynamic = False, Default = \"mtrf", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMouseWheelAxis, Type = String, Dynamic = False, Default = \"mwax", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMouseWheelDelta, Type = String, Dynamic = False, Default = \"mwdl", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamMutableArray, Type = String, Dynamic = False, Default = \"marr", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamReason, Type = String, Dynamic = False, Default = \"why\?", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamResult, Type = String, Dynamic = False, Default = \"ansr", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamRgnHandle, Type = String, Dynamic = False, Default = \"rgnh", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamShape, Type = String, Dynamic = False, Default = \"shap", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamTabletEventType, Type = String, Dynamic = False, Default = \"tblt", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamTextInputSendText, Type = String, Dynamic = False, Default = \"tstx", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamTransactionID, Type = String, Dynamic = False, Default = \"trns", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamUserData, Type = String, Dynamic = False, Default = \"usrd", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamWindowMouseLocation, Type = String, Dynamic = False, Default = \"wmou", Scope = Public #tag EndConstant #tag Constant, Name = kEventParamWindowRef, Type = String, Dynamic = False, Default = \"wind", Scope = Public #tag EndConstant #tag Constant, Name = kEventSearchFieldCancelClicked, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kEventTextAccepted, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kEventTextDidChange, Type = Double, Dynamic = False, Default = \"3", Scope = Public #tag EndConstant #tag Constant, Name = kEventTextInputUnicodeForKeyEvent, Type = Double, Dynamic = False, Default = \"2", Scope = Public #tag EndConstant #tag Constant, Name = kEventWindowDrawContent, Type = Double, Dynamic = False, Default = \"2", Scope = Public #tag EndConstant #tag Constant, Name = kEventWindowHiding, Type = Double, Dynamic = False, Default = \"23", Scope = Public #tag EndConstant #tag Constant, Name = kEventWindowPaint, Type = Double, Dynamic = False, Default = \"1013", Scope = Public #tag EndConstant #tag Constant, Name = kEventWindowUpdate, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kHISearchFieldAttributesCancel, Type = Double, Dynamic = False, Default = \"1", Scope = Public #tag EndConstant #tag Constant, Name = kHISearchFieldAttributesSearchIcon, Type = Double, Dynamic = False, Default = \"2", Scope = Public #tag EndConstant #tag Constant, Name = typeBoolean, Type = String, Dynamic = False, Default = \"bool", Scope = Public #tag EndConstant #tag Constant, Name = typeCFArrayRef, Type = String, Dynamic = False, Default = \"cfar", Scope = Public #tag EndConstant #tag Constant, Name = typeCFAttributedStringRef, Type = String, Dynamic = False, Default = \"cfas", Scope = Public #tag EndConstant #tag Constant, Name = typeCFBooleanRef, Type = String, Dynamic = False, Default = \"cftf", Scope = Public #tag EndConstant #tag Constant, Name = typeCFDictionaryRef, Type = String, Dynamic = False, Default = \"cfdc", Scope = Public #tag EndConstant #tag Constant, Name = typeCFIndex, Type = String, Dynamic = False, Default = \"cfix", Scope = Public #tag EndConstant #tag Constant, Name = typeCFMutableArrayRef, Type = String, Dynamic = False, Default = \"cfma", Scope = Public #tag EndConstant #tag Constant, Name = typeCFMutableAttributedStringRef, Type = String, Dynamic = False, Default = \"cfaa", Scope = Public #tag EndConstant #tag Constant, Name = typeCFMutableDictionaryRef, Type = String, Dynamic = False, Default = \"cfmd", Scope = Public #tag EndConstant #tag Constant, Name = typeCFMutableStringRef, Type = String, Dynamic = False, Default = \"cfms", Scope = Public #tag EndConstant #tag Constant, Name = typeCFNumberRef, Type = String, Dynamic = False, Default = \"cfnb", Scope = Public #tag EndConstant #tag Constant, Name = typeCFStringRef, Type = String, Dynamic = False, Default = \"cfst", Scope = Public #tag EndConstant #tag Constant, Name = typeCFTypeRef, Type = String, Dynamic = False, Default = \"cfty", Scope = Public #tag EndConstant #tag Constant, Name = typeCGContextRef, Type = String, Dynamic = False, Default = \"cntx", Scope = Public #tag EndConstant #tag Constant, Name = typeChar, Type = String, Dynamic = False, Default = \"TEXT", Scope = Public #tag EndConstant #tag Constant, Name = typeCollection, Type = String, Dynamic = False, Default = \"cltn", Scope = Public #tag EndConstant #tag Constant, Name = typeControlPartCode, Type = String, Dynamic = False, Default = \"cprt", Scope = Public #tag EndConstant #tag Constant, Name = typeControlRef, Type = String, Dynamic = False, Default = \"crtl", Scope = Public #tag EndConstant #tag Constant, Name = typeCString, Type = String, Dynamic = False, Default = \"cstr", Scope = Public #tag EndConstant #tag Constant, Name = typeGDHandle, Type = String, Dynamic = False, Default = \"gdev", Scope = Public #tag EndConstant #tag Constant, Name = typeGrafPtr, Type = String, Dynamic = False, Default = \"graf", Scope = Public #tag EndConstant #tag Constant, Name = typeGWorldPtr, Type = String, Dynamic = False, Default = \"gwld", Scope = Public #tag EndConstant #tag Constant, Name = typeHICommand, Type = String, Dynamic = False, Default = \"hcmd", Scope = Public #tag EndConstant #tag Constant, Name = typeHIPoint, Type = String, Dynamic = False, Default = \"hipt", Scope = Public #tag EndConstant #tag Constant, Name = typeHIRect, Type = String, Dynamic = False, Default = \"hirc", Scope = Public #tag EndConstant #tag Constant, Name = typeHIShapeRef, Type = String, Dynamic = False, Default = \"shap", Scope = Public #tag EndConstant #tag Constant, Name = typeHISize, Type = String, Dynamic = False, Default = \"hisz", Scope = Public #tag EndConstant #tag Constant, Name = typeMenuRef, Type = String, Dynamic = False, Default = \"menu", Scope = Public #tag EndConstant #tag Constant, Name = typeMouseButton, Type = String, Dynamic = False, Default = \"mbtn", Scope = Public #tag EndConstant #tag Constant, Name = typeMouseTrackingRef, Type = String, Dynamic = False, Default = \"mtrf", Scope = Public #tag EndConstant #tag Constant, Name = typeMouseWheelAxis, Type = String, Dynamic = False, Default = \"mwax", Scope = Public #tag EndConstant #tag Constant, Name = typeOSStatus, Type = String, Dynamic = False, Default = \"osst", Scope = Public #tag EndConstant #tag Constant, Name = typePString, Type = String, Dynamic = False, Default = \"pstr", Scope = Public #tag EndConstant #tag Constant, Name = typePtr, Type = String, Dynamic = False, Default = \"ptr ", Scope = Public #tag EndConstant #tag Constant, Name = typeQDPoint, Type = String, Dynamic = False, Default = \"QDpt", Scope = Public #tag EndConstant #tag Constant, Name = typeQDRgnHandle, Type = String, Dynamic = False, Default = \"rgnh", Scope = Public #tag EndConstant #tag Constant, Name = typeUInt32, Type = String, Dynamic = False, Default = \"magn", Scope = Public #tag EndConstant #tag Constant, Name = typeUnicodeText, Type = String, Dynamic = False, Default = \"utxt", Scope = Public #tag EndConstant #tag Constant, Name = typeVoidPtr, Type = String, Dynamic = False, Default = \"void", Scope = Public #tag EndConstant #tag Constant, Name = typeWindowRef, Type = String, Dynamic = False, Default = \"wind", Scope = Public #tag EndConstant #tag Structure, Name = EventTypeSpec, Flags = &h0 eventClass as UInt32 eventKind as UInt32 #tag EndStructure #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
#tag Module Protected Module CertTools #tag Method, Flags = &h1 Protected Function DeviceGUID() As String // The Mac's GUID is the MAC address from network interface "en0", see https://developer.apple.com/devcenter/mac/documents/validating.html #if true // This version uses the CoreFoundation and IOKit classes from https://github.com/macoslib/macoslib dim mac as String mac = PrimaryMACAddress dim bytes() as String = mac.Split(":") if bytes.Ubound = 5 then return HexBytesToData (bytes) end if #elseif true // Use this code if you do use the MBS plugins dim mac as String = SystemInformationMBS.MACAddressString dim bytes() as String = mac.Split(":") if bytes.Ubound = 5 then return HexBytesToData (bytes) end if #elseif TargetMacOS // Use this code if you do NOT use the MBS plugins nor the CoreFoundation and IOKit classes dim sh as new Shell sh.Execute "/sbin/ifconfig en0" dim s as String s = sh.Result dim lines() as String lines = ReplaceLineEndings(s,chr(13)).Split(chr(13)) for each line as String in lines dim p as Integer line = line.Trim p = line.InStr("ether ") if p = 1 then dim mac as String = line.NthField(" ",2) dim bytes() as String = mac.Split(":") if bytes.Ubound = 5 then return HexBytesToData (bytes) end if end if next #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function HexBytesToData(bytes() as String) As MemoryBlock dim mb as new MemoryBlock(6) for i as Integer = 0 to 5 mb.Byte(i) = Val("&h"+bytes(i)) next return mb End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function IsValid(guid as String, receipt as Dictionary, bundleID as String) As Boolean // Returns true if the given receipt (which comes from 'ReadReceipt') is valid // for the given GUID (which is a unique code for a particular machine) #if TargetMacOS declare sub SHA1 lib "/usr/lib/libcrypto.dylib" (d as Ptr, n as Int32, md as Ptr) if receipt <> nil then dim input as MemoryBlock input = guid + receipt.Value(Keys.kReceiptOpaqueValue) + receipt.Value(Keys.kReceiptBundleIdentiferData) dim hash as new MemoryBlock(20) ' SHA_DIGEST_LENGTH SHA1 (input, input.Size, hash) dim hashFromReceipt as String = receipt.Value(Keys.kReceiptHash) if StrComp (hash, hashFromReceipt, 0) = 0 then return receipt.Value(Keys.kReceiptBundleIdentifer) = bundleID end if end if #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function ReadReceipt(certFile as FolderItem) As Dictionary // This function reads certain entries from the App's certification receipt file #if TargetMacOS declare function d2i_PKCS7_fp lib "/usr/lib/libcrypto.dylib" (fp as Int32, p7 as Ptr) as Ptr declare sub PKCS7_free lib "/usr/lib/libcrypto.dylib" (p7 as Ptr) declare function OBJ_obj2nid lib "/usr/lib/libcrypto.dylib" (ASN1_OBJECT as Ptr) as Int32 declare function ASN1_get_object lib "/usr/lib/libcrypto.dylib" (ByRef pp as Ptr, ByRef plength as Int32, ByRef ptag as Int32, ByRef pclass as Int32, omax as Int32) as Int32 dim result as Dictionary if certFile = nil then return nil dim bs as BinaryStream try bs = BinaryStream.Open(certFile) catch exc as RuntimeException return nil end dim fp as Int32 = bs.Handle(BinaryStream.HandleTypeFilePointer) if fp = 0 then return nil dim p7 as Ptr = d2i_PKCS7_fp (fp, nil) bs.Close bs = nil if p7 = nil then return nil // is it signed? dim nid as Int32 = OBJ_obj2nid (p7.PKCS7.type) if nid <> 22 then goto bail1 // is data? nid = OBJ_obj2nid (p7.PKCS7.d.PKCS7_SIGNED.contents.PKCS7.type) if nid <> 21 then goto bail1 dim octets as Ptr = p7.PKCS7.d.PKCS7_SIGNED.contents.PKCS7.d dim p, e as Ptr p = octets.ASN1_STRING.data dim l as Integer = octets.ASN1_STRING.length e = p + Ptr(l) dim res, type, xclass, length as Integer res = ASN1_get_object(p, length, type, xclass, e - p) if type <> 17 then goto bail1 ' V_ASN1_SET result = new Dictionary while p < e call ASN1_get_object (p, length, type, xclass, e - p) if type <> 16 then exit ' V_ASN1_SEQUENCE end dim seq_end as Ptr = p + Ptr(length) dim attr_type, attr_version as Integer // Attribute type call ASN1_get_object (p, length, type, xclass, seq_end - p) if type = 2 and length = 1 then ' V_ASN1_INTEGER attr_type = p.Byte(0) end p = p + Ptr(length) // Attribute version call ASN1_get_object (p, length, type, xclass, seq_end - p) if type = 2 and length = 1 then ' V_ASN1_INTEGER attr_version = p.Byte(0) end p = p + Ptr(length) // Only parse attributes we're interested in if ATTRS(attr_type) > ATTRS.ATTR_START and ATTRS(attr_type) < ATTRS.ATTR_END then dim key as Keys call ASN1_get_object (p, length, type, xclass, seq_end - p) if type = 4 then ' V_ASN1_OCTET_STRING // Bytes if ATTRS(attr_type) = ATTRS.BUNDLE_ID or ATTRS(attr_type) = ATTRS.OPAQUE_VALUE or ATTRS(attr_type) = ATTRS.HASH then select case ATTRS(attr_type) case ATTRS.BUNDLE_ID // This is included for hash generation key = Keys.kReceiptBundleIdentiferData case ATTRS.OPAQUE_VALUE key = Keys.kReceiptOpaqueValue case ATTRS.HASH key = Keys.kReceiptHash end select dim mb as MemoryBlock = p result.Value(key) = mb.StringValue(0, length) end // Strings if ATTRS(attr_type) = ATTRS.BUNDLE_ID or ATTRS(attr_type) = ATTRS.VERSION then dim str_type, str_length as Integer dim str_p as Ptr = p call ASN1_get_object (str_p, str_length, str_type, xclass, seq_end - str_p) if str_type = 12 then ' V_ASN1_UTF8STRING dim mb as MemoryBlock = str_p dim s as String = mb.StringValue(0,str_length).DefineEncoding(Encodings.UTF8) select case ATTRS(attr_type) case ATTRS.BUNDLE_ID key = Keys.kReceiptBundleIdentifer case ATTRS.VERSION key = Keys.kReceiptVersion end select result.Value(key) = s end end end p = p + Ptr(length) end if // Skip any remaining fields in this SEQUENCE while p < seq_end call ASN1_get_object (p, length, type, xclass, seq_end - p) p = p + Ptr(length) wend wend bail1: PKCS7_free (p7) return result #endif End Function #tag EndMethod #tag Note, Name = About This module contains methods that help checking a receipt file as it's used with applications delivered by Apple's App Store. Original (i.e. up-to-date) sources are located here: https://github.com/macoslib/macoslib Written by Thomas Tempelmann, 31 Oct 2010 Last update: 25 Nov 2012 (Usage note updated to use AppStoreReceiptDirectory function on 10.7 and later) #tag EndNote #tag Note, Name = Usage IsValid: Call CertTools.IsValid, passing the results from CertTools.DeviceGUID and CertTools.ReadReceipt to it. If it returns false, this means that the app was not certified to run on this particular computer (App Store apps are certified per machine). In order to tell Mac OS X about this fact, exit the app with the exit code 173, which should then lead to the user being asked to re-certify this app for this computer (which will probably ask the user for his iTunes login, then checking if he has purchased the app from the store and thus is a valid user) ReadReceipt: Pass the location of the receipt file, which gets stored (by the App Store delivery code) inside your app in "Contents/_MASReceipt/". Example: dim f as FolderItem if IsLion then f = NSBundle.MainBundle.AppStoreReceiptDirectory() else f = App.ExecutableFile.Parent.Parent // "Contents" folder f = f.Child("_MASReceipt").Child("receipt") // this is where the App Store puts the receipt when "buying" an app end if not CertTools.IsValid (CertTools.DeviceGUID, CertTools.ReadReceipt(f), "put the App's Application Identifier here") then declare sub exit_ lib "System" alias "exit" (code as Integer) exit_ (173) end Tips: Be aware that a cracker might attempt to disable your checking code so that he can make your app run on any computer, then distribute either the cracking code or your app thru other channels. In general, a good cracker will find ways to accomplish this, and you can't do anything about it. So better accept this possibility right now. However, here are some hints as to how to make it not too easy for a casual or lazy cracker: • Rename the module and its functions, possibly to names that do not hint at their purpose. That makes it harder for a cracker to even find the functions he needs to patch. (Note: the method and module names may appear in the generated code, while local variables don't, so do not bother renaming the variables - but to be sure better look at the generated code, e.g. with the "nm" command line too.) • In a similar way, avoid having the code that decides to exit the app be very close to the call that calls IsValid. Instead, call the various functions in different places so that a cracker has a hard time to find the place where the actual test of the receipt takes place. For instance, he might start looking at the code that calls the exit function, so make sure that's not the only place where an invalid receipt is acted upon. Better to modify some other globals in your app after calling IsValid, and use some effect of these globals later to decide whether to exit the app. That way, the cracker can find the exit call, but that's long after your app has already gotten into a state where it won't function any more. So the cracker would have to do a lot of backtracing to find the code that actually makes the receipt check and decision thereupon. #tag EndNote #tag Structure, Name = ASN1_STRING, Flags = &h21 length as Int32 type as Int32 data as Ptr flags as Int32 #tag EndStructure #tag Structure, Name = PKCS7, Flags = &h21 asn1 as CString length as Int32 state as Int32 detached as Int32 type as Ptr d as Ptr #tag EndStructure #tag Structure, Name = PKCS7_SIGNED, Flags = &h21 version as Ptr md_algs as Ptr cert as Ptr crl as Ptr signer_info as Ptr contents as Ptr #tag EndStructure #tag Enum, Name = ATTRS, Type = Integer, Flags = &h21 zero ATTR_START BUNDLE_ID VERSION OPAQUE_VALUE HASH ATTR_END #tag EndEnum #tag Enum, Name = Keys, Type = Integer, Flags = &h1 kReceiptBundleIdentifer kReceiptBundleIdentiferData kReceiptVersion kReceiptOpaqueValue kReceiptHash #tag EndEnum #tag ViewBehavior #tag ViewProperty Name="Index" Visible=true Group="ID" InitialValue="-2147483648" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Module #tag EndModule
\ No newline at end of file
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment