If you don't know it, have a look at http://www.photools.com/
These Scripts can be used any way, but also without any kind of warranty!
If you don't agree, please leave now.
= new Script
= updated Script
Multi Database Transmission V 1.2 (06-Jun-2003) - This script transmits Images from a SourceDB to a TargetDB, preserving all Category-Assignments and Property-Entries. (And, *g*, if Mario would give us an updated Timestamp for the DatabaseImageRecords, we could merge Databases by checking which Entry is newer. Think about mobile IMatch.)
Remove Empty Categories from Database V 1.0 (30-May-2003) - This script removes all 'empty'-Categories from the active Database.
OffLineCache Garbage Collector V 1.0 (28-Jun-2003) - This script checks all existing Images in OfflineCacheFolder of the active Database and deletes ownerless OLC-Images. Additionally you can select some Categories from which you want delete the Images OfflineCache-pendants.
Photoshop Conversion (PS 5.5 + 6) V 0.9 (02-Jul-2003) - This Script combines the ManagementPower of IMatch with the ImageManipulationPower of Adobes Photoshop 6.0 in an easy to use way. This Script I have written together with Klaus Schwarzburg. Many thanks for your help, Klaus.
lcms Webgallery Creator V 0.1 (05-Oct-2002) - This script enhance the original Webgallery-Creator-Script with an ICC-Conversion-feature.
little Batch Converter V 1.2 (26-Jun-2003) - This script create resized copies, optionally with ICC-Conversion for Tiff- and Jpeg-sources. Can work with OfflineCacheImages instead of originals and can transmit all Property-, Category- and IPTC-data to the copies.
Registry Functions V 1.0 (01-Nov-2002) - A littleHelper-Script to put and retrieve Data to/from Registry in its correct DataTypes. VB usually provides only the StringType. With this Lib you can store every DataType to Registry (Byte, Integer, Long, Double, Decimal, Boolean, Variant, ...).
Debug Messages V 1.0 (08-Nov-2002) - A littleHelper-Script which handles Debugoutput in Priorityclasses. With this you can have good Informationoutput when you develope a Script and a less or no Output when run the Script in Productivity-Mode. Your DebugmessagePoints can stay in code without any (auswirkung). Usefull for future changes on your code.
Explanation
MainScript: hn_RemoveEmptyCategoriesFromDatabase.bas
Needed Modules: [hnFncRegKey.lib]
hnFncRegKey.lib: (300 lines / 158 real codelines / 0 Subs / 9 Functions / 0 Properties)
1| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2| ' 3| 4| ' 5| ' h.nogajski@web.de 6| ' http://horst.nogajski.de 7| ' 8| '-------------------------------------------------------------------------------------------------- 9| ' 10| ' LittleHelperScript: RegistryFunctions (for SAX-Basic or VB) 11| ' 12| ' Set/Get Values to/from Registry with different VarTypes (Not only StringVars!) 13| ' 14| Public Const hnfncregkeyLibVersionString As String = "V 1.1 (05-Mar-2003)" 15| Public Const hnfncregkeyLibVersion As Long = 10100 'two digits per position, allows for versions such as V 20.12.29 16| 'last position not used in String now (could be used for internal 17| 'releases for example), set to 00 in Long 18| ' 19| ' Changes V 1.0 to 1.1: 20| ' LibVersion, LibVersionString added (Mei) 21| ' Returns the revision version of this library, to allow testing for downward compatibility 22| ' 23| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 24| '-------------------------------------------------------------------------------------------------- 25| ' 26| ' Public Functions: 27| ' 28| ' SaveRegKey 29| ' Saves a Key/Value-Pair to Registry and a second one, storing the original Typedefinition. 30| ' GetRegKey 31| ' Returns the Value of a given Key converted to it's original VarType. (e.g. Integer, Boolean, Long,...) 32| ' DelRegKey 33| ' Deletes a given Key. 34| ' DelAllRegKeys 35| ' Deletes the whole KeyTree. 36| ' GiveRegKeyArray 37| ' Returns a sorted array with all Keys, optional with TypedefinitionKeys. 38| ' 39| '-------------------------------------------------------------------------------------------------- 40| ' 41| ' Private Functions: 42| ' 43| ' TypeToRegVal 44| ' Converts any Type to String and associate the Typedefinition to global CurRegValType 45| ' RegValToType 46| ' Converts a given Var to the Type stored in the second RegKey 47| ' ResetGlobalVars 48| ' Resets the two globalVars CurRegVal + CurRegValType 49| ' RKF_SortStringArray 50| ' Sorts a given StringArray ascending ByRef 51| ' 52| '-------------------------------------------------------------------------------------------------- 53| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 54| 55| 56| 57| 58| '*********************************************************************************** 59| '* Copy this Section to your CallingScript to DeclarationSection and set the Params 60| '*********************************************************************************** 61| 62| ' ! The Key-AppName and the Key-SectionName in Registry ! 63| ' ! Please Set this Constants in your Calling Script ! 64| 65| 'Public Const My_RegKeyApp As String = "photools.com\IMatch.3" 66| 'Public Const My_RegKeySection As String = "Scripts\TestScript" 67| 68| '*********************************************************************************** 69| '* Copy this Section to your CallingScript to DeclarationSection and set the Params 70| '*********************************************************************************** 71| 72| Option Explicit 73| 74| 75| ' A Suffix added to the RegKey storing the VarType 76| Private Const KeySuffix As String = "_VarType" 77| 78| 79| ' Two Vars, the Wrapperfunction needs for transferring data between them 80| Dim CurRegVal As Variant 81| Dim CurRegValType As String 82| 83| 84| Public Function SaveRegKey(MyKey As String, MyVal As Variant) 85| 86| ResetGlobalVars() 87| TypeToRegVal(MyVal) 88| 89| SaveSetting My_RegKeyApp, My_RegKeySection, MyKey, CurRegVal 90| SaveSetting My_RegKeyApp, My_RegKeySection, MyKey & KeySuffix, CurRegValType 91| 92| End Function 93| 94| 95| Public Function GetRegKey(MyKey As String, Optional MyDefaultValue As Variant = Empty) As Variant 96| 97| ResetGlobalVars() 98| CurRegValType = GetSetting(My_RegKeyApp, My_RegKeySection, MyKey & KeySuffix) 99| 100| If CurRegValType = "" Then 101| If MyDefaultValue <> Empty Then GetRegKey = MyDefaultValue 102| Else 103| RegValToType(GetSetting(My_RegKeyApp, My_RegKeySection, MyKey, MyDefaultValue)) 104| GetRegKey = CurRegVal 105| End If 106| 107| End Function 108| 109| 110| Public Function DelRegKey(MyKey As String) 111| 112| ResetGlobalVars() 113| CurRegVal = GetSetting(My_RegKeyApp, My_RegKeySection, MyKey) 114| CurRegValType = GetSetting(My_RegKeyApp, My_RegKeySection, MyKey & KeySuffix) 115| 116| If CurRegValType = "Empty" And TypeName(CurRegVal) = "String" And CurRegVal = "" Then 117| DeleteSetting(My_RegKeyApp, My_RegKeySection, MyKey) 118| End If 119| 120| If CurRegVal <> "" Then DeleteSetting(My_RegKeyApp, My_RegKeySection, MyKey) 121| If CurRegValType <> "" Then DeleteSetting(My_RegKeyApp, My_RegKeySection, MyKey & KeySuffix) 122| 123| End Function 124| 125| 126| Public Function DelAllRegKeys() 127| 128| ResetGlobalVars() 129| SaveSetting(My_RegKeyApp, My_RegKeySection, "IwillDelYouSoon", "truely =:)") 130| DeleteSetting(My_RegKeyApp, My_RegKeySection) 131| 132| End Function 133| 134| 135| Public Function GiveRegKeyArray(Optional WithTypeDefinitions As Boolean = False) As String() 136| 137| ResetGlobalVars() 138| Dim AllMyKeys As Variant 139| Dim SortedKeys() As String 140| Dim I As Integer 141| 142| AllMyKeys = GetAllSettings(My_RegKeyApp,My_RegKeySection) 143| 144| For I = LBound(AllMyKeys) To UBound(AllMyKeys) 145| ReDim Preserve SortedKeys(I) 146| SortedKeys(I) = CStr(AllMyKeys(I,0)) & "=" & CStr(AllMyKeys(I,1)) 147| Next I 148| RKF_SortStringArray(SortedKeys()) 149| 150| If WithTypeDefinitions Then 151| 152| GiveRegKeyArray = SortedKeys() 153| 154| Else 155| 156| Dim noTypeDefs() As String 157| Dim k As Integer 158| k = 0 159| 160| For I = LBound(SortedKeys) To UBound(SortedKeys) 161| If InStr(SortedKeys(I),KeySuffix) = 0 Then 162| ReDim Preserve noTypeDefs(k) 163| noTypeDefs(k) = SortedKeys(I) 164| k = k + 1 165| End If 166| Next I 167| 168| GiveRegKeyArray = noTypeDefs() 169| 170| End If 171| 172| End Function 173| 174| 175| Private Function TypeToRegVal(MyVal As Variant) As String 176| 177| Select Case TypeName(MyVal) 178| Case "Empty" 179| CurRegVal = "" 180| CurRegValType = "Empty" 181| Case "Null" 182| CurRegVal = "" 183| CurRegValType = "Empty" 184| Case "Byte" 185| CurRegVal = CStr(MyVal) 186| CurRegValType = "Byte" 187| Case "Integer" 188| CurRegVal = CStr(MyVal) 189| CurRegValType = "Integer" 190| Case "Long" 191| CurRegVal = CStr(MyVal) 192| CurRegValType = "Long" 193| Case "Single" 194| CurRegVal = CStr(MyVal) 195| CurRegValType = "Single" 196| Case "Currency" 197| CurRegVal = CStr(MyVal) 198| CurRegValType = "Currency" 199| Case"Decimal" 200| CurRegVal = CStr(MyVal) 201| CurRegValType = "Decimal" 202| Case "Double" 203| CurRegVal = CStr(MyVal) 204| CurRegValType = "Double" 205| Case "Date" 206| CurRegVal = CStr(MyVal) 207| CurRegValType = "Date" 208| Case "Boolean" 209| If MyVal = True Then 210| CurRegVal = "True" 211| CurRegValType = "Boolean" 212| Else 213| CurRegVal = "False" 214| CurRegValType = "Boolean" 215| End If 216| Case "String" 217| CurRegVal = CStr(MyVal) 218| CurRegValType = "String" 219| Case Else 220| CurRegVal = CStr(MyVal) 221| CurRegValType = "Unknown" 222| End Select 223| 224| End Function 225| 226| 227| Private Function RegValToType(MyVal As String) 228| 229| Select Case CurRegValType 230| Case "Empty" 231| CurRegVal = Null 232| Case "Byte" 233| CurRegVal = CByte(MyVal) 234| Case "Integer" 235| CurRegVal = CInt(MyVal) 236| Case "Long" 237| CurRegVal = CLng(MyVal) 238| Case "Single" 239| CurRegVal = CSng(MyVal) 240| Case "Double" 241| CurRegVal = CDbl(MyVal) 242| Case "Currency" 243| CurRegVal = CCur(CDbl(MyVal)) 244| Case "Decimal" 245| CurRegVal = CDec(CDbl(MyVal)) 246| Case "Date" 247| CurRegVal = CDate(MyVal) 248| Case "Boolean" 249| CurRegVal = CBool(MyVal) 250| Case "String" 251| CurRegVal = CStr(MyVal) 252| Case Else 253| CurRegVal = CVar(MyVal) 254| End Select 255| 256| End Function 257| 258| 259| Private Function ResetGlobalVars() 260| CurRegVal = "" 261| CurRegValType = "" 262| End Function 263| 264| 265| Private Function RKF_SortStringArray(ByRef A() As String) 266| Dim t As String 267| Dim I As Long 268| Dim j As Long 269| 270| For I = LBound(A) To UBound(A) 271| For j = I + 1 To UBound(A) 272| If A(I) > A(j) Then 273| t = A(I) 274| A(I) = A(j) 275| A(j) = t 276| End If 277| Next 278| Next 279| 280| End Function 281| 282| 283| 284| 285| 286| '### FunctionList: 287| ' - Private Function RKF_SortStringArray(ByRef A() As String) 288| ' - Private Function RegValToType(MyVal As String) 289| ' - Private Function ResetGlobalVars() 290| ' - Private Function TypeToRegVal(MyVal As Variant) As String 291| ' - Public Function DelAllRegKeys() 292| ' - Public Function DelRegKey(MyKey As String) 293| ' - Public Function GetRegKey(MyKey As String, Optional MyDefaultValue As Variant = Empty) As Variant 294| ' - Public Function GiveRegKeyArray(Optional WithTypeDefinitions As Boolean = False) As String() 295| ' - Public Function SaveRegKey(MyKey As String, MyVal As Variant) 296| 297| '### Public Declarations: 298| ' - Public Const hnfncregkeyLibVersion As Long = 10100 'two digits per position, allows for versions such as V 20.12.29 299| ' - Public Const hnfncregkeyLibVersionString As String = "V 1.1 (05-Mar-2003)" 300|