98 lines
3.0 KiB
QBasic
98 lines
3.0 KiB
QBasic
|
Attribute VB_Name = "DataAccess"
|
||
|
|
Option Private Module
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
Public Function AccessDatabase() As InfoDatabase
|
||
|
|
Static s_AccessDatabase As InfoDatabase
|
||
|
|
|
||
|
|
On Error GoTo CREATE_NEW
|
||
|
|
Set AccessDatabase = s_AccessDatabase.Validate
|
||
|
|
Exit Function
|
||
|
|
|
||
|
|
CREATE_NEW:
|
||
|
|
Set s_AccessDatabase = New InfoDatabase
|
||
|
|
Call s_AccessDatabase.Init(ThisWorkbook, GetDocumentsLocation(ThisWorkbook))
|
||
|
|
Set AccessDatabase = s_AccessDatabase
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function SetDocumentsLocation(sDir$)
|
||
|
|
ThisWorkbook.Names(HT03_CELL_FOLDER).RefersToRange = sDir
|
||
|
|
AccessDatabase.docsLocation_ = GetDocumentsLocation(ThisWorkbook)
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function ClearAll()
|
||
|
|
ThisWorkbook.Names(CELL_STAT_BASE).RefersToRange = 0
|
||
|
|
Call SetDocumentsLocation(HT03_DEFAULT_WORKDIR)
|
||
|
|
Call ThisWorkbook.Sheets(HT03_SHT_DOCS).UsedRange.Offset(1).ClearContents
|
||
|
|
Call ThisWorkbook.Sheets(HT03_SHT_LINKS).UsedRange.Offset(1).ClearContents
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function GetIndexDump() As Long()
|
||
|
|
Dim theDB As InfoDatabase: Set theDB = AccessDatabase
|
||
|
|
GetIndexDump = theDB.IndexDump
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function GetLinksDump(target&) As Long()
|
||
|
|
Dim theDB As InfoDatabase: Set theDB = AccessDatabase
|
||
|
|
GetLinksDump = theDB.LinksDumpFor(target)
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function SetLinksFor(target&, linksData() As String)
|
||
|
|
Dim theDB As InfoDatabase: Set theDB = AccessDatabase
|
||
|
|
If Not theDB.Contains(target) Then _
|
||
|
|
Exit Function
|
||
|
|
|
||
|
|
Call theDB.StartOptimization
|
||
|
|
|
||
|
|
Call theDB.DeleteLinksFor(target)
|
||
|
|
Call theDB.SetLinksInternal(target, linksData)
|
||
|
|
|
||
|
|
Call theDB.EndOptimization
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function RemoveLinksFor(target&) As Long
|
||
|
|
RemoveLinksFor = 0
|
||
|
|
Dim lnksSht As Excel.Worksheet: Set lnksSht = ThisWorkbook.Sheets(HT03_SHT_LINKS)
|
||
|
|
Dim nRow&: nRow = HT03_DEFAULT_FIRST_LINE
|
||
|
|
Do While lnksSht.Cells(nRow, S_L_FROM_ID) <> vbNullString
|
||
|
|
If lnksSht.Cells(nRow, S_L_FROM_ID) = target Then
|
||
|
|
lnksSht.Rows(nRow).Delete
|
||
|
|
RemoveLinksFor = RemoveLinksFor + 1
|
||
|
|
Else
|
||
|
|
nRow = nRow + 1
|
||
|
|
End If
|
||
|
|
Loop
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function RemoveIDFromDocs(target&) As String
|
||
|
|
Dim docsSht As Excel.Worksheet: Set docsSht = ThisWorkbook.Sheets(HT03_SHT_DOCS)
|
||
|
|
Dim nRow&: nRow = HT03_DEFAULT_FIRST_LINE
|
||
|
|
Do While docsSht.Cells(nRow, S_D_GARANT_ID) <> vbNullString
|
||
|
|
If docsSht.Cells(nRow, S_D_GARANT_ID) = target Then
|
||
|
|
Dim theFile$: theFile = docsSht.Cells(nRow, S_D_FILENAME)
|
||
|
|
If theFile <> HT03_FILE_NOT_LOADED Then
|
||
|
|
theFile = AccessDatabase.docsLocation_ & "/" & theFile
|
||
|
|
Else
|
||
|
|
theFile = vbNullString
|
||
|
|
End If
|
||
|
|
docsSht.Rows(nRow).Delete
|
||
|
|
RemoveIDFromDocs = theFile
|
||
|
|
Exit Function
|
||
|
|
End If
|
||
|
|
nRow = nRow + 1
|
||
|
|
Loop
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function SubstituteLinks(nDelete&, nSubstitute&)
|
||
|
|
Dim lnksSht As Excel.Worksheet: Set lnksSht = ThisWorkbook.Sheets(HT03_SHT_LINKS)
|
||
|
|
Dim nRow&: nRow = HT03_DEFAULT_FIRST_LINE
|
||
|
|
Do
|
||
|
|
Dim sID$: sID = lnksSht.Cells(nRow, S_L_TO_ID)
|
||
|
|
If sID = vbNullString Then _
|
||
|
|
Exit Do
|
||
|
|
If sID = nDelete Then _
|
||
|
|
lnksSht.Cells(nRow, S_L_TO_ID) = nSubstitute
|
||
|
|
nRow = nRow + 1
|
||
|
|
Loop
|
||
|
|
End Function
|