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]
hn_OLC_GarbageCollector.bas: (614 lines / 384 real codelines / 3 Subs / 6 Functions / 0 Properties)
1| '#Reference {420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#D:\WINNT\System32\scrrun.dll#Microsoft Scripting Runtime 2| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 3| ' 4| 5| ' 6| ' h.nogajski@web.de 7| ' http://horst.nogajski.de 8| ' 9| '-------------------------------------------------------------------------------------------------- 10| ' 11| ' OLC-GarbageCollector (IMatch SAX-Basic) 12| ' 13| ' This Script checks all existing Images in OfflineCacheFolder of the active Database 14| ' and deletes ownerless OLC-Images. Additionally you can select some Categories from which 15| ' you want delete the Images OfflineCache-pendants. 16| ' 17| ' 18| 'V 1.0 (28-Jun-2003) 19| ' 20| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 21| '-------------------------------------------------------------------------------------------------- 22| ' 23| ' Uses / Embedds 24| ' 25| '#uses "lib\hnPublicDeclarations.lib" 26| '#uses "lib\hnFncUtils.lib" => Needs the IMatch 3 Scripthelping Type Library embedded 27| '#uses "lib\hnClsWaitdialog.cls" 28| ' 29| ' 30| ' This Script itself needs the Microsoft Scripting Type Library embedded (check: Edit->References) 31| ' 32| '-------------------------------------------------------------------------------------------------- 33| ' 34| ' Public Functions: 35| ' 36| ' ------------------------------------------------------------------------------------------- 37| ' FunctionName 38| ' Descript: 39| ' Params: 40| ' Returns: 41| ' 42| '-------------------------------------------------------------------------------------------------- 43| ' 44| ' VersionChanges: 45| ' 46| ' V 1.0 (28-Jun-2003) initial release 47| ' 48| '-------------------------------------------------------------------------------------------------- 49| ' 50| ' Notes: Please type in the abolute Path to your IMatch-Offlinecache-Rootfolder 51| ' and set the Private Const KillFilesOnlyAsSimulation to False, so that you really can 52| ' delete your Garbage ;-) 53| ' 54| ' Normally IMatch holds the OfflineCache in sync with the Database-Images. 55| ' If you remove or delete Images in IMatch, the corresponding OLC-Images will deleted. 56| ' But if you have an older Database (created 'once a time' with an older IMatch-Version) 57| ' there maybe some OfflineCache-slack. (e.g. if you have deleted Images outside of IMatch 58| ' or for what reasons however the Cache wasn't synchronized by IMatch) 59| ' 60| '-------------------------------------------------------------------------------------------------- 61| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 62| 63| 64| 65| Option Explicit 66| 67| 68| 'type in the Fulllpath to your Offlinecache-Rootfolder as you have done in Preferences 69| 'since Version 3.3.0.8 IMatch has (will have) a global Variable which holds this Value 70| Private Const OLC_MAINFOLDERPATH As String = "P:\_IMOfflineCache\" 71| Private Const KillFilesOnlyAsSimulation As Boolean = False 72| 73| 74| 'Set Values for Debugging and ErrorMessages 75| Private Const SuppressClassNotReadyMsg As Boolean = False 76| Private Const DoClassDebug As Boolean = False 77| Private Const DoScriptDebug As Boolean = False 78| 79| 80| 81| 'SCRIPTNAME & ScriptVersionString is needed for RegistryClasses, MsgBoxTitles etc. 82| Private Const SCRIPTNAME As String = "OLC-GarbageCollector" 83| Private Const ScriptVersionString As String = "V 1.0 (28-Jun-2003)" 84| 'is used to display Scriptname and Version as title of messageboxes and dialogs 85| Private Const DialogTitle As String = SCRIPTNAME & " " & ScriptVersionString 86| 87| 88| 'Modulglobal Classes + Objects (delete those you do not need) 89| Private WD As clsWaitdialog 90| Private DB As Database 91| Private Selection As Images 92| Private PicT As Image 93| Private IbuckHas As ImageBucket 94| Private IbuckHasnot As ImageBucket 95| Private IbuckKill As ImageBucket 96| Private OLCfiles As Dictionary 97| Private Delfiles As Dictionary 98| Private KillCatImages As Categories 99| Private Ownerless As Long 100| Private Totaltime As Double 101| Private CatList() As String 102| Private DBOLCfolder As String 103| Private olcname As String 104| Private oid As String 105| 106| 107| Sub Main 108| 109| On Error GoTo ErrHandler 110| 111| 'Check Class-/LibVersions and initialize global Variables 112| 113| If hnPuplicDeclarationsLibCheckVersionAgainst(12200) Then 114| InitializeGlobalVars 115| Else 116| GoTo Escape 117| End If 118| 119| If Not hnFncUtilsLibCheckVersionAgainst(14000) Then GoTo Escape 120| 121| Set DB = Application.ActiveDatabase 122| If DB Is Nothing Then 123| MsgBox DialogTitle & vbNewLine & vbNewLine & "We have no open database!" & vbNewLine & "Script stops now!", vbExclamation, DialogTitle 124| GoTo Escape 125| End If 126| 127| Set Selection = DB.GetImages 128| If (Selection Is Nothing) Or (Selection.Count = 0) Then 129| MsgBox DialogTitle & vbNewLine & vbNewLine & "No valid selection of Images!" & vbNewLine & "Script stops now!", vbExclamation, DialogTitle 130| GoTo Escape 131| End If 132| 133| Set WD = New clsWaitdialog 134| If Not WD.CheckVersionAgainst(11000) Then GoTo Escape 135| 136| 'Build the OfflineCache-Folderstring of active Database 137| DBOLCfolder = hn_BuildOfflineCacheFolderStr(DB, OLC_MAINFOLDERPATH) 138| 139| If DBOLCfolder = "" Then 140| MsgBox "For the active database [" & hn_FileStrObject(DB.FileName).FName & "] does no OfflineCacheFolder exist." & vbNewLine & vbNewLine & "You have defined the Private Const OLC_MAINFOLDERPATH = [" & OLC_MAINFOLDERPATH & "]" & vbNewLine & vbNewLine & Infomsg(), vbInformation , DialogTitle 141| GoTo Escape 142| End If 143| 144| 'initialize Buckets and Dictionaries 145| Set IbuckHas = DB.CreateImageBucket 146| Set IbuckHasnot = DB.CreateImageBucket 147| Set IbuckKill = DB.CreateImageBucket 148| Set OLCfiles = New Dictionary 149| Set Delfiles = New Dictionary 150| 151| 152| 'Open the Dialog 153| If DoDialog <> -1 Then GoTo Escape 'If it doesn't return True, we stop the script. 154| 155| 156| 157| 'After all Lists are build and checked, we delete all files defined as garbage, if there are any. 158| If Not (Delfiles.Count) > 0 Then 159| 160| MsgBox "There is nothing to do, garbage = 0%", vbInformation, DialogTitle 161| GoTo Escape 162| 163| Else 164| 165| 'Initialize WaitdialogClass 166| If WD.ClassInit(Delfiles.Count, "OLC-GarbageCollector now reconciles your Cache with Database.", True, SCRIPTNAME, ScriptVersionString) <> -1 Then 167| MsgBox DialogTitle & vbNewLine & vbNewLine & "Couldn't initialize the WaitDialogClass!" & vbNewLine & "Script stops now!", vbExclamation, DialogTitle 168| GoTo Escape 169| End If 170| WD.SetLine2("... killing garbage files") 171| 172| Dim x As Variant 173| For Each x In Delfiles 174| If DoScriptDebug Then Debug.Print "- try to kill: " & OLCfiles.Item(x) 175| If Not hn_KillFile(Delfiles.Item(x), KillFilesOnlyAsSimulation) Then 176| WD.CountSkippedFile 177| If DoScriptDebug Then Debug.Print " - FAILURE" 178| Else 179| If DoScriptDebug Then Debug.Print " - success" 180| End If 181| WD.SetLine3("files left for killing: " & CStr(CInt(Delfiles.Count) - CInt(WD.ProcessSummary.procFiles))) 182| WD.CountProcessedFile 183| WD.SetPercentage 184| If WD.UserHasCanceled Then GoTo Escape 185| Next x 186| 187| WD.Closes 188| Totaltime = Totaltime + WD.ProcessSummary.procDuration 189| MsgBox "Process duration: " & hn_friendlyTimerStr(Totaltime) & vbNewLine & vbNewLine & "Have treated " & WD.ProcessSummary.procFiles & " Images out of " & Delfiles.Count & vbNewLine & vbNewLine & "killed garbage: " & CStr(WD.ProcessSummary.procFiles - WD.ProcessSummary.skippedFiles) & vbNewLine & "skipped files: " & WD.ProcessSummary.skippedFiles, vbInformation, DialogTitle 190| WD.ClassUNSET 191| 192| End If 193| 194| Escape: 195| UNSET_OBJECTS 196| Exit Sub 197| 198| ErrHandler: 199| ErrMsg(Err) 200| Resume Escape 201| 202| End Sub 203| 204| Public Sub UNSET_OBJECTS 205| FreeObject(WD) 206| FreeObject(DB) 207| FreeObject(Selection) 208| FreeObject(PicT) 209| FreeObject(IbuckHas) 210| FreeObject(IbuckHasnot) 211| FreeObject(IbuckKill) 212| FreeObject(Delfiles) 213| FreeObject(OLCfiles) 214| FreeObject(KillCatImages) 215| End Sub 216| 217| Private Function FillBucket(ByVal cat As Category, ByVal buck As ImageBucket) 218| 219| On Error GoTo ErrHandler 220| 221| Dim Childcategories As Categories, cat2 As Category 222| 223| buck.CombineImages(cat.Images) 224| 225| Set Childcategories = cat.Children 226| If Not Childcategories Is Nothing Then 227| If Childcategories.Count > 0 Then 228| For Each cat2 In Childcategories 229| FillBucket(cat2, buck) 230| Next cat2 231| End If 232| End If 233| 234| Escape: 235| FreeObject(Childcategories) 236| FreeObject(cat2) 237| Exit Function 238| 239| ErrHandler: 240| ErrMsg(Err) 241| Resume Escape 242| 243| End Function 244| 245| 246| Private Sub BuildLists(ByVal AllLists As Boolean) 247| 248| On Error GoTo ErrHandler 249| 250| Dim cat As Category, x As Variant 251| 252| 253| If AllLists Then 254| 255| 'Initialize WaitdialogClass 256| If WD.ClassInit(Selection.Count, "Checking for OfflineCacheImages [" & Selection.Count & "] ... ", True, SCRIPTNAME, ScriptVersionString) <> -1 Then 257| MsgBox DialogTitle & vbNewLine & vbNewLine & "Couldn't initialize the WaitDialogClass!" & vbNewLine & "Script stops now!", vbExclamation, DialogTitle 258| GoTo Escape 259| End If 260| 261| 262| 'Read all files found in OLC-Folder into a Dictionary-Object 263| '(OID as Key; Fullpath as Value | Note: the filename (without path and filetype) of OfflineCacheImages are the OID from its owner-image) 264| WD.SetLine2("checking files in OLC-Folder...") 265| OLCDirIntoDictionary(OLCfiles, DBOLCfolder, True) 266| 267| 268| WD.SetLine2("checking all DatabaseImages for OLC-pendants ...") 269| For Each PicT In Selection 270| 271| WD.CountProcessedFile 272| olcname = hn_BuildFolderStr(DBOLCfolder, Left(CStr(PicT.OID), 2)) & PicT.OID & ".jpg" 273| 274| If hn_FileExists(olcname) Then 275| IbuckHas.CombineImage(PicT) 276| Else 277| IbuckHasnot.CombineImage(PicT) 278| End If 279| WD.SetLine3(CStr(WD.ProcessSummary.procFiles)) 280| WD.SetPercentage 281| If WD.UserHasCanceled Then GoTo Escape 282| 283| Next PicT 284| 285| WD.Closes 286| Totaltime = WD.ProcessSummary.procDuration 287| WD.ClassUNSET 288| 289| Ownerless = CLng(OLCfiles.Count - IbuckHas.Count) 290| 291| 'At this step we have filled 2 Buckets and 1 Dictionary 292| 'IbuckHas, IbuckHasnot = contains the total Images which are in Database sorted via have or have not an OLC-Pendant 293| 'OLCfiles = contains all Images found in the OfflineCacheFolder 294| 'Also we know the amount of ownerless OLC-Images (stored in: Ownerless) 295| 296| End If 297| 298| 299| 'Clear the KillingList-Bucket 300| IbuckKill.Clear 301| 'Fill the bucket with Images of all userselected Cats including their Childcats 302| If Not KillCatImages Is Nothing Then 303| If KillCatImages.Count > 0 Then 304| 'Initialize WaitdialogClass 305| If WD.ClassInit(KillCatImages.Count, "Building Lists with garbage files and files to preserve ...", False, SCRIPTNAME, ScriptVersionString) <> -1 Then 306| MsgBox DialogTitle & vbNewLine & vbNewLine & "Couldn't initialize the WaitDialogClass!" & vbNewLine & "Script stops now!", vbExclamation, DialogTitle 307| GoTo Escape 308| End If 309| WD.SetLine2("... building category list ...") 310| For Each cat In KillCatImages 311| FillBucket cat, IbuckKill 312| WD.CountProcessedFile 313| WD.SetPercentage 314| Next cat 315| WD.Closes 316| Totaltime = Totaltime + WD.ProcessSummary.procDuration 317| WD.ClassUNSET 318| End If 319| End If 320| 321| 322| 'Put all OLC-files into the Delfiles-Dictionary and then remove all Images which are in Database and not in the Killinglist 323| 'Initialize WaitdialogClass 324| If WD.ClassInit(OLCfiles.Count, "Building Lists with garbage files and files to preserve ...", False, SCRIPTNAME, ScriptVersionString) <> -1 Then 325| MsgBox DialogTitle & vbNewLine & vbNewLine & "Couldn't initialize the WaitDialogClass!" & vbNewLine & "Script stops now!", vbExclamation, DialogTitle 326| GoTo Escape 327| End If 328| WD.SetLine2("... building garbage list ...") 329| WD.InitReversedCount(OLCfiles.Count) 330| For Each x In OLCfiles 331| Delfiles.Item(x) = OLCfiles.Item(x) 332| WD.CountProcessedFileReversed 333| WD.SetPercentage 334| Next x 335| WD.Closes 336| Totaltime = Totaltime + WD.ProcessSummary.procDuration 337| WD.ClassUNSET 338| 339| 340| 'Initialize WaitdialogClass 341| If WD.ClassInit(IbuckHas.Images.Count, "Building Lists with garbage files and files to preserve ...", True, SCRIPTNAME, ScriptVersionString) <> -1 Then 342| MsgBox DialogTitle & vbNewLine & vbNewLine & "Couldn't initialize the WaitDialogClass!" & vbNewLine & "Script stops now!", vbExclamation, DialogTitle 343| GoTo Escape 344| End If 345| WD.SetLine2("... building preserved list ...") 346| For Each PicT In IbuckHas.Images 347| WD.CountProcessedFile 348| olcname = hn_BuildFolderStr(DBOLCfolder, Left(CStr(PicT.OID), 2)) & PicT.OID & ".jpg" 349| If hn_FileExists(olcname) Then 350| If Not IbuckKill Is Nothing Then 351| If Not IbuckKill.Find(PicT) Then Delfiles.Remove(Trim(CStr(PicT.OID))) 352| Else 353| Delfiles.Remove(Trim(CStr(PicT.OID))) 354| End If 355| End If 356| WD.SetLine3(CStr(WD.ProcessSummary.procFiles)) 357| WD.SetPercentage 358| If WD.UserHasCanceled Then GoTo Escape 359| Next PicT 360| WD.Closes 361| Totaltime = Totaltime + WD.ProcessSummary.procDuration 362| WD.ClassUNSET 363| 364| 365| Escape: 366| FreeObject(cat) 367| Exit Sub 368| 369| ErrHandler: 370| ErrMsg(Err) 371| Resume Escape 372| 373| End Sub 374| 375| 376| Private Function OLCDirIntoDictionary(ByRef FilenameDic As Dictionary, ByVal FullPathFolder As String, Optional ByVal subfolders As Boolean = False) As Boolean 377| 378| On Error GoTo Errhandler 379| 380| Dim dirs As Dictionary 381| Dim p As String 382| p = hn_BuildFolderStr(FullPathFolder) 383| 384| 385| If DoScriptDebug Then Debug.Print "- Proceed: " & p 386| 387| ' First scan the files in the folder 388| Dim fname As String, s As String, oid As String 389| 390| fname = Dir(p & "*.*",vbNormal) 391| While fname <> "" 392| s = LCase(p & fname) 393| If Right(s, 3) = "jpg" Then 394| s = Replace(s, ".jpg", "") 395| s = Mid(s, InStrRev(s, "\")+1) 396| If DoScriptDebug Then Debug.Print "- Add: " & s & " = " & p & fname 397| FilenameDic.Add(s, p & fname) 398| End If 399| fname = Dir() 400| Wend 401| 402| 403| If subfolders Then 404| 405| Set dirs = New Dictionary 406| 407| fname = Dir(p & "*.*",vbDirectory) 408| While fname <> "" 409| If (GetAttr(p & fname) And vbDirectory) = vbDirectory Then 410| If Left(fname,1) <> "." Then 411| dirs.Add(dirs.Count +1, p & fname) 412| If DoScriptDebug Then Debug.Print "- Found SubDir: " & p & fname 413| End If 414| End If 415| fname = Dir() 416| Wend 417| 418| Dim d As Variant 419| For Each d In dirs 420| OLCDirIntoDictionary(FilenameDic, dirs.Item(d), subfolders) 421| Next d 422| 423| End If 424| 425| OLCDirIntoDictionary = True 426| 427| Escape: 428| FreeObject(dirs) 429| Exit Function 430| 431| ErrHandler: 432| ErrMsg(Err) 433| Resume Escape 434| 435| End Function 436| 437| 438| Private Function DoDialog() As Integer 439| 440| On Error GoTo Errhandler 441| 442| 443| Begin Dialog UserDialog 830,357,DialogTitle,.DLG_func ' %GRID:10,7,1,1 444| GroupBox 610,7,210,203,"select Cats",.GroupBox3 445| GroupBox 10,7,590,336,"",.GroupBox1 446| Text 30,28,550,301,"",.txt 447| OKButton 720,322,90,21 448| CancelButton 620,322,90,21 449| PushButton 620,28,190,21,"select Categories",.BtnKillCatImages 450| ListBox 620,56,190,147,CatList(),.ExcListBox,3 451| Picture 610,224,210,56,MacroDir & "\icons\removecatslogo.bmp",0,.Picture1 452| PushButton 30,308,550,21,"check DB- and OLC-Images",.BtnStartBuildingLists 453| PushButton 620,287,190,21,"Instructions for use",.Btn_Info 454| End Dialog 455| 456| 457| Dim dlg As UserDialog 458| 459| DoDialog = Dialog(dlg) 460| 461| 462| Escape: 463| Exit Function 464| 465| ErrHandler: 466| ErrMsg(Err) 467| Resume Escape 468| 469| End Function 470| 471| 472| Private Function DLG_func(DlgItem$, Action%, SuppValue&) As Boolean 473| 474| On Error GoTo ErrHandler 475| 476| Select Case Action% 477| 478| Case 1 479| DlgText("txt", SetText("start")) 480| DlgEnable("OK", False) 481| 482| Case 2 ' Value changing or button pressed 483| Select Case DlgItem$ 484| 485| Case "Btn_Info" 486| MsgBox InfoMsg, vbInformation, DialogTitle 487| DLG_func = True 488| 489| 490| Case "BtnStartBuildingLists" 491| DlgVisible("BtnStartBuildingLists", False) 492| BuildLists(True) 493| DlgText("txt", SetText("")) 494| DlgEnable("OK", True) 495| DLG_func = True 496| 497| 498| Case "BtnKillCatImages" 499| Set KillCatImages = DB.SelectCategoriesDialog(KillCatImages, False) 500| If Not KillCatImages Is Nothing Then 501| If KillCatImages.Count > 0 Then 502| Dim Cat As Category, i As Integer 503| ReDim CatList(0 To KillCatImages.Count -1) 504| For Each Cat In KillCatImages 505| CatList(i) = Cat.FullName 506| i = i +1 507| Next Cat 508| Else 509| ReDim CatList(0) 510| End If 511| End If 512| DlgListBoxArray "ExcListBox", CatList() 513| If Not DlgVisible("BtnStartBuildingLists") Then 514| BuildLists(False) 515| DlgText("txt", SetText("")) 516| End If 517| DLG_func = True 518| 519| Case "ExcListBox" 520| DLG_func = True 521| 522| End Select 523| 524| 525| End Select 526| 527| 528| Escape: 529| FreeObject(Cat) 530| Exit Function 531| 532| ErrHandler: 533| ErrMsg(Err) 534| Resume Escape 535| 536| End Function 537| 538| 539| Private Function SetText(ByVal start As String) As String 540| 541| On Error GoTo ErrHandler 542| 543| If start = "start" Then 544| 545| SetText = "This script checks the OfflineCacheFolder" & vbNewLine & _ 546| "[" & DBOLCfolder & "]" & vbNewLine & _ 547| "of the active Database [" & hn_FileStrObject(DB.FileName).FName & "]" & " for ownerless OLC-Images." & vbNewLine & vbNewLine & _ 548| "Additionally you can select Categories from which all OLC-Images should also be deleted." & vbNewLine & vbNewLine & _ 549| vbNewLine & vbNewLine & _ 550| "To start the script you have to press the Button 'check DB- and OLC-Images'" & vbNewLine & vbNewLine & _ 551| "After that all Database-Images will checked for OLC-Pendants," & vbNewLine & _ 552| "and all files in OLC-Folder will checked for Database-Pendants." & vbNewLine & vbNewLine & _ 553| "All ownerless Images will added to a KillingList." & vbNewLine & vbNewLine & _ 554| "If you have selected Categories, then the OLC-Images" & vbNewLine & _ 555| "from this Categories Images (including _ALL_ Childcategories) also will" & vbNewLine & _ 556| "added to the Killinglist." & vbNewLine & vbNewLine & _ 557| "The result will displayed here, and then you can decide to start deleting." 558| 559| Else 560| 561| SetText = "This script checks the OfflineCacheFolder" & vbNewLine & _ 562| "[" & DBOLCfolder & "]" & vbNewLine & _ 563| "of the active Database [" & hn_FileStrObject(DB.FileName).FName & "]" & " for ownerless OLC-Images." & vbNewLine & vbNewLine & _ 564| "Additionally you can select Categories from which all OLC-Images should also be deleted." & vbNewLine & vbNewLine & _ 565| "The Database contains:" & vbNewLine & vbNewLine & _ 566| "Images total in DB: " & CStr(Selection.Count) & vbNewLine & _ 567| "Images with OLC: " & CStr(IbuckHas.Count) & vbNewLine & _ 568| "Images without OLC: " & CStr(IbuckHasnot.Count) & vbNewLine & vbNewLine & _ 569| "Images total in OLC-Folder: " & CStr(OLCfiles.Count) & vbNewLine & _ 570| "Images ownerless in OLC-Fol.: " & CStr(Ownerless) & vbNewLine & vbNewLine & _ 571| "Images from Catlist: " & CStr(IbuckKill.Count) & vbNewLine & vbNewLine & _ 572| "Images defined as garbage: " & CStr(Delfiles.Count) & vbNewLine & vbNewLine & _ 573| " (garbage = ownerless Images in OLCfolder + Images from Catlist which" & vbNewLine & " have an OLC-Pendant)" & vbNewLine & vbNewLine & _ 574| "To delete this garbage press OK." 575| 576| End If 577| 578| Escape: 579| Exit Function 580| 581| ErrHandler: 582| ErrMsg(Err) 583| Resume Escape 584| 585| End Function 586| 587| Private Function Infomsg() As String 588| 589| On Error GoTo ErrHandler 590| 591| Dim Imsg As String 592| Imsg = "Instructions for use:" & vbNewLine & vbNewLine & _ 593| "This script checks the Offlinecachefolder of the active Database for ownerless files." & vbNewLine & vbNewLine & _ 594| "Optionally you can select Categories. This Images Offlinecache-pendants also will add to the List." & vbNewLine & vbNewLine & _ 595| "First you have to specify the Constant in Scriptheadsection so that it points to your OfflineCacheRootfolder." & vbNewLine & _ 596| "This is only necessary for IMatch Versions prior than 3.3.0.8" & vbNewLine 597| If Application.Version < "3.3.0.8" Then Imsg = Imsg & "[ Like yours =:), " & Application.Version & " ]" & vbNewLine 598| Imsg = Imsg & vbNewLine & "If you have tested the scripts functionallity on your system and everything works fine," & vbNewLine & _ 599| "you may set thePrivate Const KillFilesOnlyAsSimulation to False, so that the script becomes" & vbNewLine & _ 600| "angry, ggrrhhhh, and really killes the garbage =:[x]" & vbNewLine & vbNewLine & _ 601| "Enjoy the free discspace, and if you don't have, please send me a picture ;-)" & vbNewLine & vbNewLine & _ 602| "For more information or other scripts go to my IMatch Scriptsection on http://horst.nogajski.de/imatch/" 603| 604| Infomsg = Imsg 605| 606| Escape: 607| Exit Function 608| 609| ErrHandler: 610| ErrMsg(Err) 611| Resume Escape 612| 613| End Function 614|