'' -*- basic -*-
' dbspec.vbs
' $Name:  k$Date: 2023-11-28 17:15:14 -0700 (Tue, 28 Nov 2023) $ $Rev: 95692 $ $
'
' Written by Cubane Canada 2003-09-23
' Modified codebase from dbopit
'
' 
Option Explicit
' Global Variables
' 
Dim g_wsh                               ' Windows scripting Shell object
Dim g_fso                               ' File system object
Dim g_strScriptName                     ' This script's name
Dim g_strLogFileName                    ' Log file name
Dim g_tflLog                            ' Log file object

Dim g_strOurDBPath                      ' path to our database (supplied)

Dim g_strOurDBDir                       ' GMCL data directory (where spec.mdb is found)
Dim g_strOurDBName                      ' full database filename (Path + spec.mdb)

Dim g_strOutputDBDir                    ' output database directory

Dim g_dbOur                             ' Our database object

Dim g_nDebugMode                        ' Debugging Level

Const DEBUG_PROD  = 0                   ' production: log errors
Const DEBUG_TEST  = 1                   ' test: log and print errors, log DebugOuts
Const DEBUG_DEVEL = 2                   ' Development: log and print all

Const ENOTFOUND = 3265                  ' Error: not found in collection
Const ENOEXCLUSIVE = 3356               ' Error: can't get exclusive access (someone else has)

' CommitTrans options
Const dbForceOSFlush = 1                ' force writing buffers after commit

g_nDebugMode = DEBUG_DEVEL
SetLocale("en-us")

Main

Sub Main()

  ' Initialize global objects
  InitializeGlobals                     

  ' parses argument list
  ParseArgs

  ' Open 
  OpenDatabases

  ' Link the tables we want
  LinkTables

  ' Closes all databases
  CloseDatabases

  ' delete global objects (cleaning up)
  DeleteGlobals

  ' End script and indicate success
  WScript.Quit 0

End Sub

Sub ParseArgs()

'  On Error Resume Next
  Dim nIndex
  Dim Args
  Dim strSourceDB

  nIndex = 0

  DebugOut "Parsing arguments..."
  
  On Error Resume Next

  Set Args = WScript.Arguments

  If InStr( 1, Args.Item(nIndex), "d=", vbTextCompare ) Then
    g_nDebugMode = CInt( Mid( Args.Item(nIndex), 3 ) )
    nIndex = nIndex + 1
  End If

  If Args.Count - nIndex <> 1 Then
    WScript.Echo "Expected one argument: <build home>"
    WScript.Quit 1
  End If

  ' Arg 1: path to our database
  g_strOurDBPath = Args.Item( nIndex )
  nIndex = nIndex + 1

  g_strOurDBPath = g_fso.BuildPath( g_strOurDBPath, "PROGRAMS" )

  g_strOutputDBDir = "."

  strSourceDB = g_fso.BuildPath( g_strOurDBPath, "spec.mdb" )
  g_strOurDBName = "spec.mdb"

  g_fso.DeleteFile g_strOurDBName, True
  If Err.Number <> 0 And Err.Number <> 53 Then
    LogError "Problem deleting " & g_strOurDBName & " " & _
             Err.Number & " " & Err.Description
    Err.Clear
    WScript.Quit 1
  End If

  DebugOut "Done parsing arguments..."

End Sub

Sub InitializeGlobals()

  DebugOut "Initializing Global Objects..."
  g_strScriptName = WScript.ScriptName

  Set g_wsh = CreateObject("WScript.Shell")
  If( Err.Number <> 0 ) Then
    MsgBox "Can't create WScript.Shell " & vbCRLF & _
           "Error # " & CStr(Err.Number) & _
           " " & Err.Description & "-- " & g_strScriptName & _
           " aborting."
    WScript.Quit 1
  End If

  On Error Resume Next
  Set g_fso = CreateObject("Scripting.FileSystemObject")
  If( Err.Number <> 0 ) Then
    MsgBox "Can't create Scripting.FileSystemObject " & vbCRLF & _
           "Error # " & CStr(Err.Number) & _
           " " & Err.Description & "-- " & g_strScriptName & _
           " aborting."
    WScript.Quit 1
  End If

  ' configure log files
  g_strLogFileName = g_fso.GetBaseName( g_strScriptName ) & ".log"

  Set g_tflLog = g_fso.CreateTextFile( g_strLogFileName, True )
  If Err.Number <> 0 Then
    MsgBox "Can't open log file" & vbCRLF & _
           "Error # " & CStr(Err.Number) & _
           " " & Err.Description & "-- " & g_strScriptName & _
           " aborting."
    WScript.Quit    
  End If

  LogError "DBSPEC version $Date: 2023-11-28 17:15:14 -0700 (Tue, 28 Nov 2023) $ $Revision: 95692 $"

  DebugOut "Done Initializing Global Objects."

End Sub

Function MyRegRead( strKey )

  On Error Resume Next

  MyRegRead = g_wsh.RegRead(strKey)
  If Err.Number <> 0 Then
    LogError "Error reading registry key " & strKey & ": " & Err.Number & _
             " - " & Err.Description
    Err.Clear
    MyRegRead = ""
  End If
  
End Function

Sub OpenDatabases

  Dim sConnect
  
  DebugOut "Opening Databases..."
  
  On Error Resume Next

  sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & g_strOurDBName
  
  Set g_dbOur = CreateObject( "ADOX.Catalog" )
  g_dbOur.Create sConnect

  If( Err.Number <> 0 ) Then
    LogError "Can't open database " & g_strOurDBName & vbCRLF & _
           "Error # " & CStr(Err.Number) & _
           " " & Err.Description & "-- " & g_strScriptName & _
           " exiting."
    WScript.Quit 1
  End If

  DebugOut "Databases Opened."

End Sub

Sub LinkTables

  Dim folder
  Dim f

  On Error Resume Next
  DebugOut "Linking Tables..."

  Set folder = g_fso.GetFolder( g_strOutputDBDir )
  LinkAllDBF folder

  Set folder = folder.ParentFolder
  Set folder = folder.SubFolders( "TAG" )

  For Each f in folder.SubFolders 
	  LinkAllDBF f
  Next
  
  DebugOut "Tables Linked."

End Sub

Sub LinkAllDBF( folder )
  Dim rsLink
  Dim tdNew
  Dim strConnect
  Dim strTagTable
  Dim td
  Dim f
  Dim nLength
  

  On Error Resume Next
  DebugOut "Linking DBFs from " & folder.Name

  For Each f In folder.Files

    Dim strTableName
    Dim strFileName
    Dim tbl

	If StrComp( Right( f.Name, 4 ), ".DBF", 1 ) = 0 Then

		strTableName = Left( f.Name, Len( f.Name ) - 4 )
		strFileName = f.ShortName
		
		Set tbl = CreateObject( "ADOX.Table" )
		tbl.Name = strTableName
		Set tbl.ParentCatalog = g_dbOur
		
		tbl.Properties( "Jet OLEDB:Create Link" ) = True
		tbl.Properties( "Jet OLEDB:Link Datasource" ) = folder.Path
		tbl.Properties( "Jet OLEDB:Link Provider String" ) = "Dbase IV"
		tbl.Properties( "Jet OLEDB:Remote Table Name" ) = strFileName
		
		g_dbOur.Tables.Append tbl

		If Err.Number <> 0  Then
		  LogError "Problem appending linked table " & strTableName & ": " & _
				   Err.Number & " " & Err.Description
		End If

    End If
  Next

  DebugOut "Done Linking DBFs from " & folder.Name

End Sub

Function SanitizeString( strName )

		If IsNull( strName ) Then
			strName = ""
		End If

        ' Replace \ with -
        strName = Replace( strName, "\", "-" )

        ' Replace / with -
        strName = Replace( strName, "/", "-" )

        ' Replace : with -
        strName = Replace( strName, ":", "-" )

        ' Replace * with -
        strName = Replace( strName, "*", "-" )

        ' Replace ? with -
        strName = Replace( strName, "?", "-" )

        ' Replace " with -
        strName = Replace( strName, """", "-" )

        ' Replace < with -
        strName = Replace( strName, "<", "-" )

        ' Replace > with -
        strName = Replace( strName, ">", "-" )

        ' Replace | with -
        strName = Replace( strName, "|", "-" )

        ' Replace , with -
        strName = Replace( strName, ",", "-" )

		' Replace newline with space
		strName = RemoveNewlines( strName )

        SanitizeString = strName

End Function  

Function RemoveNewlines( strName )

		' Replace newlines with spaces
		strName = Replace( strName, vbCR, " " )
		strName = Replace( strName, vbLF, " " )

		RemoveNewlines = strName

End Function

Sub CloseDatabases

  DebugOut "Starting to close databases..."
  Set g_dbOur = Nothing
  DebugOut "Databases closed."

End Sub

Sub DeleteGlobals

  On Error Resume Next

  DebugOut "Starting to delete global objects..."
  Set g_fso = Nothing
  Set g_wsh = Nothing

  DebugOut "Closing log file... Bye!"
  g_tflLog.Close
  If Err.Number <> 0 Then
    MsgBox "Error closing log file " & g_strLogFileName & vbCRLF & _
           Err.Number & " " & Err.Description
  End If
  Set g_tflLog = Nothing
  g_tflLog = Empty

End Sub

Sub LogError( Str )

  On Error Resume Next

  If Not IsEmpty( g_tflLog ) Then
    g_tflLog.WriteLine( Str )
  End If

  If g_nDebugMode >= DEBUG_TEST Then
    WScript.Echo Str
  End If

End Sub

Sub DebugOut(str)

  On Error Resume Next

  If g_nDebugMode >= DEBUG_TEST Then
    If Not IsEmpty( g_tflLog ) Then
      g_tflLog.WriteLine( Str )
    End If
  End If

  If g_nDebugMode >= DEBUG_DEVEL Then
    WScript.Echo Str
  End If
  
End Sub

