'#Reference {3F4DACA7-160D-11D2-A8E9-00104B365C9F}#1.0#0#C:\WINNT\System32\vbscript.dll\2#Microsoft VBScript Regular Expressions 1.0
'#Reference {00025E01-0000-0000-C000-000000000046}#5.0#0#C:\Program Files\Common Files\Microsoft Shared\DAO\Microsoft Shared\DAO\Dao360.dll#Microsoft DAO 3.6 Object Library
'#Reference {420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\WINNT\System32\scrrun.dll#Microsoft Scripting Runtime
''Scan data bases

'THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND
'EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
'OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE

Option Explicit

' Converts "\n" to linefeed and "\t" to tab
Function StringToPassolo(s As String) As String
	Dim res As String
	Dim reg As RegExp
	Set reg = New RegExp

	reg.Global = True
	reg.Pattern = "[^\\]\\n"
	res = reg.Replace(s, CStr(vbLf))
	reg.Pattern = "[^\\]\\t"
	res = reg.Replace(res, CStr(vbTab))

	StringToPassolo = res
End Function

' Converts linefeed to "\n" and tab to "\t"
Function StringToDatabase(s As String) As String
	Dim res As String
	Dim reg As RegExp
	Set reg = New RegExp

	reg.Global = True
	reg.Pattern = "\n"
	res = reg.Replace(s, "\n")
	reg.Pattern = "\t"
	res = reg.Replace(res, "\t")

	StringToDatabase = res
End Function


' Get data about the database from configuration file
' Line 1: filepath of database
' Line 2: name of table to be translated
' Line 3: name of field with resource entry ids
' Line 4: name of field with language codes
' Line 5: name of field with text
Function GetDatabaseInfo( SourceFile As String, ByRef db As String, ByRef tbl As String, ByRef idfld As String, ByRef langfld As String, ByRef textfld As String) As Boolean
	Dim pos As Integer
	Dim fso As Scripting.FileSystemObject, ti As Scripting.TextStream
    Set fso = New Scripting.FileSystemObject

	' If file does not exists => error
    On Error GoTo failure
    Set ti = fso.OpenTextFile(SourceFile)

	db = ti.ReadLine
	tbl = ti.ReadLine
	idfld = ti.ReadLine
	langfld = ti.ReadLine
	textfld = ti.ReadLine
	GetDatabaseInfo = True

	' Name of DB is absolute
	If Left(db,2) = "\\" Or Mid(db, 2, 1) = ":" Then Exit Function

	pos = InStrRev(SourceFile, "\")
	If pos = 0 Then GoTo failure

	db = Left(SourceFile, pos) & db

	Exit Function

failure:
GetDatabaseInfo = False
	PSL.Output("Error reading database configuration file")
End Function

Function DbUpdate(rd As PslResData) As Long
    Dim dbs As Database
	Dim rcs1 As Recordset, rcs2 As Recordset
 	Dim db As String, tbl As String, idfld As String, langfld As String, textfld As String
 	Dim criteria As String, data As String

 	If GetDatabaseInfo(rd.SourceFile, db, tbl, idfld, langfld, textfld) = False Then
		DbUpdate = 1
		Exit Function
	End If

	DbUpdate = 0
	Set dbs = DAO.OpenDatabase(db)
	Set rcs1 = dbs.OpenRecordset(tbl, dbOpenDynaset, dbReadOnly)
	Set rcs2 = dbs.OpenRecordset(tbl, dbOpenDynaset)

	' Create Resource
	rd.ProcessResource "Database", tbl

	' For all entries with source language
	On Error GoTo skip
	criteria = langfld & "=" & CStr(rd.SourceLanguage)
	rcs1.FindFirst(criteria)
	Do Until rcs1.NoMatch

		' Process entry
		rd.SetEntryData(pslResUpdId, rcs1.Fields(idfld))
		rd.SetEntryData(pslResUpdText, StringToPassolo(rcs1.Fields(textfld)))
		rd.SetEntryData(pslResUpdCtrl, "")
		rd.ProcessEntry

		' If generation of target and translation available...
		If rd.Action = pslResUpdGenerate And rd.GetEntryData(pslResUpdTranslated) = "1" Then
			rcs2.MoveFirst
			rcs2.FindFirst(idfld & "='" & rcs1.Fields(idfld) & "' and " & langfld & "=" & CStr(rd.TargetLanguage))
			'target entry not found, create a new one
			If rcs2.NoMatch Then
				rcs2.AddNew
				rcs2.Fields(idfld) = rcs1.Fields(idfld)
				rcs2.Fields(textfld) = StringToDatabase(rd.GetEntryData(pslResUpdText))
				rcs2.Fields(langfld) = rd.TargetLanguage
				rcs2.Update
			' change the entry
			Else
				rcs2.Edit
				rcs2.Fields(textfld) = StringToDatabase(rd.GetEntryData(pslResUpdText))
				rcs2.Update
			End If

		End If

skip:   ' Error Handling
		If Err.Number <> 0 Then
			If Err.Number <> -2146825125& Then GoTo ende

			PSL.Output("Entry " & rcs1.Fields(idfld) & " might be too long in the translated version!")
			On Error GoTo skip
			Err.Clear
		End If

		rcs1.FindNext(criteria)
	Loop
	rcs2.Close
	rcs1.Close
ende:
End Function

Function DbListContent(rd As PslResData) As Long
    Dim dbs As Database
	Dim rcs As Recordset

 	Dim db As String, tbl As String, idfld As String, langfld As String, textfld As String

	DbListContent = 1
 	If GetDatabaseInfo(rd.SourceFile, db, tbl, idfld, langfld, textfld) = False Then
		Exit Function
	End If

	On Error GoTo ende
	Set dbs = DAO.OpenDatabase(db)
	Set rcs = dbs.OpenRecordset(tbl, dbOpenDynaset)
	DbListContent = 0

	' Run through all records and add language. Not very
	' efficient but multiple calls with	same data is allowed
	While True
		rd.ListResource "Database", tbl, rcs.Fields(langfld)
		rcs.MoveNext
	Wend
ende:
End Function

Function DbCheckFiles(rd As PslResData) As Long
    Dim fso As Scripting.FileSystemObject, ts As Scripting.TextStream, s As String
    Set fso = New Scripting.FileSystemObject

	' No TDB file
	If UCase(Right(rd.SourceFile, 3)) <> "TDB" Then GoTo failure

	' File does not exists
    On Error GoTo failure
    Set ts = fso.OpenTextFile(rd.SourceFile)

	DbCheckFiles = 0
	Exit Function

failure:
	DbCheckFiles = 1

End Function

Function DbGetLanguages(rd As PslResData) As Long
    Dim dbs As Database
	Dim rcs As Recordset

 	Dim db As String, tbl As String, idfld As String, langfld As String, textfld As String

	DbGetLanguages = 1

 	If GetDatabaseInfo(rd.SourceFile, db, tbl, idfld, langfld, textfld) = False Then
		Exit Function
	End If

	On Error GoTo ende
	Set dbs = DAO.OpenDatabase(db)
	Set rcs = dbs.OpenRecordset(tbl, dbOpenDynaset)
	DbGetLanguages = 0

	' Run through all records and add language. Not very
	' efficient but multiple calls with	same language is allowed
	While True
		rd.AddLanguage rcs.Fields(langfld)
		rcs.MoveNext
	Wend
ende:
End Function

' Dispatch the queries
Public Sub PSL_OnProcessUserFile(rd As PslResData)
	rd.Error = 0

	If rd.Action = pslResUpdGetFileExtensions Then
		rd.AddFileExtension("Database Defintion (*.tdb)", "*.tdb")
		Exit Sub
	End If

	' No Tdb file
	If UCase(Right(rd.SourceFile, 3)) <> "TDB" Then Exit Sub

	Select Case rd.Action
		Case pslResUpdGenerate
			rd.Error = DbUpdate(rd)
		Case pslResUpdScanTarget
			rd.Error = DbUpdate(rd)
		Case pslResUpdScanData
			rd.Error = DbUpdate(rd)
		Case pslResUpdListContent
			rd.Error = DbListContent(rd)
		Case pslResUpdCheckSourceTarget
			rd.Error = DbCheckFiles(rd)
		Case pslResUpdGetLanguages
			rd.Error = DbGetLanguages(rd)
		Case Else
			rd.Error = 1
	End Select
End Sub

