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_OLC_GarbageCollector.bas
Needed Modules: [hnPublicDeclarations.lib]
[hnFncUtils.lib]
[hnClsWaitDialog.cls]
hnClsWaitDialog.cls: (590 lines / 325 real codelines / 0 Subs / 2 Functions / 20 Properties)
1| VERSION 1.0 CLASS 2| BEGIN 3| MultiUse = -1 'True 4| END 5| Attribute VB_PredeclaredId = False 6| Attribute VB_Creatable = True 7| Attribute VB_Exposed = True 8| Attribute VB_GlobalNameSpace = False 9| Attribute VB_Name = "clsWaitdialog" 10| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 11| ' 12| 13| ' 14| ' h.nogajski@web.de 15| ' http://horst.nogajski.de 16| ' 17| '-------------------------------------------------------------------------------------------------- 18| ' 19| ' Waitdialog Class (for IMatch SAX-Basic) 20| ' 21| ' Handles the Waitdialog- and StatusbarActions 22| ' 23| ' 24| 'V 1.1 (28-Jun-2003) 25| ' 26| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 27| '-------------------------------------------------------------------------------------------------- 28| ' 29| ' Uses / Embedds 30| ' 31| '#uses "hnPublicDeclarations.lib" 32| '#uses "hnFncUtils.lib" => Needs the IMatch 3 Scripthelping Type Library embedded 33| ' 34| '-------------------------------------------------------------------------------------------------- 35| ' 36| ' Public Functions: 37| ' 38| ' ------------------------------------------------------------------------------------------- 39| ' ClsVersion 40| ' Descript: Returns the revision Version of this Class, 41| ' To allow testing For downward compatibility 42| ' two digits per position, allows for versions such as V 20.12.29 43| ' last position not used in String now 44| ' (could be used for internal releases for example), set to 00 in Long 45| ' Returns: Long 46| ' ------------------------------------------------------------------------------------------- 47| ' ClsVersionString 48| ' Returns: String 49| ' ------------------------------------------------------------------------------------------- 50| ' ClsName 51| ' Descript: returns the Private Const SCRIPTNAME 52| ' Returns: String 53| ' ------------------------------------------------------------------------------------------- 54| ' CheckVersionAgainst 55| ' Descript: Checks a given Long against the ClassVersionNumber. 56| ' The given Long represents the ClassVersionNumber which the 57| ' script-author has used creating his script. 58| ' Params: Long neededLong, Optional Boolean suppressMsgBox 59| ' Returns: Boolean 60| ' ------------------------------------------------------------------------------------------- 61| ' ClassInit 62| ' Descript: Initializes the class instance. Returncodes are: 63| ' 0 for an Error / couldn't be initialized 64| ' -1 for successfull initialization 65| ' 1 if it is already initialized 66| ' Params: 67| ' Returns: Integer 68| ' ------------------------------------------------------------------------------------------- 69| ' ClassUNSET 70| ' Descript: Clears all values of all modulglobal-variables 71| ' After that, the class must/can be initialized again for further using 72| ' Returns: Boolean 73| ' ------------------------------------------------------------------------------------------- 74| ' FunctionName 75| ' Descript: 76| ' Params: 77| ' Returns: 78| ' 79| '-------------------------------------------------------------------------------------------------- 80| ' 81| ' Private Functions: 82| ' 83| ' NamesOfPrivates 84| ' Description of privatesDescription of privates 85| ' 86| '-------------------------------------------------------------------------------------------------- 87| ' 88| ' VersionChanges: 89| ' 90| ' V 1.0 (22-Jun-2003) initial release 91| ' 92| ' V 1.1 (28-Jun-2003) added: ReversedCount =:) 93| ' 94| '-------------------------------------------------------------------------------------------------- 95| ' 96| ' Credits: 97| ' 98| '-------------------------------------------------------------------------------------------------- 99| ' 100| ' Notes: 101| ' 102| '-------------------------------------------------------------------------------------------------- 103| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 104| 105| 106| Option Explicit 107| 108| 109| 'ClassVersion/String 110| Private Const ClassVersionString As String = "V 1.1 (28-Jun-2003)" 111| Private Const ClassVersion As Long = 11000 112| 113| 'SCRIPTNAME is needed for MsgBoxTitles etc. 114| Private Const SCRIPTNAME As String = "ClassWaitdialog" 115| 116| 117| 'Debugging 118| Private bDoClassOutput As Boolean 119| 120| 121| 'ClassInit() 122| Private bClassReady As Boolean 123| Private bSuppressClassNotReadyMsg As Boolean 124| Private bUserCancelEnabled As Boolean 125| Private bUserPressedCancel As Boolean 126| Private DialogTitle As String 127| Private CallingScriptNameStr As String 128| Private CallingScriptVersionStr As String 129| 130| 131| 'The Variables, Arrays and Objects 132| Private Summary As WaitDialogSummary 133| Private procStart As Date 134| Private procEnd As Date 135| Private StartTime As Double 136| Private Duration As Double 137| Private TotalFilesize As Double 138| Private Line1 As String 139| Private Line2 As String 140| Private Line3 As String 141| Private allInt As Integer 142| Private curInt As Integer 143| Private skippedInt As Integer 144| 145| 146| Public Property Get ClsVersion() As Long 147| ClsVersion = ClassVersion 148| End Property 149| 150| Public Property Get ClsVersionString() As String 151| ClsVersionString = ClassVersionString 152| End Property 153| 154| Public Property Get ClsName() As String 155| ClsName = SCRIPTNAME 156| End Property 157| 158| Public Property Get CheckVersionAgainst(ByRef neededLong As Long, Optional ByRef suppressMsgBox As Boolean = False) As Boolean 159| If neededLong <= ClassVersion Then 160| CheckVersionAgainst = True 161| Else 162| CheckVersionAgainst = False 163| If Not suppressMsgBox Then 164| MsgBox "The version of the " & SCRIPTNAME & " is to old: " & ClassVersionString & " = long(" & ClassVersion & ")" & vbNewLine & vbNewLine & _ 165| "Maybe that you have overwritten the file contained in the ZIP file of this Script" & vbNewLine & _ 166| "with an outdated version delivered with another script in your Script folder." & vbNewLine & vbNewLine & _ 167| "Please check and reinstall the file from the ZIP file of this Script" & vbNewLine & _ 168| "with version: long(" & CStr(neededLong) & "), or greater.", vbInformation,"Outdated Classfile: " & SCRIPTNAME 169| End If 170| End If 171| End Property 172| 173| Public Property Get ClassUNSET() As Boolean 174| 'Here comes all modulglobal variables in 175| 'and must be set to false, null and emptystrings, etc. 176| bSuppressClassNotReadyMsg = False 177| bClassReady = False 178| bDoClassOutput = False 179| bUserPressedCancel = False 180| Line1 = "" 181| Line2 = "" 182| Line3 = "" 183| allInt = 0 184| curInt = 0 185| TotalFilesize = 0 186| StartTime = 0 187| Duration = 0 188| ClassUNSET = True 189| End Property 190| 191| 192| Public Property Get ClassInit(ByRef HundertPercentValue As Integer, ByRef FirstLineText As String, Optional ByRef UserCancelEnabled As Boolean = True, Optional ByRef CallingScriptsName As String, Optional ByRef CallingScriptsVersion As String, Optional ByRef SuppressClsNotReadyMsg As Boolean) As Integer 193| 194| On Error GoTo ErrHandler 195| 196| ClassInit = 0 197| bSuppressClassNotReadyMsg = SuppressClsNotReadyMsg 198| 199| If bClassReady Then 200| ClassInit = 1 201| GoTo Escape 202| End If 203| 204| 205| If CallingScriptsName = "" Then 206| CallingScriptNameStr = SCRIPTNAME 207| CallingScriptVersionStr = ClassVersionString 208| Else 209| CallingScriptNameStr = CallingScriptsName 210| CallingScriptVersionStr = CallingScriptsVersion 211| End If 212| DialogTitle = CallingScriptNameStr & " " & CallingScriptVersionStr 213| 214| bUserCancelEnabled = UserCancelEnabled 215| Line1 = FirstLineText 216| allInt = HundertPercentValue 217| StartTime = Timer 218| procStart = Now 219| bClassReady = True 220| ClassInit = -1 221| 222| 223| 'start statusbar and waitdialog 224| Application.StatusBarSetText Line1 225| Application.StatusBarShowPercentage 0, allInt 226| Application.WaitDialogOpen Line1, 0, allInt, bUserCancelEnabled 227| 228| 229| Escape: 230| Exit Property 231| 232| ErrHandler: 233| ErrMsg(Err) 234| Resume Escape 235| 236| End Property 237| 238| 239| Public Property Get SetLine1(ByRef txt As String) As Boolean 240| 241| On Error GoTo ErrHandler 242| 243| Line1 = txt 244| 245| SetLine1 = RefreshIt(1) 246| 247| Escape: 248| Exit Property 249| 250| ErrHandler: 251| ErrMsg(Err) 252| Resume Escape 253| 254| End Property 255| 256| 257| Public Property Get SetLine2(ByRef txt As String) As Boolean 258| 259| On Error GoTo ErrHandler 260| 261| Line2 = txt 262| 263| SetLine2 = RefreshIt(2) 264| 265| Escape: 266| Exit Property 267| 268| ErrHandler: 269| ErrMsg(Err) 270| Resume Escape 271| 272| End Property 273| 274| 275| Public Property Get SetLine2_SourcefileInfo(ByRef FullpathOfSourceFile As String, Optional ByRef AddFilesize As Boolean = False) As Boolean 276| 277| On Error GoTo ErrHandler 278| 279| Line2 = "[ " & curInt & " / " & allInt & " ] is: " & hn_FileStrObject(FullpathOfSourceFile).FBasename 280| If hn_FileExists(FullpathOfSourceFile, vbNormal) Then 281| Line2 = Line2 & " [ " & hn_friendlyFilesizeStr(FullpathOfSourceFile) & " ]" 282| If AddFilesize Then TotalFilesize = TotalFilesize + FileLen(FullpathOfSourceFile) 283| End If 284| 285| SetLine2_SourcefileInfo = RefreshIt(2) 286| 287| Escape: 288| Exit Property 289| 290| ErrHandler: 291| ErrMsg(Err) 292| Resume Escape 293| 294| End Property 295| 296| 297| Public Property Get SetLine3(ByRef txt As String) As Boolean 298| 299| On Error GoTo ErrHandler 300| 301| Line3 = txt 302| 303| SetLine3 = RefreshIt(3) 304| 305| Escape: 306| Exit Property 307| 308| ErrHandler: 309| ErrMsg(Err) 310| Resume Escape 311| 312| End Property 313| 314| 315| Public Property Get AddFilesize(ByRef FullpathOfFile As String) As Boolean 316| 317| On Error GoTo ErrHandler 318| 319| If hn_FileExists(FullpathOfFile,vbNormal) Then 320| TotalFilesize = TotalFilesize + FileLen(FullpathOfFile) 321| End If 322| 323| AddFilesize = True 324| 325| Escape: 326| Exit Property 327| 328| ErrHandler: 329| ErrMsg(Err) 330| Resume Escape 331| 332| End Property 333| 334| 335| Public Property Get SetPercentage() As Boolean 336| 337| On Error GoTo ErrHandler 338| 339| DoEvents 340| 341| 'refresh statusbar and waitdialog 342| Application.StatusBarSetPercentage curInt 343| Application.WaitDialogSetPercentage curInt 344| 345| SetPercentage = True 346| 347| Escape: 348| Exit Property 349| 350| ErrHandler: 351| ErrMsg(Err) 352| Resume Escape 353| 354| End Property 355| 356| 357| Public Property Get Closes() As Boolean 358| 359| On Error GoTo ErrHandler 360| 361| 'Reset statusbar and close waitdialog 362| Application.StatusBarHidePercentage 363| Application.WaitDialogClose 364| 365| 'Get ProcessDuration 366| Duration = Timer - StartTime 367| If Duration < 0 Then Duration = Duration + 86400 368| procEnd = Now 369| 370| Closes = True 371| 372| Escape: 373| Exit Property 374| 375| ErrHandler: 376| ErrMsg(Err) 377| Resume Escape 378| 379| End Property 380| 381| 382| Public Property Get UserHasCanceled() As Boolean 383| 384| On Error GoTo ErrHandler 385| 386| DoEvents 387| 388| If Application.WaitDialogIsCanceled Then 389| 390| 'Get ProcessDuration 391| Duration = Timer - StartTime 392| If Duration < 0 Then Duration = Duration + 86400 393| procEnd = Now 394| 395| Application.StatusBarSetText("PROCESS PAUSES BECAUSE USER PRESSED CANCELBUTTON") 396| SetLine3("PROCESS PAUSES BECAUSE USER PRESSED CANCELBUTTON") 397| RefreshIt(3) 398| 399| If MsgBox(ProcessSummaryString() & vbNewLine & vbNewLine & vbNewLine & " - DO YOU REALLY WANT TO ABORT THIS PROCESS? -", vbYesNo, DialogTitle) = vbYes Then 400| UserHasCanceled = True 401| bUserPressedCancel = True 402| Else 403| Application.WaitDialogClose 404| Application.StatusBarSetText(Line1) 405| Application.WaitDialogOpen Line1, 0, allInt, bUserCancelEnabled 406| SetPercentage 407| SetLine3("PROCESS WILL CONTINUE NOW") 408| RefreshIt(3) 409| procEnd = CDate(0) 410| Duration = 0 411| End If 412| 413| End If 414| 415| Escape: 416| Exit Property 417| 418| ErrHandler: 419| ErrMsg(Err) 420| Resume Escape 421| 422| End Property 423| 424| 425| Public Property Get CountProcessedFile() As Boolean 426| 427| On Error GoTo ErrHandler 428| 429| curInt = curInt +1 430| CountProcessedFile = True 431| 432| Escape: 433| Exit Property 434| 435| ErrHandler: 436| ErrMsg(Err) 437| Resume Escape 438| 439| End Property 440| 441| Public Property Get InitReversedCount(ByVal MaxIntValue As Integer) As Boolean 442| 443| On Error GoTo ErrHandler 444| 445| curInt = MaxIntValue 446| InitReversedCount = True 447| 448| Escape: 449| Exit Property 450| 451| ErrHandler: 452| ErrMsg(Err) 453| Resume Escape 454| 455| End Property 456| 457| Public Property Get CountProcessedFileReversed() As Boolean 458| 459| On Error GoTo ErrHandler 460| 461| curInt = curInt -1 462| CountProcessedFileReversed = True 463| 464| Escape: 465| Exit Property 466| 467| ErrHandler: 468| ErrMsg(Err) 469| Resume Escape 470| 471| End Property 472| 473| Public Property Get CountSkippedFile() As Boolean 474| 475| On Error GoTo ErrHandler 476| 477| skippedInt = skippedInt +1 478| CountSkippedFile = True 479| 480| Escape: 481| Exit Property 482| 483| ErrHandler: 484| ErrMsg(Err) 485| Resume Escape 486| 487| End Property 488| 489| Public Property Get ProcessSummary() As WaitDialogSummary 490| 491| On Error GoTo ErrHandler 492| 493| ProcessSummary.procStart = procStart 494| ProcessSummary.procEnd = procEnd 495| ProcessSummary.procDuration = Duration 496| ProcessSummary.procDurationStr = hn_friendlyTimerStr(Duration) 497| ProcessSummary.allFiles = allInt 498| ProcessSummary.procFiles = curInt 499| ProcessSummary.skippedFiles = skippedInt 500| ProcessSummary.procTotalFilesize = TotalFilesize 501| ProcessSummary.procTotalFilesizeStr = hn_friendlyBitStr(TotalFilesize) 502| 503| Escape: 504| Exit Property 505| 506| ErrHandler: 507| ErrMsg(Err) 508| Resume Escape 509| 510| End Property 511| 512| Public Property Get ProcessSummaryMessageBox() As Boolean 513| 514| On Error GoTo ErrHandler 515| 516| If bClassReady And Not bUserPressedCancel Then 517| MsgBox ProcessSummaryString(), vbInformation, DialogTitle 518| ProcessSummaryMessageBox = True 519| End If 520| 521| Escape: 522| Exit Property 523| 524| ErrHandler: 525| ErrMsg(Err) 526| Resume Escape 527| 528| End Property 529| 530| Private Function ProcessSummaryString() As String 531| 532| On Error GoTo ErrHandler 533| 534| Dim s As WaitDialogSummary 535| s = ProcessSummary 536| 537| Dim msg As String 538| msg = Line1 & vbNewLine 539| msg = msg & vbNewLine & "Process started: " & CStr(s.procStart) 540| msg = msg & vbNewLine & "Process paused/ended: " & CStr(s.procEnd) 541| msg = msg & vbNewLine & vbNewLine & "Images treated: " & CStr(s.procFiles) & " (out of " & CStr(s.allFiles) & ")" 542| msg = msg & vbNewLine & "Images successful processed: " & CStr(s.procFiles - s.skippedFiles) & " with total " & s.procTotalFilesizeStr & " filesize" 543| msg = msg & vbNewLine & "Images skipped: " & CStr(s.skippedFiles) 544| 'msg = msg & vbNewLine & "Images has failed: " & CStr("") 545| msg = msg & vbNewLine & vbNewLine & "Process tooks " & s.procDurationStr 546| 547| ProcessSummaryString = msg 548| 549| Escape: 550| Exit Function 551| 552| ErrHandler: 553| ErrMsg(Err) 554| Resume Escape 555| 556| End Function 557| 558| Private Function RefreshIt(ByRef Lines As Integer) As Boolean 559| 560| On Error GoTo ErrHandler 561| 562| Dim DisplayText As String 563| 564| ProcessSummary 565| 566| Select Case Lines 567| Case 3 568| DisplayText = Line1 & vbNewLine & Line2 & vbNewLine & Line3 569| Case 2 570| DisplayText = Line1 & vbNewLine & Line2 571| Case 1 572| DisplayText = Line1 573| Case Else 574| DisplayText = Line1 575| End Select 576| 577| Application.WaitDialogSetText DisplayText 578| RefreshIt = True 579| 580| Escape: 581| Exit Function 582| 583| ErrHandler: 584| ErrMsg(Err) 585| Resume Escape 586| 587| End Function 588| 589| 590|