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_littleBatchConverter.bas
Needed Modules: [hnPublicDeclarations.lib]
[hnFncUtils.lib]
[hnClsRegKey.cls]
[hnClsTransmission.cls]
[hnClsWaitDialog.cls]
hnPublicDeclarations.lib: (510 lines / 259 real codelines / 2 Subs / 3 Functions / 0 Properties)
1| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2| ' 3| 4| ' 5| ' h.nogajski@web.de 6| ' http://horst.nogajski.de 7| ' 8| '-------------------------------------------------------------------------------------------------- 9| ' 10| ' All Public-Declarations and some Basic Functions needed in every Script, Class or Lib! 11| ' 12| ' 13| 'V 1.22 (25-Jun-2003) 14| ' 15| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 16| '-------------------------------------------------------------------------------------------------- 17| ' 18| ' Uses / Embedds 19| ' 20| ' NONE 21| ' 22| '-------------------------------------------------------------------------------------------------- 23| ' 24| ' Public Functions: 25| ' 26| ' ------------------------------------------------------------------------------------------- 27| ' CheckVersionAgainst (with LibFileName as Prefix) => hnPuplicDeclarationsLibCheckVersionAgainst 28| ' Descript: Checks a given Long against the LibVersionNumber. 29| ' The given Long represents the LibVersionNumber which the 30| ' script-author has used creating his script. 31| ' Params: Long neededLong, Optional Boolean suppressMsgBox 32| ' Returns: Boolean 33| ' ------------------------------------------------------------------------------------------- 34| ' InitializeGlobalVars 35| ' Should be called at beginning of 'Sub Main' from Scripts 36| ' to concatenate FolderStrings and set other global variables. 37| ' ------------------------------------------------------------------------------------------- 38| ' ConcatenateFolderStr 39| ' Descript: This function simply concatenate given folder / subfolderstrings 40| ' and / or sets the given folderstrings that they ends with a Backslash. 41| ' Params: MainfolderString, optionally SubfolderString 42| ' Returns: String 43| ' ------------------------------------------------------------------------------------------- 44| ' ErrMsg 45| ' Descript: This function formats an Errormessage with Number, Description and a 46| ' detailed Callstack-List from a given ErrorObject. 47| ' This Message will returned by the Function as String. 48| ' Optionally with Parameter two and three you can force/supress a 49| ' Messagebox-Output and/or a Debugwindow-Output. 50| ' The Messagebox also lets the user choose to try continue with Script 51| ' or to exit it. 52| ' 53| ' In every Function, Sub or Property of all used Script / Classes / Libs 54| ' this must specified as ErrHandler like: 55| ' 56| ' Function xyz() 57| ' >> On Error Goto ErrHandler 58| ' 59| ' [...CODE TO EXECUTE...] 60| ' 61| ' Escape: 62| ' Exit Function 63| ' ErrHandler: 64| ' >> ErrMsg(Err, [bErrMsgBox], [bErrDebugPrint]) 65| ' >> Resume Escape 66| ' End Function 67| ' 68| ' Params: vbErrorObject, optionally Boolean bErrMsgBox + bErrDebugPrint 69| ' Returns: String 70| ' ------------------------------------------------------------------------------------------- 71| ' FreeObject 72| ' Descript: Every created Object must be freed to avoid memory slack. 73| ' Params: any Object / Variable 74| ' Returns: 75| ' 76| '-------------------------------------------------------------------------------------------------- 77| ' 78| ' Public Enumerations: 79| ' Public Types: 80| ' Public API-Declarations: 81| ' Public Constants: 82| ' 83| ' ... see detailed list at end of file ... 84| ' 85| '-------------------------------------------------------------------------------------------------- 86| ' 87| ' VersionChanges: 88| ' 89| ' V 1.0 (14-Mar-2003) initial release 90| ' 91| ' V 1.01 (31-Mar-2003) added: Enum PS_pngInterlaceType; Enum PS_pngFilter; Type PSffPNG; 92| ' extended Type WorkflowChildCatObject with: PS_AutoAssign, PS_IsRunning 93| ' 94| ' V 1.02 (10-May-2003) Moved hn_GlobalVars.lib into this file. 95| ' 96| ' V 1.2 (02-Jun-2003) created a cleaned-up PublicVersion of this lib. 97| ' added: LibVersion; hnPuplicDeclarationsLibCheckVersionAgainst; 98| ' 99| ' V 1.21 (22-Jun-2003) added: Type WaitDialogSummary (ClsWaitdialog) 100| ' 101| ' V 1.22 (25-Jun-2003) added: Constants for lcms ICC Tools 102| ' 103| ' 104| '-------------------------------------------------------------------------------------------------- 105| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 106| 107| 108| Option Explicit 109| 110| 111| 'LibVersion 112| Private Const LibVersionString As String = "V 1.22 (25-Jun-2003)" 113| Private Const LibVersion As Long = 12200 114| 'SCRIPTNAME 115| Private Const SCRIPTNAME As String = "_hnLibPuplicDeclarations" 116| 117| 118| 119| '###################### Public Declarations #################### 120| 121| ' ------------------------------------------------------------------------------------------- 122| ' ClsWaitdialog 123| ' --------- 124| 125| Public Type WaitDialogSummary 126| allFiles As Long 127| procFiles As Long 128| skippedFiles As Long 129| procTotalFilesize As Double 130| procTotalFilesizeStr As String 131| procDuration As Double 132| procDurationStr As String 133| procStart As Date 134| procEnd As Date 135| End Type 136| 137| 138| ' ------------------------------------------------------------------------------------------- 139| ' ClsRegKey 140| ' --------- 141| 142| Public Enum MyVarType 143| AsEmpty = 0 'Variant variable is Empty. It has never been assigned a value. 144| AsNull = 1 'Variant variable is Null. 145| AsByte = 17 'Variable contains a byte value. 146| AsInteger = 2 'Variable contains an Integer value. 147| AsLong = 3 'Variable contains a Long value. 148| AsSingle = 4 'Variable contains a Single value. 149| AsDouble = 5 'Variable contains a Double value. 150| AsCurrency = 6 'Variable contains a Currency value. 151| AsString = 8 'Variable contains a String value. 152| AsBoolean = 11 'Variable contains a Boolean value. 153| AsVariant = 12 'Variable contains a Variant value. 154| AsDecimal = 14 'Variable contains a 96 bit scaled real. 155| AsDate = 7 'Variable contains a Date value. 156| End Enum 157| 158| Public Enum MyLittleVarType 159| As_Byte = 17 'Variable contains a byte value. 160| As_Integer = 2 'Variable contains an Integer value. 161| As_Long = 3 'Variable contains a Long value. 162| As_Single = 4 'Variable contains a Single value. 163| As_Double = 5 'Variable contains a Double value. 164| As_Currency = 6 'Variable contains a Currency value. 165| As_String = 8 'Variable contains a String value. 166| As_Boolean = 11 'Variable contains a Boolean value. 167| As_Decimal = 14 'Variable contains a 96 bit scaled real. 168| As_Date = 7 'Variable contains a Date value. 169| End Enum 170| 171| 172| 173| ' ------------------------------------------------------------------------------------------- 174| ' ClsRegTreePresets 175| ' ----------------- 176| 177| Public Enum PresetRefreshInfo 178| CanceledByUser = 0 179| StoreSet = 1 180| SuccessfulLoaded = 2 181| UnexpectedError = 16 182| End Enum 183| 184| 185| 186| ' ------------------------------------------------------------------------------------------- 187| ' FncUtils.lib 188| ' ------------ 189| 190| Public Enum VarIsOf 191| TypeEmpty = vbEmpty 192| TypeNull = vbNull 193| TypeInteger = vbInteger 194| TypeLong = vbLong 195| TypeSingle = vbSingle 196| TypeDouble = vbDouble 197| TypeCurrency = vbCurrency 198| TypeDate = vbDate 199| TypeString = vbString 200| TypeObject = vbObject 201| TypeError = vbError 202| TypeBoolean = vbBoolean 203| TypeVariant = vbVariant 204| TypeDataObject = vbDataObject 205| TypeDecimal = vbDecimal 206| TypeByte = vbByte 207| TypeUserDefinedType = vbUserDefinedType 208| End Enum 209| 210| Public Enum BrowseForFileBox 211| OnlyExistingFiles = 0 'Only allow the user To Select a file that exists. 212| ConfirmCreation = 1 'Confirm creation when the user selects a file that does Not exist. 213| NewAndExistingFiles = 2 'Allow the user To Select Any file whether it exists Or Not. 214| End Enum 215| 216| Public Enum DirParams 217| vbNormal = vbNormal 218| vbDirectory = vbDirectory 219| vbVolume = vbVolume 220| End Enum 221| 222| Public Enum DT 223| Local 224| UNC 225| End Enum 226| 227| Public Enum FileDateType 228| lastModified = 0 229| lastAccess = 1 230| created = 2 231| End Enum 232| 233| Public Type PathStrObj 234| DType As DT 235| DName As String 236| PathNoDrive As String 237| End Type 238| 239| Public Type FileStrObj 240| ValidPathStr As Boolean 241| UNC_Path As Boolean 242| PathFull As String 243| PathWithDrive As String 244| PathNoDrive As String 245| Drive As String 246| FBasename As String 247| FName As String 248| FType As String 249| End Type 250| 251| '---------------------------------------------- 252| 'needed for StringValidation and AutoCorrection 253| Public Enum StringType 254| numeric = 1 255| alpha = 2 256| alphanumeric = 3 257| alphanumericFileName = 4 258| alphanumericFileNameNoBlancs = 7 259| alphanumericPathStr = 5 260| alphanumericPathStrNoBlancs = 8 261| germanUmlaut = 6 262| germanUmlautsConverted = 21 263| End Enum 264| 265| Public Enum StringCorrectionType 266| None = 0 267| OnlyGermanUmlauts = 1 268| FullCleaning = 2 269| End Enum 270| 271| Public Type StrValidationObj 272| 's As String 273| Typ As StringType 274| isValid As Boolean 275| hasGermanUmlauts As Boolean 276| End Type 277| 278| 279| 280| ' ------------------------------------------------------------------------------------------- 281| ' WIN-API 282| ' ------- 283| 284| 285| '----------------------------------------- 286| ' This is needed for the ShellandWait-Function which I have taken from: 287| ' http://www.freevbcode.com/ShowCode.Asp?ID=99 288| Public Const STATUS_PENDING = &H103& 289| Public Const PROCESS_QUERY_INFORMATION = &H400 290| Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 291| Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long 292| Public Enum ShellWindowStyle 293| vbNormalFocus = vbNormalFocus 294| vbNormalNoFocus = vbNormalNoFocus 295| vbHidden = vbHidden 296| vbMinimizedNoFocus = vbMinimizedNoFocus 297| vbMinimizedFocus = vbMinimizedFocus 298| vbMaximizedFocus = vbMaximizedFocus 299| End Enum 300| '----------------------------------------- 301| 302| 303| '----------------------------------------- 304| ' This is needed for the hn_ShortPath-Function 305| Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long 306| '----------------------------------------- 307| 308| 309| '----------------------------------------- 310| ' This is needed to switch Screensaver on/off etc. 311| ' (The Black Box for Visual Basic 2.2) 312| Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long 313| '----------------------------------------- 314| 315| 316| '----------------------------------------- 317| ' Get WindowHandle by Name 318| Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 319| 320| ' Change WindowStyle 321| Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 322| Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 323| Public Const GWL_EXSTYLE = (-20) 324| Public Const WS_EX_TRANSPARENT = &H20& 325| '----------------------------------------- 326| 327| 328| 329| 330| ' ------------------------------------------------------------------------------------------- 331| ' lcms ICC Tools 332| ' -------------- 333| Public Const LCMS_TIFF_EXE As String = MacroDir & "\..\progs\tifficc.exe" 'Fullpath to the lcms tifficc.exe 334| Public Const LCMS_JPEG_EXE As String = MacroDir & "\..\progs\jpegicc.exe" 'Fullpath to the lcms jpegicc.exe 335| Public Const LCMS_SRGB_PROFILE As String = MacroDir & "\..\progs\lcms_sRGB.icm" 'Fullpath to the icm/icc Profile for Standard-RGB-Colorspace 336| Public Const LCMS_TIFF_PARAM As String = "-t0 -c2" 'Commandline parameters for the tifficc.exe 337| Public Const LCMS_JPEG_PARAM As String = "-t0 -c2" 'Commandline parameters for the jpegicc.exe 338| Public Const LCMS_TEMPDIR As String = Environ("TEMP") 'temporary dir for file conversions 339| 340| 341| 342| ' ------------------------------------------------------------------------------------------- 343| ' GlobalVars 344| ' ---------- 345| 346| 'Der Name des Subfolders innerhalb des IMatchScriptsfolders mit meinen Scripten und sonstigem Kram 347| Private Const MYSUBFOLDER As String = "hn273_Public" 348| 349| 'Namen einiger ScriptSektionen in der Registry 350| 351| Public Const REGTREENAME_PHOTOSHOPCONVERSION As String = "PhotoshopConversion" 352| Public Const REGTREENAME_AGFADUOSCAN As String = "AgfaDuoscannBatch" 353| 354| 355| 'Programmglobale Variablen 356| Public SCRIPTFOLDER As String 357| Public SCRIPTSUBFOLDER As String 358| Public ICONS As String 359| Public THIS_MACHINE_RAM As Long 360| Public DEFAULT_WORKFLOWFOLDER As String 361| Public OFFLINECACHE_MAINFOLDER As String 362| Public REPORTFOLDER As String 363| Public PSEXEC As String 364| 365| 366| 367| '########### Functions ########################################## 368| 369| 370| Public Function hnPuplicDeclarationsLibCheckVersionAgainst(ByRef neededLong As Long, Optional ByRef suppressMsgBox As Boolean = False) As Boolean 371| If neededLong <= LibVersion Then 372| hnPuplicDeclarationsLibCheckVersionAgainst = True 373| Else 374| hnPuplicDeclarationsLibCheckVersionAgainst = False 375| If Not suppressMsgBox Then 376| MsgBox "The version of the " & SCRIPTNAME & " is to old: " & LibVersionString & " = long(" & LibVersion & ")" & vbNewLine & vbNewLine & _ 377| "Maybe that you have overwritten the file contained in the ZIP file of this Script" & vbNewLine & _ 378| "with an outdated version delivered with another script in your Script folder." & vbNewLine & vbNewLine & _ 379| "Please check and reinstall the file from the ZIP file of this Script" & vbNewLine & _ 380| "with version: long(" & CStr(neededLong) & "), or greater.", vbInformation,"Outdated Classfile: " & SCRIPTNAME 381| End If 382| End If 383| End Function 384| 385| 386| 387| 388| Public Sub InitializeGlobalVars(Optional ByRef ForTestDataBase As Boolean = False) 389| 390| On Error GoTo ErrHandler 391| 392| THIS_MACHINE_RAM = 1500000000 393| DEFAULT_WORKFLOWFOLDER = "\\EMINENZ\WORK\WORKFLOW\" 394| REPORTFOLDER = "\\EMINENZ\BOOTDRIVE\Logs_Reports\" 395| PSEXEC = "\\EMINENZ\BOOTDRIVE\bin_local\psexec.exe" 396| OFFLINECACHE_MAINFOLDER = "P:\_IMOfflineCache\" 397| 398| SCRIPTFOLDER = ConcatenateFolderStr(Application.GetApplicationVariable("Application.ScriptFolder")) 399| SCRIPTSUBFOLDER = ConcatenateFolderStr(SCRIPTFOLDER, MYSUBFOLDER) 400| ICONS = ConcatenateFolderStr(SCRIPTSUBFOLDER, "icons") 401| 402| Escape: 403| Exit Sub 404| ErrHandler: 405| ErrMsg(Err) 406| Resume Escape 407| 408| End Sub 409| 410| 411| Private Function ConcatenateFolderStr(ByVal Mainfolder As String, Optional ByVal Subfolder As String) As String 412| 413| On Error GoTo ErrHandler 414| 415| If Right(Mainfolder,1) <> "\" Then 416| Mainfolder = Mainfolder & "\" 417| End If 418| If Subfolder <> "" Then 419| If Right(Subfolder,1) <> "\" Then 420| Subfolder = Subfolder & "\" 421| End If 422| If Left(Subfolder,1) = "\" Then 423| Subfolder = Mid$(Subfolder,2,Len(Subfolder)-1) 424| End If 425| End If 426| 427| ConcatenateFolderStr = Mainfolder & Subfolder 428| 429| Escape: 430| Exit Function 431| 432| ErrHandler: 433| ErrMsg(Err) 434| Resume Escape 435| 436| End Function 437| 438| 439| Public Sub FreeObject(ByRef TheObject As Variant) 440| 441| On Error GoTo ErrHandler 442| 443| Select Case VarType(TheObject) 444| Case 2, 3, 4, 5, 6, 7, 14, 17, 11 445| TheObject = 0 446| 447| Case 1, 9, 12, 13 448| If Not TheObject Is Nothing Then Set TheObject = Nothing 449| 450| Case 36 451| 'TheObject = ? 452| 453| End Select 454| 455| Escape: 456| Exit Sub 457| 458| ErrHandler: 459| ErrMsg(Err) 460| Resume Escape 461| 462| End Sub 463| 464| 465| Public Function ErrMsg(ByRef TheError As ErrObject, Optional ByRef bErrMsgBox As Boolean = True, Optional ByRef bErrDebugPrint As Boolean = True) As String 466| 467| Dim Msg As String, CLines As String, depth As Integer, check As Variant, start As Long, ende As Long 468| Dim ScriptFile As String, Func As String, LineNr As String, Task As String 469| 470| Msg = "Error! (" & Now & ")" & vbNewLine & "Number: " & CStr(TheError.Number) & vbNewLine & "Description: " & TheError.Description & vbNewLine 471| depth = -1 472| CLines = "CallStack:" & vbNewLine & vbNewLine 473| Do 474| depth = depth +1 475| check = CallersLine(depth) 476| If check = "" Then 477| Exit Do 478| Else 479| check = CStr(check) 480| ScriptFile = Mid(check, 2, InStr(1, check, "|") -2) 481| start = InStr(1, check, "|") +1 482| ende = InStr(1, check, "#") 483| Func = Mid(check, start, ende - start) 484| start = InStr(1, check, "#") +1 485| ende = InStr(1, check, "]") 486| LineNr = Mid(check, start, ende - start) 487| start = InStr(1, check, "]") +1 488| Task = Mid(check, start) 489| CLines = CLines & "File: " & ScriptFile & vbNewLine & "Func/Sub: " & Func & vbNewLine & "LineNr: " & LineNr & " = " & Task & vbNewLine & vbNewLine 490| End If 491| Loop 492| Msg = Msg & CLines & "Continue the Script?" 493| 494| ErrMsg = Msg 495| If bErrDebugPrint Then Debug.Print Msg 496| If bErrMsgBox Then 497| If MsgBox(Msg, vbCritical + vbMsgBoxSetForeground + vbYesNo + vbDefaultButton1, "Unexpected Error!") = vbNo Then 498| 'The Sub Main should have a Public Sub named "UNSET_OBJECTS" with a list of FreeObject(xy) method calls. 499| 'This is needed to avoid memory slack. 500| 'I need to know a way to check if a sub or function exists ...?? 501| 'UNSET_OBJECTS 502| Exit All 503| End If 504| End If 505| 506| End Function 507| 508| 509| 510|