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: hnSample_FncRegKeys.bas
Needed Modules: [hnFncRegKey.obm]
hnSample_FncRegKeys.bas: (178 lines / 134 real codelines / 2 Subs / 1 Function / 0 Properties)
1| '#uses "hn273\hnFncRegKey.obm" 2| 3| Option Explicit 4| 5| 6| ' The Key-AppName and the Key-SectionName 7| Public Const My_RegKeyApp As String = "photools.com\IMatch.3" 8| Public Const My_RegKeySection As String = "Scripts\TestKeys" 9| 10| 11| ' Global Variables 12| Dim MyVarTypeEmpty As Variant 13| Dim MyVarTypeByte As Byte 14| Dim MyVarTypeInteger As Integer 15| Dim MyVarTypeLong As Long 16| Dim MyVarTypeSingle As Single 17| Dim MyVarTypeDouble As Double 18| Dim MyVarTypeCurrency As Currency 19| Dim MyVarTypeDate As Date 20| Dim MyVarTypeDecimal As Variant 21| Dim MyVarTypeBoolean As Boolean 22| Dim MyVarTypeString As String 23| Dim MyEmptyStr As String 24| Dim MyEmptyStrWithDefault As String 25| 26| 27| Sub Main 28| 29| 30| Dim explanation As String 31| explanation = "SaveRegKey(" & Chr(34) & "MyIntKey" & Chr(34) & ",CInt(1024))" & vbCr & "This saves a IntegerValue to Registry" 32| explanation = explanation & vbCr & vbCr 33| explanation = explanation & "SaveRegKey(" & Chr(34) & "MyBoolKey" & Chr(34) & ",CBool(False))" & vbCr & "This saves a BooleanValue to Registry" 34| explanation = explanation & vbCr & vbCr 35| explanation = explanation & "SaveRegKey(" & Chr(34) & "MyStrKey" & Chr(34) & "," & Chr(34) & "stringstring" & Chr(34) & ")" & vbCr & "This saves a StringValue To Registry" 36| explanation = explanation & vbCr & vbCr 37| explanation = explanation & vbCr & vbCr 38| explanation = explanation & "myStrVar = GetRegKey(" & Chr(34) & "MyKey" & Chr(34) & "," & Chr(34) & "defaultStr" & Chr(34) & ")" & vbCr & "puts the stored Value of MyKey in myStrVar, or," & vbCr & "if MyKey is empty or does not exist," & vbCr & "it puts the defaultvalue in myStrVar!" & vbCr & vbCr 39| explanation = explanation & "If you want more Info you can go to the IMatchSection on my private homepage." & vbCr & "Do you want go To the explanation Now?" 40| 41| 42| 43| 44| Dim MyMsg As String 45| Dim loopnumber As Integer 46| loopnumber = 1 47| 48| ' Save some Values of different Types to Registry 49| SaveRegKey("MyVarTypeEmpty",Null) 50| SaveRegKey("MyVarTypeByte",CByte(255)) 51| SaveRegKey("MyVarTypeInteger",CInt(32767)) 52| SaveRegKey("MyVarTypeLong",CLng(2147483647)) 53| SaveRegKey("MyVarTypeSingle",CSng(2147483648.73)) 54| SaveRegKey("MyVarTypeDouble",CDbl(1.8*10*Exp(308))) 55| SaveRegKey("MyVarTypeCurrency",CCur(72233720368547.5807)) 56| SaveRegKey("MyVarTypeDate",CDate("31.12.9999")) 57| SaveRegKey("MyVarTypeDecimal",1.0123456789102828282828282828) 58| SaveRegKey("MyVarTypeBoolean",CBool(True)) 59| SaveRegKey("MyVarTypeString","This is a String, STRING, string!") 60| 61| 62| LoopMsg: 63| 64| ' Get values from registry [, or take DefaultValue] 65| MyVarTypeEmpty = GetRegKey("MyVarTypeEmpty") 66| MyVarTypeByte = GetRegKey("MyVarTypeByte") 67| MyVarTypeInteger = GetRegKey("MyVarTypeInteger",-32768) 68| MyVarTypeLong = GetRegKey("MyVarTypeLong",-2147483647) 69| MyVarTypeSingle = GetRegKey("MyVarTypeSingle") 70| MyVarTypeDouble = GetRegKey("MyVarTypeDouble") 71| MyVarTypeCurrency = GetRegKey("MyVarTypeCurrency") 72| MyVarTypeDate = GetRegKey("MyVarTypeDate","01.11.2002") 73| MyVarTypeDecimal = GetRegKey("MyVarTypeDecimal") 74| MyVarTypeBoolean = GetRegKey("MyVarTypeBoolean") 75| MyVarTypeString = GetRegKey("MyVarTypeString") 76| 'Try to get two Values of nonexisting Keys. One with DefaultValue, one without! 77| MyEmptyStr = GetRegKey("MyEmptyStr") 78| MyEmptyStrWithDefault = GetRegKey("MyEmptyStrWithDefault", "This Is a Default String, which wasn't stored in the Registry!") 79| 80| Select Case loopnumber 81| Case 1 82| MyMsg = "Testing: Save, Get and Delete RegKeyValues!" & Chr(13) & Chr(13) & _ 83| "These Values are stored in Registry:" & Chr(13) & Chr(13) & _ 84| "MyVarTypeEmpty = " & MyVarTypeEmpty & Chr(13) & Chr(13) & _ 85| "MyVarTypeByte = " & MyVarTypeByte & Chr(13) & _ 86| "MyVarTypeInteger = " & MyVarTypeInteger & Chr(13) & _ 87| "MyVarTypeLong = " & MyVarTypeLong & Chr(13) & Chr(13) & _ 88| "MyVarTypeSingle = " & MyVarTypeSingle & Chr(13) & _ 89| "MyVarTypeDouble = " & MyVarTypeDouble & Chr(13) & _ 90| "MyVarTypeCurrency = " & MyVarTypeCurrency & Chr(13) & _ 91| "MyVarTypeDecimal = " & MyVarTypeDecimal & Chr(13) & Chr(13) & _ 92| "MyVarTypeDate = " & MyVarTypeDate & Chr(13) & _ 93| "MyVarTypeBoolean = " & MyVarTypeBoolean & Chr(13) & Chr(13) & _ 94| "MyVarTypeString = " & MyVarTypeString & Chr(13) & _ 95| "MyEmptyStr = " & MyEmptyStr & Chr(13) & _ 96| "MyEmptyStrWithDefault = " & MyEmptyStrWithDefault & Chr(13) & Chr(13) & _ 97| "Do you want delete some Keys?" 98| If MsgBox(MyMsg,vbYesNo,"Have you read this? =:)") = vbNo Then GoTo Exit_ 99| Case 2 100| MyMsg = "Testing: Save, Get and Delete RegKeyValues!" & Chr(13) & Chr(13) & _ 101| "These are only DefaultValues or EmptyVars:" & Chr(13) & Chr(13) & _ 102| "MyVarTypeEmpty = " & MyVarTypeEmpty & Chr(13) & Chr(13) & _ 103| "MyVarTypeByte = " & MyVarTypeByte & Chr(13) & _ 104| "MyVarTypeInteger = " & MyVarTypeInteger & Chr(13) & _ 105| "MyVarTypeLong = " & MyVarTypeLong & Chr(13) & Chr(13) & _ 106| "MyVarTypeSingle = " & MyVarTypeSingle & Chr(13) & _ 107| "MyVarTypeDouble = " & MyVarTypeDouble & Chr(13) & _ 108| "MyVarTypeCurrency = " & MyVarTypeCurrency & Chr(13) & _ 109| "MyVarTypeDecimal = " & MyVarTypeDecimal & Chr(13) & Chr(13) & _ 110| "MyVarTypeDate = " & MyVarTypeDate & Chr(13) & _ 111| "MyVarTypeBoolean = " & MyVarTypeBoolean & Chr(13) & Chr(13) & _ 112| "MyVarTypeString = " & MyVarTypeString & Chr(13) & _ 113| "MyEmptyStr = " & MyEmptyStr & Chr(13) & _ 114| "MyEmptyStrWithDefault = " & MyEmptyStrWithDefault 115| MsgBox(MyMsg,vbOkOnly,"DEMO of RegKeyFunctions =:)") 116| GoTo Exit_ 117| Case Else 118| GoTo Exit_ 119| End Select 120| 121| 122| 'DelAllRegKeys() 123| 124| 125| 'Delete some RegKeys 126| DelRegKey("MyVarTypeEmpty") 127| DelRegKey("MyVarTypeByte") 128| DelRegKey("MyVarTypeInteger") 129| DelRegKey("MyVarTypeLong") 130| DelRegKey("MyVarTypeSingle") 131| DelRegKey("MyVarTypeDouble") 132| DelRegKey("MyVarTypeCurrency") 133| DelRegKey("MyVarTypeDate") 134| DelRegKey("MyVarTypeDecimal") 135| DelRegKey("MyVarTypeBoolean") 136| DelRegKey("MyVarTypeString") 137| 'Try to delete some nonexisting Keys 138| DelRegKey("MyEmptyStr") 139| DelRegKey("MyEmptyStrWithDefault") 140| 141| loopnumber = loopnumber + 1 142| GoTo LoopMsg 143| 144| Exit_: 145| Dim question As VbMsgBoxResult 146| question = MsgBox(explanation,vbYesNo,"For more info you can go to ExplanationSite") 147| If question =vbYes Then CallPage 148| 149| End Sub 150| 151| Sub CallPage 152| 153| Dim explanation As String 154| Dim SinnDesLebens As Variant 155| explanation = URLShortCut("http://horst.nogajski.de/imatch/index.php?show=RegistryFunctions&sub=regkey.explanation.inc.php#Show","RegKeyExplanation.url") 156| If explanation <> "" Then 157| SinnDesLebens = Application.ShellExecute("open",explanation) 158| 'If CInt(SinnDesLebens) <> 42 Then Error_ 159| End If 160| 161| End Sub 162| 163| Private Function URLShortCut(ByVal URL As String, Optional filename As String = "hn273ShortCut.url") As String 164| 165| URLShortCut = "" 166| 167| Dim FN As Integer 168| FN = FreeFile 169| filename = Environ("TEMP") & "\" & filename 170| Open filename For Output As #FN 171| Print #FN, "[InternetShortcut]" 172| Print #FN, "URL=" & URL 173| Close #FN 174| 175| URLShortCut = filename 176| 177| End Function 178|