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
......
#tag Class Protected Class IdleLogout Inherits Application #tag Event Sub Open() Dim debugFileName as string Dim theDate as date dim mXMLtreeToFollow(-1) as string dim mPrefKeyFoundData(-1) as string dim mTempFoundPlistData as string = "" // Local variable to use for gathering plist settings theDate = new Date Globals.gAppFolderItem = GetFolderItem("/Users/Shared/", FolderItem.PathTypeShell) if Globals.gAppFolderItem.Exists = false then Globals.gAppFolderItem = GetFolderItem("/tmp/", FolderItem.PathTypeShell) MsgBox "Can't find /Users/Shared! Using /tmp/ for logs" end // Set the name of the log debugFileName = "psuIdleLogout.RUN" + MiscMethods.PadData("0",2,str(theDate.Year),Globals.kLogToFileDisable) _ + "-" + MiscMethods.PadData("0",2,str(theDate.Month),Globals.kLogToFileDisable) + "-" debugFileName = debugFileName + MiscMethods.PadData("0",2,str(theDate.Day),Globals.kLogToFileDisable) + _ "-" + MiscMethods.PadData("0",2,str(theDate.Hour),Globals.kLogToFileDisable) + "-" debugFileName = debugFileName + MiscMethods.PadData("0",2,str(theDate.Minute),Globals.kLogToFileDisable) + _ "-" + MiscMethods.PadData("0",2,str(theDate.Second),Globals.kLogToFileDisable) + ".log" // Initilize the log, quit if we can't create the log if not (LogToFile.Initialize(debugFileName,Globals.gAppFolderItem)) then beep MsgBox "Error creating run log file! Exiting..." quit end if // Keep only the last 5 logs if ( LogToFile.DeleteOldLogs(5) ) then LogToFile("Deleted Old Logs") end if // CFPref calls 'dim ComputerIdleAfterNumSeconds as Integer = "900" 'dim IdleLoopDelaySeconds as Integer = "60" 'dim WaitForUserPromptSeconds = "90" // Set version number in pref file // prefs.Value ("version") = App.pAppVersion // dim AppVersionPref as String = prefs.Value("version", App.pAppVersion) // Get version from plist file 'dim ComputerIdleAfterNumSecondsPref as string = prefs.Value("ComputerIdleAfterNumSeconds", App.pComputerIdleAfterNumSeconds) 'dim IdleLoopDelaySecondsPref as string = prefs.Value("IdleLoopDelaySeconds", App.pIdleLoopDelaySeconds) 'dim WaitForUserPromptSecondsPref as string = prefs.Value("WaitForUserPromptSeconds", App.pWaitForUserPromptSeconds) ' 'LogToFile("CFPrefs Return of ComputerIdleAfterNumSeconds: " + ComputerIdleAfterNumSecondsPref ) // Are there any users that we should ignore running for? if ( PlistHelper.readPlist(pDefaultPrefsFSPath, pDefaultPrefsFileName, "IgnoreUser", mTempFoundPlistData ) ) then pIgnoreUser = mTempFoundPlistData LogToFile(CurrentMethodName + ": Found the default key data, = " + str(pIgnoreUser) ) else // Failed! LogToFile(CurrentMethodName + ": Warning! Failed to find the default key 'IgnoreUser', using default of "+ str (pIgnoreUser) ) end if // Are there any groups that we should ignore running for? if ( PlistHelper.readPlist(pDefaultPrefsFSPath, pDefaultPrefsFileName, "IgnoreGroup", mTempFoundPlistData ) ) then pIgnoreGroup = mTempFoundPlistData LogToFile(CurrentMethodName + ": Found the default key data, = " + str(pIgnoreGroup) ) else // Failed! LogToFile(CurrentMethodName + ": Warning! Failed to find the default key 'IgnoreGroup', using default of "+ str (pIgnoreGroup) ) end if // Is this user macadmin? if ( MiscMethods.CurrentUsername(pIgnoreUser) ) then // It is macadmin, quit the app LogToFile("Current user is " + pIgnoreUser + ", quiting app") quit else LogToFile("User is not " + pIgnoreUser + ", continuing") end if // Is this user an admin? if ( MiscMethods.CurrentGroup(pIgnoreGroup) ) then // It is macadmin, quit the app LogToFile("Current user is an " + pIgnoreGroup + ", quiting app") quit else LogToFile("User is not an " + pIgnoreGroup + ", continuing") end if // What should the Title Be in the Popup Window if ( PlistHelper.readPlist(pDefaultPrefsFSPath, pDefaultPrefsFileName, "WindowTitle", mTempFoundPlistData ) ) then LogoutWarning.WarningTitle.setString(str(mTempFoundPlistData)) LogToFile(CurrentMethodName + ": Found the default key data, = " + str(mTempFoundPlistData) ) else // Failed! LogToFile(CurrentMethodName + ": Warning! Failed to find the default key 'WindowTitle', using default of "+ str(LogoutWarning.WarningTitle.Text)) end if // How long should we wait before considering the Mac is idle too long? if ( PlistHelper.readPlist(pDefaultPrefsFSPath, pDefaultPrefsFileName, "ComputerIdleAfterNumSeconds", mTempFoundPlistData ) ) then pComputerIdleAfterNumSeconds = val( mTempFoundPlistData ) LogToFile(CurrentMethodName + ": Found the default key data, = " + str(pComputerIdleAfterNumSeconds) ) else // Failed! LogToFile(CurrentMethodName + ": Warning! Failed to find the default key 'ComputerIdleAfterNumSeconds', using default of "+ str (pComputerIdleAfterNumSeconds) ) end if // How often should we check to see how long the Mac has been idle? if ( PlistHelper.readPlist(pDefaultPrefsFSPath, pDefaultPrefsFileName, "IdleLoopDelaySeconds", mTempFoundPlistData ) ) then pIdleLoopDelaySeconds = val( mTempFoundPlistData ) LogToFile(CurrentMethodName + ": Found the default key data, = " + str(pIdleLoopDelaySeconds) ) else // Failed! LogToFile(CurrentMethodName + ": Warning! Failed to find the default key 'IdleLoopDelaySeconds', using default of "+ str (pIdleLoopDelaySeconds) ) end if // How long should we wait for the user to respond for More Time or to Log Out? if ( PlistHelper.readPlist(pDefaultPrefsFSPath, pDefaultPrefsFileName, "WaitForUserPromptSeconds", mTempFoundPlistData ) ) then pWaitForUserPromptSeconds = val( mTempFoundPlistData ) LogToFile(CurrentMethodName + ": Found the default key data, = " + str(pWaitForUserPromptSeconds) ) else // Failed! LogToFile(CurrentMethodName + ": Warning! Failed to find the default key 'WaitForUserPromptSeconds', using default of "+ str (pWaitForUserPromptSeconds) ) end if // Hide window from view at start LogoutWarning.Hide() // Start IdleThread LogToFile(CurrentMethodName + ": Running IdleThread") // start thread to watch for idle StartIdleWatch() // exit app now LogToFile(CurrentMethodName + ": <---") End Sub #tag EndEvent #tag Method, Flags = &h0 Sub forceLogout() LogToFile(CurrentMethodName + ": --->") // Testing mode, use say instead of logout Dim s As Shell s=New Shell dim ShellResults as string s.Mode = 0 // Log LogToFile(CurrentMethodName + ": START Killing Apps") // kill the apps that are open from /Apps LogToFile(CurrentMethodName + ": Killing all launched from /Applications") // s.Execute("kill -9 `ps axxx | grep ""/Applications"" | awk '{print $1}'`") ShellResults = s.Result LogToFile(CurrentMethodName + ": App Kill Results: " + ShellResults) // Kill PSU specific Applescript that can cause issues LogToFile(CurrentMethodName + ": Killing the psuStartupManger") //s.Execute("kill -9 `ps axxx | grep ""/Library/CLMshared/Startup Items/psuStartupManager.app"" |grep applet | awk '{print $1}'`") ShellResults = s.Result LogToFile(CurrentMethodName + ": StartupManager Kill Results: " + ShellResults) // Log out our user with force LogToFile(CurrentMethodName + ": Tell AppleScript to log it out") // New method to logout with osascript. //s.Execute("osascript -e 'tell application ""System Events"" to keystroke ""q"" using {command down, shift down, option down}'") ShellResults = s.Result LogToFile(CurrentMethodName + ": LogOut AS Results: " + ShellResults) // Log and quit LogToFile(CurrentMethodName + ": <---") Quit End Sub #tag EndMethod #tag Method, Flags = &h0 Function IdleSeconds() As Integer // Set up variables for idle time // Shell result Dim mIdleSecs As String // Shell exit code Dim merrCode As Integer // Set up shell Dim s As Shell s=New Shell s.Mode = 0 // Check idle time //s.Execute code to check idle time from USB input devices s.Execute "/bin/echo $((`/usr/sbin/ioreg -c IOHIDSystem | /usr/bin/sed -e '/HIDIdleTime/ !{ d' -e 't' -e '}' -e 's/.* = //g' -e 'q'` / 1000000000))" // Set results to mIdleResult mIdleSecs = s.Result // Set error code to mIdleError merrCode = s.ErrorCode // Log mIdleResult for debugging // System.Log(System.LogLevelError, "Method: " + midleSecs) // LogToFile("mIdleSeconds: " + str(mIdleSecs)) Return val(mIdleSecs) End Function #tag EndMethod #tag Method, Flags = &h0 Function makeFolder(mkdirPath As string) As Boolean // Set up variables for idle time // Shell result = mkdirPath // Shell exit code Dim merrCode As Integer // Set up shell Dim s As Shell s=New Shell s.Mode = 0 // Check idle time //s.Execute code to check idle time from USB input devices s.Execute "mkdir -p /Users/Shared" // Set results to mIdleResult mkdirPath = s.Result // Set error code to mIdleError merrCode = s.ErrorCode // Log mIdleResult for debugging // System.Log(System.LogLevelError, "Method: " + midleSecs) // LogToFile("mIdleSeconds: " + str(mIdleSecs)) if mkdirPath = "0" then return true else return false end End Function #tag EndMethod #tag Method, Flags = &h0 Function RemoteControlCheck() As Boolean // Set up variables for idle time Dim stablished as String = "ESTABLISHED" // Shell result Dim rccheck As String // Shell exit code Dim merrCode As Integer // Set up shell Dim s As Shell s=New Shell s.Mode = 0 // Check idle time //s.Execute code to check for connection s.Execute "/usr/sbin/netstat -n | /usr/bin/grep '.5900'| /usr/bin/awk '{print $6}'" // Set results to rccheck // Make the entire returned text uppercase in case Apple ever changes the case to CaMeL CaSe, which would break our code: rccheck = Uppercase(s.Result) //LogToFile("rccheck: " + rccheck) // Set error code to merrCode merrCode = s.ErrorCode // LogToFile("rccheck: "+ rccheck) // LogToFile("stablished: "+ stablished) If ( InStr( rccheck, stablished ) > 0 ) then return true else //LogToFile("rccheck: false") return false End if // System.Log(System.LogLevelError, "Method: " + midleSecs) // LogToFile("mIdleSeconds: " + str(mIdleSecs)) End Function #tag EndMethod #tag Method, Flags = &h0 Sub StartIdleWatch() // if the new WatchForIdleThread is not created, do it now if ( pWatchForIdleThread = nil ) then // instatiate new thread with enumerated type pWatchForIdleThread = _ new WatchForIdleThread(Int32(eTaskType.StartIdleWatch )) // add custom methods for run and finished handlers AddHandler pWatchForIdleThread.Run, WeakAddressOf Thread_WaitForIdleTime AddHandler pWatchForIdleThread.Finished, WeakAddressOf Thread_Finished end if // Run the thread if it's not already running: if ( pWatchForIdleThread.State <> Thread.Running ) then // Hide window during idle watch LogoutWarning.Hide() // Set label to default countdown time LogoutWarning.TimeLabel.setString(str(pWaitForUserPromptSeconds)) // run the new thread pWatchForIdleThread.Run end if End Sub #tag EndMethod #tag Method, Flags = &h0 Sub StartUserCountDown() // if the new WatchForIdleThread is not created, do it now if ( pIdleCountDownThread = nil ) then // instatiate new thread with enumerated type pIdleCountDownThread = _ new WatchForIdleThread(Int32(eTaskType.StartUserCountDown )) // add custom methods for run and finished handlers AddHandler pIdleCountDownThread.Run, WeakAddressOf Thread_WaitForUserInput AddHandler pIdleCountDownThread.Finished, WeakAddressOf Thread_Finished end if // Run the thread if it's not already running if ( pIdleCountDownThread.State <> Thread.Running ) then // run the new thread pIdleCountDownThread.Run end if End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub Thread_Finished(paramThread as WatchForIdleThread) LogToFile(CurrentMethodName + ": --->") // Kill the thread that was used to get here paramThread.Kill // Found out which thread just finished select case Int32 ( paramThread.pTaskType ) // If the StartIdleWatch thread just finished case int32( eTaskType.StartIdleWatch ) // LogToFile(CurrentMethodName + ": Idle time has expired.") // Show Login Window LogoutWarning.Show() // start logout countdown window StartUserCountDown() case int32 ( eTaskType.StartUserCountDown ) // LogToFile(CurrentMethodName + ": No user response from countdown.") // LogToFile(CurrentMethodName + ": LogoutWarning.pMoreTimeAskedFor = " +str(pMoreTimeAskedFor)) // If the user (or anyone) asked for more time if (pMoreTimeAskedFor) then // if the user asks for more time, start the idle watch thread again // Restart Idle Watch StartIdleWatch() else // if the user ran out of time, start the logout // kill user logins forceLogout() end if else end select End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub Thread_WaitForIdleTime(paramThread as WatchForIdleThread) // Set up new integer to store idle seconds Dim mIdleResult As Integer // get current idle seconds mIdleResult = IdleSeconds() // LogToFile(CurrentMethodName + " Idle Seconds: " + str(mIdleResult)) // LogToFile(CurrentMethodName + " waiting for " + str(LogoutWarning.pComputerIdleAfterNumSeconds)) // While our idle result is less than max time while ( mIdleResult < pComputerIdleAfterNumSeconds ) // Wait pIdleLoopDelaySeconds each loop App.SleepCurrentThread( pIdleLoopDelaySeconds * 1000 ) // Check idle time: mIdleResult = IdleSeconds() // Log our time idle LogToFile(CurrentMethodName + ": Idle Seconds: " + str(mIdleResult)) wend // while there is a ARD/VNC session, don't idle out (netstat -n | grep '.5900') while (RemoteControlCheck() ) // Wait pIdleLoopDelaySeconds each loop App.SleepCurrentThread( pIdleLoopDelaySeconds * 1000 ) // Log LogToFile(CurrentMethodName + ": Someone is controlling via ARD/VNC, waiting...") wend // When there is not remote control LogToFile(CurrentMethodName + ": No one is controlling via ARD/VNC, continuing...") End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub Thread_WaitForUserInput(paramThread as WatchForIdleThread) LogToFile(CurrentMethodName + ": --->") // Set how long to wait before logging out user, set from global variable for LogOutDelay Dim pLogoutDelay as Integer = pWaitForUserPromptSeconds // While we're waiting for the countdown to finish... While pLogoutDelay >= 0 // LogToFile(CurrentMethodName + "Time Left: " + str(pLogoutDelay)) // Set global variable to the time left pCountDownTime = pLogoutDelay // call updateUI to set countdown label pIdleCountDownThread.UpdateUI() // take a second away from the time left pLogoutDelay = pLogoutDelay - 1 // do nothing for 1 second App.SleepCurrentThread( 1000 ) // sleep 1 second Wend // If we're here, the user didn't cancel or log out manaully // user did not ask for more time pMoreTimeAskedFor = false // Log LogToFile(CurrentMethodName + ": Time Out for Response. Log User Out...") // Done here LogToFile(CurrentMethodName + ": <---") // Return to Thread_Finished End Sub #tag EndMethod #tag Note, Name = Icon Application Icon use with CC license: From http://www.flickr.com/photos/23453447@N02/5107438855/sizes/o/in/photostream/ By zyrquel http://www.flickr.com/photos/23453447@N02/ #tag EndNote #tag Property, Flags = &h0 pAppVersion As String = "2.0" #tag EndProperty #tag Property, Flags = &h0 pComputerIdleAfterNumSeconds As Integer = 900 #tag EndProperty #tag Property, Flags = &h0 pCountDownTime As Integer #tag EndProperty #tag Property, Flags = &h0 pDefaultPrefsFileName As String = "edu.psu.its.clc.IdleLogoutSettings.plist" #tag EndProperty #tag Property, Flags = &h0 pDefaultPrefsFSPath As String = "/Library/CLMadmin/Config/" #tag EndProperty #tag Property, Flags = &h0 pIdleCountDownThread As WatchForIdleThread #tag EndProperty #tag Property, Flags = &h0 pIdleLoopDelaySeconds As Integer = 60 #tag EndProperty #tag Property, Flags = &h0 pIgnoreGroup As String = "admin" #tag EndProperty #tag Property, Flags = &h0 pIgnoreUser As String = "macadmin" #tag EndProperty #tag Property, Flags = &h0 pMoreTimeAskedFor As Boolean = true #tag EndProperty #tag Property, Flags = &h0 pWaitForUserPromptSeconds As Integer = 90 #tag EndProperty #tag Property, Flags = &h0 pWatchForIdleThread As WatchForIdleThread #tag EndProperty #tag Constant, Name = kEditClear, Type = String, Dynamic = False, Default = \"&Delete", Scope = Public #Tag Instance, Platform = Windows, Language = Default, Definition = \"&Delete" #Tag Instance, Platform = Linux, Language = Default, Definition = \"&Delete" #tag EndConstant #tag Constant, Name = kFileQuit, Type = String, Dynamic = False, Default = \"&Quit", Scope = Public #Tag Instance, Platform = Windows, Language = Default, Definition = \"E&xit" #tag EndConstant #tag Constant, Name = kFileQuitShortcut, Type = String, Dynamic = False, Default = \"", Scope = Public #Tag Instance, Platform = Mac OS, Language = Default, Definition = \"Cmd+Q" #Tag Instance, Platform = Linux, Language = Default, Definition = \"Ctrl+Q" #tag EndConstant #tag Enum, Name = eTaskType, Type = Int32, Flags = &h0 StartIdleWatch StartUserCountDown #tag EndEnum #tag ViewBehavior #tag ViewProperty Name="pAppVersion" Group="Behavior" InitialValue="1.1" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pComputerIdleAfterNumSeconds" Group="Behavior" InitialValue="900" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="pCountDownTime" Group="Behavior" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="pDefaultPrefsFileName" Group="Behavior" InitialValue="edu.psu.its.clc.IdleLogoutSettings.plist" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pDefaultPrefsFSPath" Group="Behavior" InitialValue="/Library/CLMadmin/Config/" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pIdleLoopDelaySeconds" Group="Behavior" InitialValue="60" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="pIgnoreGroup" Group="Behavior" InitialValue="admin" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pIgnoreUser" Group="Behavior" InitialValue="macadmin" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pMoreTimeAskedFor" Group="Behavior" InitialValue="true" Type="Boolean" #tag EndViewProperty #tag ViewProperty Name="pWaitForUserPromptSeconds" Group="Behavior" InitialValue="90" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Class #tag EndClass
\ No newline at end of file
#tag Class Protected Class IdleLogout Inherits Application #tag Event Sub Open() Dim debugFileName as string Dim theDate as date dim mXMLtreeToFollow(-1) as string dim mPrefKeyFoundData(-1) as string dim mTempFoundPlistData as string = "" // Local variable to use for gathering plist settings theDate = new Date Globals.gAppFolderItem = GetFolderItem("/Users/Shared/", FolderItem.PathTypeShell) if Globals.gAppFolderItem.Exists = false then Globals.gAppFolderItem = GetFolderItem("/tmp/", FolderItem.PathTypeShell) MsgBox "Can't find /Users/Shared! Using /tmp/ for logs" end // Set the name of the log debugFileName = "psuIdleLogout.RUN" + MiscMethods.PadData("0",2,str(theDate.Year),Globals.kLogToFileDisable) _ + "-" + MiscMethods.PadData("0",2,str(theDate.Month),Globals.kLogToFileDisable) + "-" debugFileName = debugFileName + MiscMethods.PadData("0",2,str(theDate.Day),Globals.kLogToFileDisable) + _ "-" + MiscMethods.PadData("0",2,str(theDate.Hour),Globals.kLogToFileDisable) + "-" debugFileName = debugFileName + MiscMethods.PadData("0",2,str(theDate.Minute),Globals.kLogToFileDisable) + _ "-" + MiscMethods.PadData("0",2,str(theDate.Second),Globals.kLogToFileDisable) + ".log" // Initilize the log, quit if we can't create the log if not (LogToFile.Initialize(debugFileName,Globals.gAppFolderItem)) then beep MsgBox "Error creating run log file! Exiting..." quit end if // Keep only the last 5 logs if ( LogToFile.DeleteOldLogs(5) ) then LogToFile("Deleted Old Logs") end if // Get App Prefs Prefs = new TTsSmartPreferences("edu.psu.idlelogout") // Check for the user to ignore pIgnoreUser = Prefs.Value("IgnoreUser", "macadmin") // Check the group to ignore pIgnoreGroup = Prefs.Value ("IgnoreGroup", "admin") // How long should we wait before considering the Mac is idle too long? pComputerIdleAfterNumSeconds = Prefs.Value("ComputerIdleAfterNumSeconds", 600) // How often should we check to see how long the Mac has been idle? pIdleLoopDelaySeconds = Prefs.Value("IdleLoopDelaySeconds", 30) // How long should we wait for the user to respond for More Time or to Log Out? pWaitForUserPromptSeconds = Prefs.Value("WaitForUserPromptSeconds",90) // What should we display on the popup window text pWindowMessage = Prefs.Value("WindowMessage",pWindowMessage) // Update Window Message LogoutWarning.WarningMessage.setString(pWindowMessage) // What should the Title Be in the Popup Window pWindowTitle = Prefs.Value("WindowTitle","Idle Logout Alert") // Update Window Title LogoutWarning.WarningTitle.setString(pWindowTitle) // Set Values in the Plist 'Prefs.Value("IgnoreUser") = pIgnoreUser 'Prefs.Value ("IgnoreGroup") = pIgnoreGroup 'Prefs.Value("ComputerIdleAfterNumSeconds") = pComputerIdleAfterNumSeconds 'Prefs.Value("IdleLoopDelaySeconds") = pIdleLoopDelaySeconds 'Prefs.Value("WaitForUserPromptSeconds") = pWaitForUserPromptSeconds 'Prefs.Value("WindowMessage") = pWindowMessage 'Prefs.Value("WindowTitle") = pWindowTitle 'Prefs.Sync LogToFile(CurrentMethodName + ": Received user exception, = " + str(pIgnoreUser) ) LogToFile(CurrentMethodName + ": Received group exception = " + str(pIgnoreGroup) ) LogToFile(CurrentMethodName + ": Received ComputerIdleAfterNumSeconds = " + str(pComputerIdleAfterNumSeconds) ) LogToFile(CurrentMethodName + ": Received IdleLoopDelaySecond, = " + str(pIdleLoopDelaySeconds) ) LogToFile(CurrentMethodName + ": Received WaitForUserPromptSeconds = " + str(pWaitForUserPromptSeconds) ) // Is this user macadmin? if ( MiscMethods.CurrentUsername(pIgnoreUser) ) then // It is macadmin, quit the app LogToFile("Current user is " + pIgnoreUser + ", quiting app") quit else LogToFile("User is not " + pIgnoreUser + ", continuing") end if // Is this user an admin? if ( MiscMethods.CurrentGroup(pIgnoreGroup) ) then // It is macadmin, quit the app LogToFile("Current user is an " + pIgnoreGroup + ", quiting app") quit else LogToFile("User is not an " + pIgnoreGroup + ", continuing") end if // Hide window from view at start LogoutWarning.Hide() // Start IdleThread LogToFile(CurrentMethodName + ": Running IdleThread") // start thread to watch for idle StartIdleWatch() // exit app now LogToFile(CurrentMethodName + ": <---") End Sub #tag EndEvent #tag Method, Flags = &h0 Sub forceLogout() LogToFile(CurrentMethodName + ": --->") // Testing mode, use say instead of logout Dim s As Shell s=New Shell dim ShellResults as string s.Mode = 0 // Log LogToFile(CurrentMethodName + ": START Killing Apps") // kill the apps that are open from /Apps LogToFile(CurrentMethodName + ": Killing all launched from /Applications") s.Execute("kill -9 `ps axxx | grep ""/Applications"" | awk '{print $1}'`") ShellResults = s.Result LogToFile(CurrentMethodName + ": App Kill Results: " + ShellResults) // Kill PSU specific Applescript that can cause issues // Removed for 2016 'LogToFile(CurrentMethodName + ": Killing the psuStartupManger") 's.Execute("kill -9 `ps axxx | grep ""/Library/CLMshared/Startup Items/psuStartupManager.app"" |grep applet | awk '{print $1}'`") 'ShellResults = s.Result 'LogToFile(CurrentMethodName + ": StartupManager Kill Results: " + ShellResults) // Log out our user with force LogToFile(CurrentMethodName + ": Tell AppleScript to log it out") // New method to logout with osascript. s.Execute("osascript -e 'tell application ""System Events"" to keystroke ""q"" using {command down, shift down, option down}'") ShellResults = s.Result LogToFile(CurrentMethodName + ": LogOut AS Results: " + ShellResults) // Log and quit LogToFile(CurrentMethodName + ": <---") End Sub #tag EndMethod #tag Method, Flags = &h0 Function IdleSeconds() As Integer // Set up variables for idle time // Shell result Dim mIdleSecs As String // Shell exit code Dim merrCode As Integer // Set up shell Dim s As Shell s=New Shell s.Mode = 0 // Check idle time //s.Execute code to check idle time from USB input devices s.Execute "/bin/echo $((`/usr/sbin/ioreg -c IOHIDSystem | /usr/bin/sed -e '/HIDIdleTime/ !{ d' -e 't' -e '}' -e 's/.* = //g' -e 'q'` / 1000000000))" // Set results to mIdleResult mIdleSecs = s.Result // Set error code to mIdleError merrCode = s.ErrorCode // Log mIdleResult for debugging // System.Log(System.LogLevelError, "Method: " + midleSecs) // LogToFile("mIdleSeconds: " + str(mIdleSecs)) Return val(mIdleSecs) End Function #tag EndMethod #tag Method, Flags = &h0 Function makeFolder(mkdirPath As string) As Boolean // Set up variables for idle time // Shell result = mkdirPath // Shell exit code Dim merrCode As Integer // Set up shell Dim s As Shell s=New Shell s.Mode = 0 // Check idle time //s.Execute code to check idle time from USB input devices s.Execute "mkdir -p /Users/Shared" // Set results to mIdleResult mkdirPath = s.Result // Set error code to mIdleError merrCode = s.ErrorCode // Log mIdleResult for debugging // System.Log(System.LogLevelError, "Method: " + midleSecs) // LogToFile("mIdleSeconds: " + str(mIdleSecs)) if mkdirPath = "0" then return true else return false end End Function #tag EndMethod #tag Method, Flags = &h0 Function RemoteControlCheck() As Boolean // Set up variables for idle time Dim stablished as String = "ESTABLISHED" // Shell result Dim rccheck As String // Shell exit code Dim merrCode As Integer // Set up shell Dim s As Shell s=New Shell s.Mode = 0 // Check idle time //s.Execute code to check for connection s.Execute "/usr/sbin/netstat -n | /usr/bin/grep '.5900'| /usr/bin/awk '{print $6}'" // Set results to rccheck // Make the entire returned text uppercase in case Apple ever changes the case to CaMeL CaSe, which would break our code: rccheck = Uppercase(s.Result) //LogToFile("rccheck: " + rccheck) // Set error code to merrCode merrCode = s.ErrorCode // LogToFile("rccheck: "+ rccheck) // LogToFile("stablished: "+ stablished) If ( InStr( rccheck, stablished ) > 0 ) then return true else //LogToFile("rccheck: false") return false End if // System.Log(System.LogLevelError, "Method: " + midleSecs) // LogToFile("mIdleSeconds: " + str(mIdleSecs)) End Function #tag EndMethod #tag Method, Flags = &h0 Sub StartIdleWatch() // if the new WatchForIdleThread is not created, do it now if ( pWatchForIdleThread = nil ) then // instatiate new thread with enumerated type pWatchForIdleThread = _ new WatchForIdleThread(Int32(eTaskType.StartIdleWatch )) // add custom methods for run and finished handlers AddHandler pWatchForIdleThread.Run, WeakAddressOf Thread_WaitForIdleTime AddHandler pWatchForIdleThread.Finished, WeakAddressOf Thread_Finished end if // Run the thread if it's not already running: if ( pWatchForIdleThread.State <> Thread.Running ) then // Hide window during idle watch LogoutWarning.Hide() // Set label to default countdown time LogoutWarning.TimeLabel.setString(str(pWaitForUserPromptSeconds)) // run the new thread pWatchForIdleThread.Run end if End Sub #tag EndMethod #tag Method, Flags = &h0 Sub StartUserCountDown() // if the new WatchForIdleThread is not created, do it now if ( pIdleCountDownThread = nil ) then // instatiate new thread with enumerated type pIdleCountDownThread = _ new WatchForIdleThread(Int32(eTaskType.StartUserCountDown )) // add custom methods for run and finished handlers AddHandler pIdleCountDownThread.Run, WeakAddressOf Thread_WaitForUserInput AddHandler pIdleCountDownThread.Finished, WeakAddressOf Thread_Finished end if // Run the thread if it's not already running if ( pIdleCountDownThread.State <> Thread.Running ) then // run the new thread pIdleCountDownThread.Run end if End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub Thread_Finished(paramThread as WatchForIdleThread) LogToFile(CurrentMethodName + ": --->") // Kill the thread that was used to get here paramThread.Kill // Found out which thread just finished select case Int32 ( paramThread.pTaskType ) // If the StartIdleWatch thread just finished case int32( eTaskType.StartIdleWatch ) // LogToFile(CurrentMethodName + ": Idle time has expired.") // Show Login Window LogoutWarning.Show() // start logout countdown window StartUserCountDown() case int32 ( eTaskType.StartUserCountDown ) // LogToFile(CurrentMethodName + ": No user response from countdown.") // LogToFile(CurrentMethodName + ": LogoutWarning.pMoreTimeAskedFor = " +str(pMoreTimeAskedFor)) // If the user (or anyone) asked for more time if (pMoreTimeAskedFor) then // if the user asks for more time, start the idle watch thread again // Restart Idle Watch StartIdleWatch() else // if the user ran out of time, start the logout // kill user logins forceLogout() end if else end select End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub Thread_WaitForIdleTime(paramThread as WatchForIdleThread) // Set up new integer to store idle seconds Dim mIdleResult As Integer // get current idle seconds mIdleResult = IdleSeconds() // LogToFile(CurrentMethodName + " Idle Seconds: " + str(mIdleResult)) // LogToFile(CurrentMethodName + " waiting for " + str(LogoutWarning.pComputerIdleAfterNumSeconds)) // While our idle result is less than max time while ( mIdleResult < pComputerIdleAfterNumSeconds ) // Wait pIdleLoopDelaySeconds each loop App.SleepCurrentThread( pIdleLoopDelaySeconds * 1000 ) // Check idle time: mIdleResult = IdleSeconds() // Log our time idle LogToFile(CurrentMethodName + ": Idle Seconds: " + str(mIdleResult)) wend // while there is a ARD/VNC session, don't idle out (netstat -n | grep '.5900') while (RemoteControlCheck() ) // Wait pIdleLoopDelaySeconds each loop App.SleepCurrentThread( pIdleLoopDelaySeconds * 1000 ) // Log LogToFile(CurrentMethodName + ": Someone is controlling via ARD/VNC, waiting...") wend // When there is not remote control LogToFile(CurrentMethodName + ": No one is controlling via ARD/VNC, continuing...") End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub Thread_WaitForUserInput(paramThread as WatchForIdleThread) LogToFile(CurrentMethodName + ": --->") // Set how long to wait before logging out user, set from global variable for LogOutDelay Dim pLogoutDelay as Integer = pWaitForUserPromptSeconds // While we're waiting for the countdown to finish... While pLogoutDelay >= 0 // LogToFile(CurrentMethodName + "Time Left: " + str(pLogoutDelay)) // Set global variable to the time left pCountDownTime = pLogoutDelay // call updateUI to set countdown label pIdleCountDownThread.UpdateUI() // take a second away from the time left pLogoutDelay = pLogoutDelay - 1 // do nothing for 1 second App.SleepCurrentThread( 1000 ) // sleep 1 second Wend // If we're here, the user didn't cancel or log out manaully // user did not ask for more time pMoreTimeAskedFor = false // Log LogToFile(CurrentMethodName + ": Time Out for Response. Log User Out...") // Done here LogToFile(CurrentMethodName + ": <---") // Return to Thread_Finished End Sub #tag EndMethod #tag Note, Name = Icon Application Icon use with CC license: From http://www.flickr.com/photos/23453447@N02/5107438855/sizes/o/in/photostream/ By zyrquel http://www.flickr.com/photos/23453447@N02/ #tag EndNote #tag Note, Name = Tests New builds should be tested for: Launching Hiding Dock Icon Logging to File Reading Preferences Reading Idle Time Countdown Timer starts when idle time reached Countdown Window Shows More Time button resets the clock Log Out Button quits open apps and logs out Timer Runs out and Auto-Logs Out Remove Control Blocks logout Custom Name Custom Text #tag EndNote #tag Property, Flags = &h0 pAppVersion As String = "2.1" #tag EndProperty #tag Property, Flags = &h0 pComputerIdleAfterNumSeconds As Integer = 900 #tag EndProperty #tag Property, Flags = &h0 pCountDownTime As Integer #tag EndProperty #tag Property, Flags = &h0 pDefaultPrefsFileName As String = "edu.psu.its.clc.IdleLogoutSettings.plist" #tag EndProperty #tag Property, Flags = &h0 pDefaultPrefsFSPath As String = "/Library/CLMadmin/Config/" #tag EndProperty #tag Property, Flags = &h0 pIdleCountDownThread As WatchForIdleThread #tag EndProperty #tag Property, Flags = &h0 pIdleLoopDelaySeconds As Integer = 60 #tag EndProperty #tag Property, Flags = &h0 pIgnoreGroup As String = "admin" #tag EndProperty #tag Property, Flags = &h0 pIgnoreUser As String = "clmadmin" #tag EndProperty #tag Property, Flags = &h0 pMoreTimeAskedFor As Boolean = true #tag EndProperty #tag Property, Flags = &h0 Prefs As TTsSmartPreferences #tag EndProperty #tag Property, Flags = &h0 pWaitForUserPromptSeconds As Integer = 90 #tag EndProperty #tag Property, Flags = &h0 pWatchForIdleThread As WatchForIdleThread #tag EndProperty #tag Property, Flags = &h0 pWindowMessage As String = "'This Mac is idle. Click the ""More Time"" button to continue using the Mac. Otherwise, an automatic logout will occur and all unsaved documents will be LOST!" #tag EndProperty #tag Property, Flags = &h0 pWindowTitle As String #tag EndProperty #tag Constant, Name = kEditClear, Type = String, Dynamic = False, Default = \"&Delete", Scope = Public #Tag Instance, Platform = Windows, Language = Default, Definition = \"&Delete" #Tag Instance, Platform = Linux, Language = Default, Definition = \"&Delete" #tag EndConstant #tag Constant, Name = kFileQuit, Type = String, Dynamic = False, Default = \"&Quit", Scope = Public #Tag Instance, Platform = Windows, Language = Default, Definition = \"E&xit" #tag EndConstant #tag Constant, Name = kFileQuitShortcut, Type = String, Dynamic = False, Default = \"", Scope = Public #Tag Instance, Platform = Mac OS, Language = Default, Definition = \"Cmd+Q" #Tag Instance, Platform = Linux, Language = Default, Definition = \"Ctrl+Q" #tag EndConstant #tag Enum, Name = eTaskType, Type = Int32, Flags = &h0 StartIdleWatch StartUserCountDown #tag EndEnum #tag ViewBehavior #tag ViewProperty Name="pAppVersion" Group="Behavior" InitialValue="1.1" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pComputerIdleAfterNumSeconds" Group="Behavior" InitialValue="900" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="pCountDownTime" Group="Behavior" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="pDefaultPrefsFileName" Group="Behavior" InitialValue="edu.psu.its.clc.IdleLogoutSettings.plist" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pDefaultPrefsFSPath" Group="Behavior" InitialValue="/Library/CLMadmin/Config/" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pIdleLoopDelaySeconds" Group="Behavior" InitialValue="60" Type="Integer" #tag EndViewProperty #tag ViewProperty Name="pIgnoreGroup" Group="Behavior" InitialValue="admin" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pIgnoreUser" Group="Behavior" InitialValue="macadmin" Type="String" EditorType="MultiLineEditor" #tag EndViewProperty #tag ViewProperty Name="pMoreTimeAskedFor" Group="Behavior" InitialValue="true" Type="Boolean" #tag EndViewProperty #tag ViewProperty Name="pWaitForUserPromptSeconds" Group="Behavior" InitialValue="90" Type="Integer" #tag EndViewProperty #tag EndViewBehavior End Class #tag EndClass
\ No newline at end of file
......
#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
#tag Module Protected Module XMLDictionary #tag Method, Flags = &h21 Private Sub ClearStorage(storage As Variant) If storage.Type = 9 Then If storage.ObjectValue IsA Dictionary Then Dictionary(storage).Clear End If ElseIf storage.IsArray Then dim t as Integer = storage.ArrayElementType if t = Variant.TypeString then dim a() as String = storage redim a(-1) elseif t = Variant.TypeInteger then dim a() as Integer = storage redim a(-1) elseif t = Variant.TypeBoolean then dim a() as Boolean = storage redim a(-1) elseif t = Variant.TypeDouble then dim a() as Double = storage redim a(-1) elseif t = Variant.TypeSingle then dim a() as Single = storage redim a(-1) elseif t = Variant.TypeDate then dim a() as Date = storage redim a(-1) elseif t = Variant.TypeLong then dim a() as Int64 = storage redim a(-1) elseif t = Variant.TypeObject then dim a() as Object = storage redim a(-1) end // fallback for unknown types - if this gets a TypeMismatchException, add the missing type to another elseif/dim/return above dim a() as Variant = storage redim a(-1) End If End Sub #tag EndMethod #tag Method, Flags = &h0 Function ExportXML(Extends xmldict As Dictionary, plist As Boolean = False, indented as Boolean = true) As XmlDocument Dim xdoc As XmlDocument Dim root, dict As XmlElement xdoc = New XmlDocument If plist Then // Plist-compatible output root = XmlElement(xdoc.AppendChild(xdoc.CreateElement("plist"))) root.SetAttribute("version", PlistVersion) if xmldict.Count = 1 and xmldict.HasKey( "cfarray" ) then // It has array at its root dict = root // The root is an array so we don't create a sub-element else // The root is a dict dict = XmlElement(root.AppendChild(xdoc.CreateElement("dict"))) end if ParseStorage xmldict, dict, True, indented IndentNode root, 0, True IndentNode dict, 0, True Else root = XmlElement(xdoc.AppendChild(xdoc.CreateElement("xmldict"))) root.SetAttribute("version", CurrentVersion) ParseStorage xmldict, root, False, indented IndentNode root, 0, True End If xdoc.AppendChild(xdoc.CreateTextNode(EndOfLine)) Return xdoc End Function #tag EndMethod #tag Method, Flags = &h0 Function ExportXMLString(Extends xmldict As Dictionary, plist As Boolean = False, indented as Boolean = true) As String // Since we can't add a DOCTYPE to the XmlDocument, // lets hack this output to add it Dim s, DTD As String Dim i As Integer s = xmldict.ExportXML(plist, indented).ToString // Let's add the DTD i = s.InStr(EndOfLine) If plist Then DTD = PlistDTD Else DTD = XMLDictDTD End If s = s.Mid(1, i + Len(EndOfLine) - 1) + DTD + EndOfLine + s.Mid(i + Len(EndOfLine)) Return s End Function #tag EndMethod #tag Method, Flags = &h21 Private Sub IndentNode(node As XmlNode, level As Integer, indentCloseTag As Boolean = False) if level >= 0 then Dim i As Integer Dim s As String s = EndOfLine For i = 1 To level s = s + Chr(9) // Tab Next node.Parent.Insert(node.OwnerDocument.CreateTextNode(s), node) If indentCloseTag Then node.AppendChild(node.OwnerDocument.CreateTextNode(s)) End If end if End Sub #tag EndMethod #tag Method, Flags = &h0 Function LoadXML(Extends xmldict As Dictionary, XMLFile As FolderItem) As Boolean Dim tos As TextInputStream Dim s As String 'tos = XMLFile.OpenAsTextFile() tos = TextInputStream.Open( XMLFile ) If tos <> nil Then s = tos.ReadAll tos.Close Return xmldict.LoadXML(s) Else Return False End If End Function #tag EndMethod #tag Method, Flags = &h0 Function LoadXML(Extends xmldict As Dictionary, XMLData As String) As Boolean Dim xdoc As XmlDocument xdoc = New XmlDocument() xdoc.PreserveWhitespace = True xdoc.LoadXml(XMLData) Return xmldict.LoadXML(xdoc) Exception err As XmlException // Ugh, invalid XML Return False End Function #tag EndMethod #tag Method, Flags = &h0 Function LoadXML(Extends xmldict As Dictionary, XMLDoc As XmlDocument) As Boolean Dim node As XmlNode XMLDoc.PreserveWhitespace = True // Check to see if it's our xmldict or if it's a plist If XMLDoc.DocumentElement.Name = "plist" Then // Make sure it's a "dict" as the base type node = XMLDoc.DocumentElement.FirstChild While node.Type <> XmlNodeType.ELEMENT_NODE And node <> nil node = node.NextSibling Wend If node = nil Or ( node.Name <> "dict" and node.Name <> "array" ) Then // Modified by Kem Tekinay: PLists can have any valid type at their root, but array and dict are the most common // It's not valid Return False End If // Now check the version If Val(XMLDoc.DocumentElement.GetAttribute("version")) <= Val(PlistVersion) Then ParseXML node, xmldict, true Return True Else Return False End If Else // First, make sure the version is at most what we expect If Val(XMLDoc.DocumentElement.GetAttribute("version")) <= Val(CurrentVersion) Then ParseXML XMLDoc.DocumentElement, xmldict, true Return True Else // We can't reliably parse a higher version, so lets not parse it at all Return False End If End If Exception err As XmlException // Ugh, invalid XML Return False End Function #tag EndMethod #tag Method, Flags = &h21 Private Function NodeContents(parent As XmlNode) As String // Concatenates all the node children values and returns the result // It's designed for the children to be all text nodes, but for anything // else it'll just use .ToString Dim i, n As Integer Dim node As XmlNode Dim s As String n = parent.ChildCount - 1 For i = 0 To n node = parent.Child(i) If node.Type = 3 Then // Text node s = s + node.Value Else // Other node - shouldn't happen, but we gotta deal with it if it does s = s + node.ToString End If Next Return s End Function #tag EndMethod #tag Method, Flags = &h21 Private Sub ParseStorage(storage As Variant, parent As XmlNode, plist As Boolean, indented as Boolean) dim level as Integer if indented then level = 1 else level = -1000 end ParseStorage(storage, parent, new Dictionary, level, plist) End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub ParseStorage(storage As Variant, parent As XmlNode, alreadySeen As Dictionary, indentLevel As Integer, plist As Boolean = False) Dim key, value As Variant Dim node, tempNode As XmlNode Dim xdoc As XmlDocument Dim s, data(-1) As String Dim multilineTag As Boolean Dim i, n As Integer // First, make sure we haven't already seen this dictionary // This protects against circular dictionary references If alreadySeen.HasKey(storage) Then // We've seen this! Bail out Return End If // Ok, lets add our storage to the list alreadySeen.Value(storage) = true xdoc = parent.OwnerDocument n = StorageCount(storage) - 1 For i = 0 To n // Key key = StorageKey(storage, i) // Modified by Kem Tekinay. // Some plists will have array at the root. If such a plist is parsed by this module, // there will only be one element in the dictionary and its key will be "cfarray". // In that case, we ignore that first key. If key <> nil and ( Dictionary( storage ).Count <> 1 or key <> "cfarray" ) Then // It's a keyed storage node = parent.AppendChild(xdoc.CreateElement("key")) node.AppendChild(xdoc.CreateTextNode(key.StringValue)) IndentNode node, indentLevel End If // Value node = nil multilineTag = False value = StorageValue(storage, i) dim vType as Integer = value.Type if value.IsArray then node = xdoc.CreateElement("array") ParseStorage value, node, alreadySeen, indentLevel+1, plist multilineTag = True else Select Case vType Case 0 // Null // If it's a plist, we can't use null, so lets use false If plist Then node = xdoc.CreateElement("false") Else node = xdoc.CreateElement("null") End If Case 2 // Integer node = xdoc.CreateElement("integer") node.AppendChild(xdoc.CreateTextNode(Str(value.IntegerValue))) case 3 // Long node = xdoc.CreateElement( "integer" ) node.AppendChild( xdoc.CreateTextNode( str( value.Int64Value ) ) ) Case 5 // Double/Single node = xdoc.CreateElement("real") node.AppendChild( xdoc.CreateTextNode( value.StringValue ) ) // Modified by Kem Tekinay. Replaced str with format to prevent truncation of the value Case 7 // Date node = xdoc.CreateElement("date") dim s2 as String = value.DateValue.SQLDateTime if plist then s2 = s2.Replace(" ","T")+"Z" end node.AppendChild(xdoc.CreateTextNode(s2)) Case 8 // String node = xdoc.CreateElement("string") s = ConvertEncoding(value.StringValue, Encodings.UTF8) // Convert to UTF8 If s.Encoding = nil Then s = DefineEncoding(s, Encodings.UTF8) // If encoding was undefined, convert fails. Simply define instead node.AppendChild(xdoc.CreateTextNode(s)) Case 9 // Object // Is this a dictionary, memoryblock or folderitem? If value.ObjectValue IsA Dictionary Then // We can parse this dictionary node = xdoc.CreateElement("dict") ParseStorage Dictionary(value.ObjectValue), node, alreadySeen, indentLevel+1, plist multilineTag = True ElseIf value.ObjectValue IsA MemoryBlock Then // We can parse this memoryblock node = xdoc.CreateElement("data") data = Split(EncodeBase64(MemoryBlock(value.ObjectValue), 45), ChrB(13)+ChrB(10)) // 45 is what plists use For Each s In data tempNode = node.AppendChild(xdoc.CreateTextNode(DefineEncoding(s, Encodings.ASCII))) IndentNode tempNode, indentLevel Next multilineTag = True ElseIf value.ObjectValue IsA FolderItem And Not plist Then // We can't output this if it's plist-compatible // Do the same thing as a memoryblock, but with a different tag node = xdoc.CreateElement("file") data = Split(EncodeBase64(FolderItem(value.ObjectValue).GetSaveInfo(Nil), 45), ChrB(13)+ChrB(10)) For Each s In Data tempNode = node.AppendChild(xdoc.CreateTextNode(s)) IndentNode tempNode, indentLevel Next multilineTag = True Else // Arbitrary object? break End If Case 11 // Boolean If value.BooleanValue = True Then node = xdoc.CreateElement("true") Else node = xdoc.CreateElement("false") End If Case 16 // Color If plist Then // We can't output colors in plists // Lets just add a False node node = xdoc.CreateElement("false") Else node = xdoc.CreateElement("color") node.AppendChild(xdoc.CreateTextNode("#" + Hex(value.IntegerValue))) End If End Select end if node = nil then // Buh? We should never reach this point, but just in case, lets add a null value // However, if it's plist-compatible mode, we have to add a false value, since it doesn't support null break if plist Then node = xdoc.CreateElement("false") Else node = xdoc.CreateElement("null") End If end parent.AppendChild node // workaround for AppendChild() as XmlNode bug IndentNode node, indentLevel, multilineTag Next End Sub #tag EndMethod #tag Method, Flags = &h21 Private Sub ParseXML(parent As XmlNode, storage As Variant, firstIteration As Boolean = False) // Modified by Kem Tekinay. // Added firstIteration parameter. // Because a plist can have at its root any valid type, the first iteration of this method // has to check to see what it is. If it's anything other than "dict", it has create an initial key // that is the right type. Dim node As XmlNode Dim key As Variant Dim v As Variant Dim d As Dictionary Dim mb As MemoryBlock //ClearStorage storage if firstIteration and parent.Name <> "dict" then key = "cf" + parent.Name // Set the initial key since we aren't really starting with a dictionary. node = parent else node = parent.FirstChild end if While node <> nil // We only want to deal with element nodes // The only other type of node that *should* show up is // a text node with only whitespace. However, even if // other nodes show up, we should ignore them, since // we're not a validator If node.Type = XmlNodeType.ELEMENT_NODE Then // Element node If key = nil And node.Name = "key" Then key = NodeContents(node) Else Select Case node.Name Case "null" StoreValue key, nil, storage Case "integer" StoreValue key, Val(NodeContents(node)) \ 1, storage Case "real" StoreValue key, Val(NodeContents(node)), storage Case "date" v = NodeContents(node) if Strcomp(Right(v, 1), "Z", 0) = 0 then // plist format v = v.StringValue.Left(v.StringValue.Len-1).Replace("T", " ") end StoreValue key, v.DateValue, storage Case "string" StoreValue key, NodeContents(node), storage Case "dict" v = StorageByKey(storage, key) If v.Type = 9 And v.ObjectValue IsA Dictionary Then d = Dictionary(v.ObjectValue) Else d = New Dictionary End If ParseXML node, d StoreValue key, d, storage Case "array" dim col() as Variant ParseXML node, col StoreValue key, col, storage Case "data" // Lets parse our Base64-encoded data mb = DecodeBase64(NodeContents(node)) StoreValue key, mb, storage Case "file" // Lets parse our Base64-encoded alias data StoreValue key, GetFolderItem(DecodeBase64(NodeContents(node))), storage Case "true" StoreValue key, True, storage Case "false" StoreValue key, False, storage Case "color" v = "&h" + NodeContents(node).Mid(1) StoreValue key, v.ColorValue, storage End Select key = nil End If End If node = node.NextSibling Wend End Sub #tag EndMethod #tag Method, Flags = &h0 Function SaveXML(Extends xmldict As Dictionary, XMLFile As FolderItem, plist As Boolean = False, indented as Boolean = true) As Boolean dim txt as String = xmldict.ExportXMLString(plist, indented) if txt <> "" then 'dim bs As BinaryStream = XMLFile.CreateBinaryFile("") dim bs as BinaryStream = BinaryStream.Create( XMLFile, true ) if bs <> nil then bs.Write txt bs.Close return true end end if End Function #tag EndMethod #tag Method, Flags = &h21 Private Function StorageByKey(storage As Variant, key As Variant) As Variant // This is only valid for dictionaries // The only purpose is to make Jarvis Badgley's request work, i.e. preserve existing dictionaries If storage.Type = 9 Then If storage.ObjectValue IsA Dictionary And Dictionary(storage.ObjectValue).HasKey(key) Then Return Dictionary(storage.ObjectValue).Value(key) End If End If Return nil End Function #tag EndMethod #tag Method, Flags = &h21 Private Function StorageCount(storage As Variant) As Integer If storage.Type = 9 Then If storage.ObjectValue IsA Dictionary Then Return Dictionary(storage.ObjectValue).Count End If ElseIf storage.IsArray Then dim t as Integer = storage.ArrayElementType if t = Variant.TypeString then dim a() as String = storage return a.Ubound+1 elseif t = Variant.TypeInteger then dim a() as Integer = storage return a.Ubound+1 elseif t = Variant.TypeBoolean then dim a() as Boolean = storage return a.Ubound+1 elseif t = Variant.TypeDouble then dim a() as Double = storage return a.Ubound+1 elseif t = Variant.TypeSingle then dim a() as Single = storage return a.Ubound+1 elseif t = Variant.TypeDate then dim a() as Date = storage return a.Ubound+1 elseif t = Variant.TypeLong then dim a() as Int64 = storage return a.Ubound+1 elseif t = Variant.TypeObject then dim a() as Object = storage return a.Ubound+1 end // fallback for unknown types - if this gets a TypeMismatchException, add the missing type to another elseif/dim/return above dim a() as Variant = storage return a.Ubound+1 End If End Function #tag EndMethod #tag Method, Flags = &h21 Private Function StorageKey(storage As Variant, index As Integer) As Variant If storage.Type = 9 And storage.ObjectValue IsA Dictionary Then Return Dictionary(storage.ObjectValue).Key(index) End If Return nil End Function #tag EndMethod #tag Method, Flags = &h21 Private Function StorageValue(storage As Variant, index As Integer) As Variant If storage.Type = 9 Then If storage.ObjectValue IsA Dictionary Then dim key as Variant = Dictionary(storage.ObjectValue).Key(index) Return Dictionary(storage.ObjectValue).Value(key) End If ElseIf storage.IsArray Then dim t as Integer = storage.ArrayElementType if t = Variant.TypeString then dim a() as String = storage return a(index) elseif t = Variant.TypeInteger then dim a() as Integer = storage return a(index) elseif t = Variant.TypeBoolean then dim a() as Boolean = storage return a(index) elseif t = Variant.TypeDouble then dim a() as Double = storage return a(index) elseif t = Variant.TypeSingle then dim a() as Single = storage return a(index) elseif t = Variant.TypeDate then dim a() as Date = storage return a(index) elseif t = Variant.TypeLong then dim a() as Int64 = storage return a(index) elseif t = Variant.TypeObject then dim a() as Object = storage return a(index) end // fallback for unknown types - if this gets a TypeMismatchException, add the missing type to another elseif/dim/return above dim a() as Variant = storage return a(index) End If End Function #tag EndMethod #tag Method, Flags = &h21 Private Sub StoreValue(key As Variant, value As Variant, storage As Variant) If storage.IsArray Then dim t as Integer = storage.ArrayElementType if t = Variant.TypeString then dim a() as String = storage a.Append value return elseif t = Variant.TypeInteger then dim a() as Integer = storage a.Append value return elseif t = Variant.TypeBoolean then dim a() as Boolean = storage a.Append value return elseif t = Variant.TypeDouble then dim a() as Double = storage a.Append value return elseif t = Variant.TypeSingle then dim a() as Single = storage a.Append value return elseif t = Variant.TypeDate then dim a() as Date = storage a.Append value return elseif t = Variant.TypeLong then dim a() as Int64 = storage a.Append value return elseif t = Variant.TypeObject then dim a() as Object = storage a.Append value return end // fallback for unknown types - if this gets a TypeMismatchException, add the missing type to another elseif/dim/Append/return above dim a() as Variant = storage a.Append value ElseIf storage.Type = 9 Then If storage.ObjectValue IsA Dictionary And key <> nil Then Dictionary(storage.ObjectValue).Value(key) = value End If End If End Sub #tag EndMethod #tag Note, Name = About This is now part of the open source "MacOSLib" Original sources are located here: https://github.com/macoslib/macoslib #tag EndNote #tag Note, Name = Version History Kevin Ballard kevin@sb.org http://www.tildesoft.com/ v1.2.8: - (by Thomas Tempelmann, tempelmann@gmail.com): Got rid of Collection in favor of using real arrays v1.2.7: - (by Thomas Tempelmann, tempelmann@gmail.com): Fixed the Date format for plists v1.2.6: - Approximately tripled the speed of loading an XML file. Unfortunately, I can't do the same for saving because the Dictionary class lacks an appropriate iterator-style access so my Ishmale the Painter's algorithm is required v1.2.5: - As per Jarvis Badgley's request, made it now respect existing dictionaries. This means that if you create a set of nested dictionaries that corresponds to the plist structure, when parsing the plist it will use the existing dictionaries rather than overwriting with its own. Of course, this is not valid when parsing an array in the plist. The main purpose of this is to set up default values before parsing the plist. Note: This means I no longer clear the dictionary when I parse the XML file. If you want to keep the old behaviour, do a Dictionary.clear before parsing the XML file v1.2.4: - Made line endings use EndOfLine instead of linefeed - Removed some commented-out code left over from the 5.5.1fc1 hack v1.2.3: - Removed said hack, due to fix in 5.5.1fc4. If you're using 5.5.1fc1-fc3, upgrade v1.2.2: - Added a hack to work around the XmlDocument.AppendChild() As XmlNode bug present in 5.5.1fc1 - If you pass a variant of an unknown type (something that should never happen), it now outputs "false" instead of "null" in plist-compatible mode v1.2.1: - Fixed bug where plist-compatible mode wasn't preserved in nested dictionaries/collections - Fixed plist-compatible mode so that colors are now output as False instead (since plist doesn't support the color type) v1.2: - Fixed double output to use Format() instead of Str() - SaveXML now sets file type/creator to "" instead of using the text filetype - Can now parse plist files - Can now save as plist files with an option boolean to all the export/save methods v1.1: - Added support for Collections as a replacement for lack of array support Note that keys in Collections are not preserved - Ugraded version attribute of resulting document to "1.1" - previous versions of XMLDictionary won't read new documents - When adding a string value to a document, it now converts it to UTF-8. If conversion failed (because no encoding was present originally), it simply defines the encoding as UTF-8 v1.0.1: - Added support for 5.5b6 changes v1.0: - Initial release #tag EndNote #tag Constant, Name = CurrentVersion, Type = String, Dynamic = False, Default = \"1.1", Scope = Private #tag EndConstant #tag Constant, Name = PlistDTD, Type = String, Dynamic = False, Default = \"<!DOCTYPE plist PUBLIC \"-//Apple Computer//DTD PLIST 1.0//EN\" \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">", Scope = Private #tag EndConstant #tag Constant, Name = PlistVersion, Type = String, Dynamic = False, Default = \"1.0", Scope = Private #tag EndConstant #tag Constant, Name = XMLDictDTD, Type = String, Dynamic = False, Default = \"<!DOCTYPE xmldict PUBLIC \"-//Tildesoft//DTD XMLDICT 1.1//EN\" \"http://www.tildesoft.com/DTDs/XMLDictionary-1.1.dtd\">", 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 Module #tag EndModule
\ No newline at end of file
#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
#tag Module Protected Module Cocoa #tag Method, Flags = &h1 Protected Function Bundle() As NSBundle //This function returns an NSBundle because it is most likely that one wants an //NSBundle for Cocoa. The function Cocoa.StringConstant provides an easy way to resolve string constants. return NSBundle.LoadFromIdentifier(BundleID) End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function ClassNameForObjectPointer(p as ptr) As String #if TargetMacOS declare function object_getClassName lib CocoaLib ( id as Ptr ) as Ptr dim s as string dim mb as MemoryBlock if p<>nil then mb = object_getClassName( p ) s = mb.CString( 0 ) else break end if declare function object_getClass lib CocoaLib (id as Ptr ) as Ptr declare function class_getName lib CocoaLib (id as Ptr) as Ptr declare function class_getSuperclass lib CocoaLib (id as Ptr) as Ptr dim cls as Ptr cls = object_getClass( p ) while cls<>nil mb = class_getName( cls ) if mb<>nil then end if cls = class_getSuperclass( cls ) wend return s #else return "" #pragma unused p #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function ClassNameTreeForClass(aClass as Ptr) As String() dim result() as string #if TargetMacOS declare function class_getName lib CocoaLib (id as Ptr) as Ptr declare function class_getSuperclass lib CocoaLib (id as Ptr) as Ptr dim cls as Ptr dim mb as MemoryBlock cls = aClass while cls<>nil mb = class_getName( cls ) if mb<>nil then result.Append mb.CString( 0 ) end if cls = class_getSuperclass( cls ) wend #else #pragma unused aClass #endif return result End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function ClassNameTreeForObjectPointer(p as ptr) As String() dim result() as string #if TargetMacOS declare function object_getClass lib CocoaLib (id as Ptr ) as Ptr declare function class_getName lib CocoaLib (id as Ptr) as Ptr declare function class_getSuperclass lib CocoaLib (id as Ptr) as Ptr if p=nil then RETURN result dim cls as Ptr dim mb as MemoryBlock cls = object_getClass( p ) while cls<>nil mb = class_getName( cls ) if mb<>nil then result.Append mb.CString( 0 ) end if cls = class_getSuperclass( cls ) wend #else #pragma unused p #endif return result End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function CMTimeAbsoluteValue(time As CMTime) As CMTime #if TargetMacOS soft declare function getCMTimeAbsoluteValue lib "CoreMedia.framework" alias "CMTimeAbsoluteValue" ( time As CMTime ) As CMTime // Introduced in MacOS X 10.7. return getCMTimeAbsoluteValue( time ) #else #pragma unused time #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function CMTimeGetSeconds(time As CMTime) As Double #if TargetMacOS soft declare function getCMTimeGetSeconds lib "CoreMedia.framework" alias "CMTimeGetSeconds" ( time As CMTime ) As Double // Introduced in MacOS X 10.7. return getCMTimeGetSeconds( time ) #else #pragma unused time #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function CMTimeIsValid(time As CMTime) As Boolean return ( time.Flags and kCMTimeFlags_Valid ) <> 0 End Function #tag EndMethod #tag Method, Flags = &h1 Attributes( deprecated = "FileManager.GetFolderItemFromPOSIXPath" ) Protected Function GetFolderItemFromPOSIXPath(absolutePath as String) As FolderItem // THIS FUNCTION IS DEPRECATED. // Use FileManager.GetFolderItemFromPOSIXPath or just GetFolderItemFromPOSIXPath instead. return FileManager.GetFolderItemFromPOSIXPath( absolutePath ) End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function InheritsFromClass(p as Ptr, classname as string) As Boolean //Check if the Ptr (corresponding to any NS object) has "classname" in its inheritance tree #if TargetMacOS dim tree() as string tree = ClassNameTreeForObjectPointer( p ) return ( tree.IndexOf( classname ) <> -1 ) #else #pragma unused p #pragma unused classname #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Sub Initialize() #if TargetCarbon // This function needs to be called once to set up the Cocoa environment. Declare Function NSApplicationLoad Lib CocoaLib () as Boolean static inited as Boolean if not inited then // we should do this only once! inited = true #if RBVersion < 2010 autoreleasePool = new AutoreleaseTimer #else // Newer RB versions (actually, since any release after July 2009) create // an autorelease pool for us, so we don't need this any more. #endif if not NSApplicationLoad() then break end end if #endif End Sub #tag EndMethod #tag Method, Flags = &h1 Protected Function LoadFramework(frameworkName as String, searchPublicFrameworks as Boolean = true) As CFBundle // Call this to make a framework known to the app, so that its classRef etc. can be looked up #if targetMacOS const FrameworksDirectoryName = "Frameworks" const FrameworkExtension = ".framework" if frameworkName.Right(10) <> FrameworkExtension then frameworkName = frameworkName + FrameworkExtension end if const NSAllDomainsMask = &h0ffff const NSLibraryDirectory = 5 const isDirectory = true dim bundleURL as CFURL dim frameworkURLs() as CFURL = Array(CFBundle.Application.FrameworksDirectory.AppendComponent(frameworkName, not isDirectory)) if searchPublicFrameworks then const expandTilde = true dim p as Ptr = NSSearchPathForDirectoriesInDomains(NSLibraryDirectory, NSAllDomainsMask, expandTilde) dim libraryPathArray as new CFArray(p, not CFType.hasOwnership) for i as Integer = 0 to libraryPathArray.Count - 1 frameworkURLs.Append CFURL.CreateFromPOSIXPath(libraryPathArray.CFStringRefValue(i), isDirectory).AppendComponent(FrameworksDirectoryName, isDirectory).AppendComponent(frameworkName, not isDirectory) next end if for each url as CFURL in frameworkURLs dim bundleItem as FolderItem = url.Item if bundleItem <> nil and bundleItem.Exists then bundleURL = url exit end if next dim b as CFBundle = CFBundle.NewCFBundleFromURL( bundleURL ) if b <> nil and b.Load then LoadedFrameworks.Append b return b else return nil end if #else #pragma unused frameworkName #pragma unused searchPublicFrameworks #endif return nil // Shouldn't get here End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function MakeDelegateClass(className as String, superclassName as String, methodList() as Tuple, ParamArray protocolNames as String) As Ptr // This is Objective-C 2.0 code (available in Leopard). For 1.0, we'd need to do it differently. #if TargetMacOS then declare function objc_allocateClassPair lib CocoaLib (superclass as Ptr, name as CString, extraBytes as Integer) as Ptr declare sub objc_registerClassPair lib CocoaLib (cls as Ptr) declare function class_addMethod lib CocoaLib (cls as Ptr, name as Ptr, imp as Ptr, types as CString) as Boolean declare function objc_getProtocol lib CocoaLib (name as CString) as Ptr declare function class_addProtocol lib CocoaLib (Cls as Ptr, protocol as Ptr) as Boolean dim newClassId as Ptr = objc_allocateClassPair(Cocoa.NSClassFromString(superclassName), className, 0) if newClassId = nil then raise new macoslibException ("Could not create new class " + className) return nil end if objc_registerClassPair newClassId for each protocolName as String in protocolNames if not class_addProtocol (newClassId, objc_getProtocol(protocolName)) then raise new macoslibException ("Could not add protocol " + protocolName + " to class " + className) end if next for each item as Tuple in methodList if not class_addMethod (newClassId, Cocoa.NSSelectorFromString(item(0)), item(1), item(2)) then raise new macoslibException ("Could not add delegate method(s) to new class " + className) return nil end if next return newClassId #else #pragma unused className #pragma unused superClassName #pragma unused methodList #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function NSAppKitVersionNumber() As Double #if TargetMacOS static d as Double if d = 0 then dim mb as MemoryBlock = CFBundle.NewCFBundleFromID("com.apple.Cocoa").DataPointerNotRetained("NSAppKitVersionNumber") d = mb.DoubleValue(0) end if return d #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function NSClassFromString(aClassName as CFStringRef) As Ptr #if TargetMacOS Declare Function NSClassFromString Lib CocoaLib (aClassName as CFStringRef) As Ptr Return NSClassFromString(aClassName) #endif End Function #tag EndMethod #tag ExternalMethod, Flags = &h1 Protected Declare Function NSFullUserName Lib CocoaLib () As CFStringRef #tag EndExternalMethod #tag ExternalMethod, Flags = &h1 Protected Declare Function NSHomeDirectory Lib CocoaLib () As CFStringRef #tag EndExternalMethod #tag Method, Flags = &h1 Protected Function NSIntegerMax() As Integer // This is a method and not a constant because it will be a different value under 32-bit and 64-bit. #if RBVersion >= 2013.01 // No 64-bit versions before this anyway #if Target64Bit then return &h7FFFFFFFFFFFFFFF #else return &h7FFFFFFF #endif #else // Older version of Real Studio that may not have had Target64Bit return &h7FFFFFFF #endif End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function NSMakePoint(x as Single, y as Single) As NSPoint dim p as NSPoint p.x = x p.y = y return p End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function NSMakeRange(start as integer, length as integer) As NSRange dim r as NSRange r.location = start r.length = length return r End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function NSMakeRect(x as Double, y as Double, w as Double, h as Double) As NSRect dim r as NSRect r.x = x r.y = y r.w = w r.h = h return r End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function NSMakeSize(width as Single, Height as Single) As NSSize dim s as NSSize s.width = width s.height = Height return s End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function NSNotFound() As Integer static r as Integer = NSIntegerMax return r // See notes in NSIntegerMax End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function NSObjectFromNSPtr(id as Ptr, hasOwnership as Boolean = false, DontReturnNSObject as boolean = false) As variant //Creates an instance of an RB Cocoa object from the passed Cocoa object instance id dim objClassNameTree() as string = ClassNameTreeForObjectPointer( id ) for i as integer = 0 to objClassNameTree.Ubound dim objClassName as string = objClassNameTree( i ) // Can't use For Each since order matters select case objClassName case "AVAsset" return new AVAsset( id, hasOwnership ) case "AVAssetTrack" return new AVAssetTrack( id, hasOwnership ) case "AVMetadataItem" return new AVMetadataItem( id, hasOwnership ) case "NSApplication" return new NSApplication( id, hasOwnership ) case "NSArray" return new NSArray( id, hasOwnership ) case "NSAttributedString" return new NSAttributedString( id, hasOwnership ) case "NSBundle" return new NSBundle( id, hasOwnership ) case "NSCell" return new NSCell( id, hasOwnership ) case "NSCharacterSet" return new NSCharacterSet( id, hasOwnership ) case "NSColor" return new NSColor( id, hasOwnership ) case "NSColorSpace" 'return new NSColorSpace( id, hasOwnership ) case "NSData" return new NSData( id, hasOwnership ) case "NSDate" return new NSDate( id, hasOwnership ) case "NSDateFormatter" return new NSDateFormatter( id, hasOwnership ) case "NSDictionary" return new NSDictionary( id, hasOwnership ) case "NSEvent" return new NSEvent( id, hasOwnership ) case "NSFileHandle" return new NSFileHandle( id, hasOwnership ) case "NSFont" return new NSFont( id, hasOwnership ) case "NSFontManager" return new NSFontManager( id, hasOwnership ) case "NSGraphicsContext" return new NSGraphicsContext( id, hasOwnership ) case "NSHost" return new NSHost( id, hasOwnership ) case "NSImage" return new NSImage( id, hasOwnership ) case "NSIndexSet" return new NSIndexSet( id, hasOwnership ) case "NSMenu" return new NSMenu( id, hasOwnership ) case "NSMenuItem" return new NSMenuItem( id, hasOwnership ) case "NSMutableArray" return new NSMutableArray( id, hasOwnership ) case "NSMutableAttributedString" return new NSMutableAttributedString( id, hasOwnership ) case "NSMutableCharacterSet" return new NSMutableCharacterSet( id, hasOwnership ) case "NSMutableDictionary" return new NSMutableDictionary( id, hasOwnership ) case "NSMutableIndexSet" return new NSMutableIndexSet( id, hasOwnership ) case "NSMutableParagraphStyle" return new NSMutableParagraphStyle( id, hasOwnership ) case "NSMutableString" return new NSMutableString( id, hasOwnership ) case "NSNetService" return new NSNetService( id, hasOwnership ) case "NSNetServiceBrowser" return new NSNetServiceBrowser( id, hasOwnership ) case "NSNotification" return new NSNotification( id, hasOwnership ) case "NSNotificationCenter" return new NSNotificationCenter( id, hasOwnership ) case "NSNull" return new NSNull( id, hasOwnership ) case "NSNumber" return new NSNumber( id, hasOwnership ) case "NSParagraphStyle" return new NSParagraphStyle( id, hasOwnership ) case "NSPasteboard" return new NSPasteboard( id, hasOwnership ) case "NSPasteboardItem" return new NSPasteboardItem( id, hasOwnership ) case "NSObject" if DontReturnNSObject then return nil else return new NSObject( id, hasOwnership ) end if case "NSPathComponentCell" 'return new NSPathComponentCell( id, hasOwnership ) case "NSPipe" return new NSPipe( id, hasOwnership ) case "NSPrinter" return new NSPrinter( id, hasOwnership ) case "NSProcessInfo" return new NSProcessInfo( id, hasOwnership ) case "NSResponder" return new NSResponder( id, hasOwnership ) case "NSRunLoop" return new NSRunLoop( id, hasOwnership ) case "NSRunningApplication" return new NSRunningApplication( id, hasOwnership ) case "NSSpeechSynthesizer" return new NSSpeechSynthesizer( id, hasOwnership ) case "NSString" return new NSString( id, hasOwnership ) case "NSTableColumn" return new NSTableColumn( id, hasOwnership ) case "NSTableHeaderView" return new NSTableHeaderView( id, hasOwnership ) case "NSTableViewDataSource" 'return new NSTableViewDataSource( id, hasOwnership ) case "NSText" return new NSText( id, hasOwnership ) case "NSTimeZone" return new NSTimeZone( id, hasOwnership ) case "NSURL" return new NSURL( id, hasOwnership ) case "NSUserDefaults" return new NSUserDefaults( id, hasOwnership ) case "NSValue" return new NSValue( id, hasOwnership ) case "NSView" return new NSView( id, hasOwnership ) case "NSWindow" return new NSWindow( id, hasOwnership ) case "NSWorkspace" return new NSWorkspace( id, hasOwnership ) case "ODNode" return new ODNode( id, hasOwnership ) case "ODSession" return new ODSession( id, hasOwnership ) end select next End Function #tag EndMethod #tag Method, Flags = &h1 Protected Function NSObjectFromVariant(v as variant) As variant if v.IsArray then return NSArray.CreateFromObjectsArray( v ) end if select case v.Type case Variant.TypeBoolean return new NSNumber( v.BooleanValue ) case Variant.TypeInteger, Variant.TypeLong return new NSNumber( v.IntegerValue ) case Variant.TypeString dim s as NSString = v.StringValue return s case Variant.TypeDouble, Variant.TypeSingle return new NSNumber( v.DoubleValue ) case Variant.TypeObject //->Dictionary, MemoryBlock if v IsA Dictionary then return NSDictionary.CreateFromDictionary( Dictionary( v )) elseif v IsA MemoryBlock then return new NSData( MemoryBlock( v )) elseif v isa NSObject then //Already a NSObject return v end if case Variant.TypeDate return new NSDate( v.DateValue ) case Variant.TypeNil return new NSNull case Variant.TypeColor return new NSColor( v.ColorValue ) else raise new TypeMismatchException end select End Function #tag EndMethod #tag ExternalMethod, Flags = &h0 Declare Function NSSearchPathForDirectoriesInDomains Lib CocoaLib (directory as Integer, domainMask as Integer, expandTilde as Boolean) As Ptr #tag EndExternalMethod #tag ExternalMethod, Flags = &h1 Protected Declare Function NSSelectorFromString Lib CocoaLib (aSelectorName as CFStringRef) As Ptr #tag EndExternalMethod #tag ExternalMethod, Flags = &h0 Declare Function NSStringFromClass Lib CocoaLib (aClass as Ptr) As CFStringRef #tag EndExternalMethod #tag ExternalMethod, Flags = &h1 Protected Declare Function NSStringFromSelector Lib CocoaLib (aSelector as Ptr) As CFStringRef #tag EndExternalMethod #tag ExternalMethod, Flags = &h1 Protected Declare Function NSUserName Lib CocoaLib () As CFStringRef #tag EndExternalMethod #tag Method, Flags = &h0 Function NSZeroPoint() As NSPoint return NSMakePoint(0, 0) End Function #tag EndMethod #tag Method, Flags = &h0 Function NSZeroRect() As NSRect return NSMakeRect(0.0, 0.0, 0.0, 0.0) End Function #tag EndMethod #tag Method, Flags = &h0 Function NSZeroSize() As NSSize return NSMakeSize(0.0, 0.0) End Function #tag EndMethod #tag Method, Flags = &h1 Protected Sub Release(id as Ptr) #if TargetMacOS declare sub release lib CocoaLib selector "release" (id as Ptr) if id <> nil then release id end if #else #pragma unused id #endif End Sub #tag EndMethod #tag Method, Flags = &h0 Sub RequireFramework(frameworkName as string) dim fname as string if frameworkName.Instr( ".framework" ) = 0 then fname = frameworkName + ".framework" else fname = frameworkName end if for each cfb as CFBundle in LoadedFrameworks if cfb.FolderItemValue.Name = fname then return end if next //Load the framework dim cfb as CFBundle = LoadFramework( frameworkName ) if cfb<>nil then LoadedFrameworks.Append cfb else raise new MacOSError( 100002, "Library not found: " + fname ) //POSIX error: kPOSIXErrorENOENT end if End Sub #tag EndMethod #tag Method, Flags = &h1 Protected Sub Retain(id as Ptr) #if TargetMacOS declare function retain lib CocoaLib selector "retain" (id as Ptr) as Ptr if id <> nil then call retain( id ) end if #else #pragma unused id #endif End Sub #tag EndMethod #tag Method, Flags = &h1 Protected Function StringConstant(symbolName as String) As String //NSBundle doesn't support loading of data pointers; for this we must use a CFBundle. #if targetMacOS dim s as string dim b as CFBundle = CFBundle.NewCFBundleFromID(BundleID) s = b.StringPointerRetained(symbolName) if s<>"" then return s end if //Not found. Search in loaded frameworks for i as integer=0 to LoadedFrameworks.Ubound s = LoadedFrameworks( i ).StringPointerRetained( symbolName ) if s<>"" then return s end if next #else #pragma unused symbolName #endif End Function #tag EndMethod #tag Note, Name = About From: http://www.declaresub.com/ideclare/Cocoa/index.html This module provides what in Cocoa terms is the "Foundation" #tag EndNote #tag Note, Name = Caution using 'SEL' and 'id' in declares This is only important if you add new Cocoa method calls yourself: If you want to call an external function (usually via "declare"), and if that function's return type is a selector (SEL) or generic Cocoa object (id), be cautious not to use such types as the return type of the declared function. Instead, have it return a UInt32 and then assign its value to a variable of type SEL or id using the ToSEL() or To_id() function (or assign directly to its ".value" member, although that's a bit unclean). If you do not obey this rule, your application may not work on PowerPC processors because of a bug in REALbasic (as of v2008r5.1): Returning structure types from declare'd functions does not work. An example where you'd want to store the result of a call in a variable such as: dim result as id Bad: declare function objc_msgSend lib CocoaLib (r as id, s as SEL) as id result = objc_msgSend (r, s) Good: declare function objc_msgSend lib CocoaLib (r as id, s as SEL) as UInt32 result = To_id (objc_msgSend (r, s)) #tag EndNote #tag Property, Flags = &h21 Private autoreleasePool As AutoreleaseTimer #tag EndProperty #tag Property, Flags = &h1 Protected LoadedFrameworks() As CFBundle #tag EndProperty #tag Constant, Name = BundleID, Type = String, Dynamic = False, Default = \"com.apple.Cocoa", Scope = Protected, Attributes = \"" #tag EndConstant #tag Constant, Name = CocoaLib, Type = String, Dynamic = False, Default = \"Cocoa.framework", Scope = Public #tag EndConstant #tag Constant, Name = FoundationLib, Type = String, Dynamic = False, Default = \"Foundation.framework", Scope = Public #tag EndConstant #tag Constant, Name = kCMTimeFlags_HasBeenRounded, Type = Double, Dynamic = False, Default = \"2", Scope = Protected #tag EndConstant #tag Constant, Name = kCMTimeFlags_ImpliedValueFlagsMask, Type = Double, Dynamic = False, Default = \"&b00011100", Scope = Protected #tag EndConstant #tag Constant, Name = kCMTimeFlags_Indefinite, Type = Double, Dynamic = False, Default = \"16", Scope = Protected #tag EndConstant #tag Constant, Name = kCMTimeFlags_NegativeInfinity, Type = Double, Dynamic = False, Default = \"8", Scope = Protected #tag EndConstant #tag Constant, Name = kCMTimeFlags_PositiveInfinity, Type = Double, Dynamic = False, Default = \"4", Scope = Protected #tag EndConstant #tag Constant, Name = kCMTimeFlags_Valid, Type = Double, Dynamic = False, Default = \"0", Scope = Protected #tag EndConstant #tag Structure, Name = CMTime, Flags = &h1 value As Int64 timescale As Int32 flags As UInt32 epoch As Int64 #tag EndStructure #tag Structure, Name = NSPoint, Flags = &h1 x as Single y as Single #tag EndStructure #tag Structure, Name = NSRange, Flags = &h1 location as Integer length as Integer #tag EndStructure #tag Structure, Name = NSRect, Flags = &h1 x as Single y as Single w as Single h as Single #tag EndStructure #tag Structure, Name = NSSize, Flags = &h1 width as Single height as Single #tag EndStructure #tag Enum, Name = NSCellStateValue, Flags = &h0 Mixed = -1 Off = 0 On = 1 #tag EndEnum #tag Enum, Name = NSComparisonResult, Flags = &h0 NSOrderedAscending = -1 NSOrderedSame = 0 NSOrderedDescending = 1 #tag EndEnum #tag Enum, Name = NSRectEdge, Flags = &h0 NSMinXEdge NSMinYEdge NSMaxXEdge NSMaxYEdge #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
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