201 lines
4.7 KiB
OpenEdge ABL
201 lines
4.7 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "Main"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = True
|
|
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
|
|
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
|
|
Attribute VB_Ext_KEY = "Member0" ,"CHHT"
|
|
Attribute VB_Ext_KEY = "Member1" ,"CKeywords"
|
|
Attribute VB_Ext_KEY = "Member2" ,"CMilestones"
|
|
Attribute VB_Ext_KEY = "Member3" ,"CStopSigns"
|
|
Attribute VB_Ext_KEY = "Member4" ,"CStopWords"
|
|
Attribute VB_Ext_KEY = "Member5" ,"CSynonymSets"
|
|
Attribute VB_Ext_KEY = "Member6" ,"CTaxonomy"
|
|
Option Explicit
|
|
|
|
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
|
|
|
|
Private p_clsHHT As HHT
|
|
Private p_clsImporter As Importer
|
|
Private p_clsKeywords As Keywords
|
|
Private p_clsStopSigns As StopSigns
|
|
Private p_clsStopWords As StopWords
|
|
Private p_clsSynonymSets As SynonymSets
|
|
Private p_clsTaxonomy As Taxonomy
|
|
|
|
Private Sub Class_Initialize()
|
|
|
|
Dim intIndex As Long
|
|
|
|
Set g_cnn = New ADODB.Connection
|
|
Set g_clsParameters = New Parameters
|
|
g_strUserName = Space$(100)
|
|
GetUserName g_strUserName, 100
|
|
|
|
' Get rid of the terminating NULL char.
|
|
For intIndex = 1 To 100
|
|
If (Asc(Mid$(g_strUserName, intIndex, 1)) = 0) Then
|
|
g_strUserName = Left$(g_strUserName, intIndex - 1)
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
SetLogFile
|
|
|
|
End Sub
|
|
|
|
Private Sub Class_Terminate()
|
|
|
|
Set g_cnn = Nothing
|
|
|
|
Set p_clsHHT = Nothing
|
|
Set p_clsImporter = Nothing
|
|
Set p_clsKeywords = Nothing
|
|
Set g_clsParameters = Nothing
|
|
Set p_clsStopSigns = Nothing
|
|
Set p_clsStopWords = Nothing
|
|
Set p_clsSynonymSets = Nothing
|
|
Set p_clsTaxonomy = Nothing
|
|
|
|
End Sub
|
|
|
|
Public Sub SetDatabase( _
|
|
ByVal i_strDatabaseName As String _
|
|
)
|
|
|
|
If (g_cnn.State = adStateOpen) Then
|
|
g_cnn.Close
|
|
End If
|
|
|
|
g_cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
|
|
"Data Source=" & i_strDatabaseName & ";"
|
|
|
|
If (g_cnn.State <> adStateOpen) Then
|
|
Err.Raise E_FAIL
|
|
End If
|
|
|
|
CheckDatabaseVersion
|
|
|
|
End Sub
|
|
|
|
Public Function CopyAndCompactDatabase( _
|
|
ByVal i_strDatabaseName As String, _
|
|
ByVal i_strDatabaseCopy As String, _
|
|
Optional ByVal lcid As Long = 1033 _
|
|
) As Boolean
|
|
|
|
On Error GoTo LErrorHandler
|
|
|
|
Dim je As New JRO.JetEngine
|
|
|
|
CopyAndCompactDatabase = False
|
|
|
|
' Make sure that a file with the same name doesn't exist
|
|
If Dir(i_strDatabaseCopy) <> "" Then Kill i_strDatabaseCopy
|
|
|
|
' Save the database first
|
|
Name i_strDatabaseName As i_strDatabaseCopy
|
|
|
|
' Create the database by compacting the saved copy
|
|
je.CompactDatabase _
|
|
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
|
|
"Data Source=" & i_strDatabaseCopy & ";", _
|
|
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
|
|
"Data Source=" & i_strDatabaseName & ";" & _
|
|
"Locale Identifier=" & lcid & ";"
|
|
' "Jet OLEDB:Encrypt Database=True;" &
|
|
' "Jet OLEDB:Database Password=password"
|
|
|
|
CopyAndCompactDatabase = True
|
|
|
|
Exit Function
|
|
|
|
LErrorHandler:
|
|
|
|
End Function
|
|
|
|
Public Property Get HHT() As HHT
|
|
|
|
If (p_clsHHT Is Nothing) Then
|
|
Set p_clsHHT = New HHT
|
|
End If
|
|
|
|
Set HHT = p_clsHHT
|
|
|
|
End Property
|
|
|
|
Public Property Get Importer() As Importer
|
|
|
|
If (p_clsImporter Is Nothing) Then
|
|
Set p_clsImporter = New Importer
|
|
End If
|
|
|
|
Set Importer = p_clsImporter
|
|
|
|
End Property
|
|
|
|
Public Property Get Keywords() As Keywords
|
|
|
|
If (p_clsKeywords Is Nothing) Then
|
|
Set p_clsKeywords = New Keywords
|
|
End If
|
|
|
|
Set Keywords = p_clsKeywords
|
|
|
|
End Property
|
|
|
|
Public Property Get Parameters() As Parameters
|
|
|
|
Set Parameters = g_clsParameters
|
|
|
|
End Property
|
|
|
|
Public Property Get StopSigns() As StopSigns
|
|
|
|
If (p_clsStopSigns Is Nothing) Then
|
|
Set p_clsStopSigns = New StopSigns
|
|
End If
|
|
|
|
Set StopSigns = p_clsStopSigns
|
|
|
|
End Property
|
|
|
|
Public Property Get StopWords() As StopWords
|
|
|
|
If (p_clsStopWords Is Nothing) Then
|
|
Set p_clsStopWords = New StopWords
|
|
End If
|
|
|
|
Set StopWords = p_clsStopWords
|
|
|
|
End Property
|
|
|
|
Public Property Get SynonymSets() As SynonymSets
|
|
|
|
If (p_clsSynonymSets Is Nothing) Then
|
|
Set p_clsSynonymSets = New SynonymSets
|
|
End If
|
|
|
|
Set SynonymSets = p_clsSynonymSets
|
|
|
|
End Property
|
|
|
|
Public Property Get Taxonomy() As Taxonomy
|
|
|
|
If (p_clsTaxonomy Is Nothing) Then
|
|
Set p_clsTaxonomy = New Taxonomy
|
|
End If
|
|
|
|
Set Taxonomy = p_clsTaxonomy
|
|
|
|
End Property
|