' ------------------------------------------------------------------------------------
'				Import-LivingAlbum2000.vbs
'
' This script can import albums created with Club Photo's Living Album 2000.
' (http://www.clubphoto.com/tools/la_soft.php)
' Pages are converted in MyAlbum as tabs (keywords with the Tab option).
' The following data is imported:
'	Photo caption --> First line of comment
'	Photo description --> Appended to the caption in the comment
'	Date Taken --> Date custom field
'	Place Taken --> Place custom field
'	Photo Web Url --> URL field
'	Marked --> Flagged/Marked flag
'	Linked sound --> Play command
' Note: The Photo description is a RTF string, we are using Microsoft Word (if
'	installed) to convert it to plain text for MyAlbum.
' ------------------------------------------------------------------------------------

Option Explicit
Const ForReading = 1, ForWriting = 2

const sLVADefaultFile = "C:\Program Files\Club Photo\Living Album 2000\MonAlbum.LVA"

dim myConnection, sqlQuery, rs, i, alb, pic, sCurPage, sLVAFile, sLVAFolder, fso, WordApp
dim cfDate, cfTime, cfPlace, sPic, s, sAlbumMediaPath

app.ClearTrace

if app.Version > "2.1.1" then
  sLVAFile = app.GetFilename( "Select the Living Album file to import", 0, "", "Living Album files (*.lva)|*.lva|All files (*.*)|*.*||", 0 )
else
  sLVAFile = sLVADefaultFile
end if 

set fso = CreateObject("Scripting.FileSystemObject")
if fso.FileExists( sLVAFile ) then ProcessLVAFile

app.Trace "Done !"


' ------------------------------------------------------------------------------------
function ProcessLVAFile

app.Trace "Living Album 2000 album is '" & sLVAFile & "'"
app.Trace "Opening LVA album..."
set myConnection = CreateObject("ADODB.Connection")
myConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sLVAFile & ";Persist Security Info=False"

' Get the MediaPath in the Info table
sqlQuery = "select * FROM Info"
set rs = myConnection.Execute( sqlQuery )
rs.MoveFirst
sAlbumMediaPath = rs.Fields("MediaPath")
rs.Close
set rs = Nothing


' LVA stores the pictures in a Entries table and the pages in a Pages table
' The script will define Tabs for each page and assign the picture to them.
sqlQuery = "select Entries.*, Pages.PageName, Pages.MediaPath FROM Entries INNER JOIN Pages ON Entries.PageID = Pages.PageID order by Entries.PageID, SlotNumber"
set rs = myConnection.Execute( sqlQuery )
rs.MoveFirst

'myConnection.Execute( "update Entries set SoundPath='C:\Program Files\Club Photo\Living Album 2000\The Microsoft Sound.wav' where EntryID=4" )


GetWordApp
'WordApp.Visible = True


' Create a new empty album and some Custom Fields
set alb = app.NewAlbum
set cfDate  = alb.AddCustomField( "Date", CF_DATE ) 
'set cfTime  = alb.AddCustomField( "Time", CF_TIME ) 
set cfPlace = alb.AddCustomField( "Place", CF_STRING ) 

sLVAFolder = left( sLVAFile, InStrRev( sLVAFile, "\" ) )

i = 1
sCurPage = "---"
while not rs.EOF
  if rs.Fields("PageName") <> sCurPage then
    Dim kw
    sCurPage = rs.Fields("PageName")
    app.Trace " Page '" & sCurPage & "'"
    set kw = alb.AddKeyword( sCurPage )
    kw.bIsTab = True
  end if
  app.Trace "    Picture " & i & vbTab & rs.fields("Title").value
  sPic = rs.Fields("FilePath")
  if left( sPic, 2 ) = "!!" then	' Not an absolute path
    sPic = sLVAFolder & sAlbumMediaPath & "\" & rs.Fields("MediaPath") & "\" & mid( sPic, 3 )
  end if
'app.Trace sPic
  set pic = alb.AddPicture( sPic )
  if pic is Nothing then
    ' Picture not found, create an empty picture anyway
    set pic = alb.NewPicture( 32, 32, 24, 0)
    pic.sFileName = sPic
  end if
  pic.sComment = rs.Fields("Title")
  if rs.Fields("Description") <> "" then
    if pic.sComment <> "" then pic.sComment = pic.sComment & vbCRLF
    if WordApp is Nothing then
	' Word not available, simply add the RTF text
	pic.sComment = pic.sComment & rs.Fields("Description")
    else
	Dim sRTFFile, f, doc
	sRTFFile = sLVAFolder & "desc.rtf"
	Set f = fso.OpenTextFile( sRTFFile, ForWriting, True)
	f.Write rs.Fields("Description")
	f.Close
	set doc = WordApp.Documents.Open( sRTFFile )
	WordApp.Selection.WholeStory
	s = WordApp.Selection
	pic.sComment = pic.sComment & Replace( s, vbCR, vbCRLF )
	doc.Close
	set doc = Nothing
    end if
  end if

  pic.SetKeyword sCurPage, True

  s = rs.Fields("DateTaken")
  if (IsDate(s)) then
    dim lDateTime
    lDateTime = app.DateToTimeValue( CDate(s) )
    pic.SetCustomFieldDate cfDate.sName, lDateTime
  end if
  s = rs.Fields("PlaceTaken")
  if s <> "" then pic.SetCustomField cfPlace.sName, s
  if rs.Fields("IsMarked") = -1 then pic.lStatus = pic.lStatus or STATE_FLAGGED
  if rs.Fields("PhotoWebUrl") <> "" then pic.sURL = rs.Fields("PhotoWebUrl")
  if rs.Fields("SoundPath") <> "" then pic.sPlayCmd = "media|" & rs.Fields("SoundPath")

  rs.MoveNext
  i = i+1
wend

'set kw = alb.AddKeyword( "--Delete this keyword when finished--" )

alb.Redraw
set alb = Nothing

' Close the database
set rs = Nothing
myConnection.Close
set myConnection = Nothing
set fso = Nothing

' Stop Word if we have been using it
if not WordApp is Nothing then
  WordApp.Quit
  set WordApp = Nothing
end if
end function


' ------------------------------------------------------------------------------------
function GetWordApp
  On error resume next
  set WordApp = CreateObject("Word.Application")
  if Err.Number <> 0 then
    set WordApp = Nothing
    app.Trace "Caution: Microsoft Word not found. Photo descriptions will not be converted."
  end if
  Err.Clear
end function