Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/himetr1r/modfiles.bas

BASIC Source File | 1999-08-17 | 8.8 KB | 343 lines

Attribute VB_Name = "modFiles"
'----------------------------------------
'- Name: Sam Huggill
'- Email: [e-mail]
'- Web: http://www.vbsquare.com/
'- Company: Lighthouse Internet Solutions
'- Date/Time: 14/08/99 11:30:03
'----------------------------------------
'- Notes:   Handles any file routines
'
'----------------------------------------

Option Explicit

Private m_blnRTF As Boolean

Public Sub ExportFile(sKey As String, tvw As TreeView, ctl As Object)
    Dim oHeader As FileHeader
    Dim lNumToExport As Long
    Dim cHourGlass As CWaitCursor
    Dim sFIleName As String
    Dim iFile As Integer
    Dim nNode As Node
    Dim lRet As Long

    '// Exports a node/nodes to a file
    '// By Chris Eastwood

    Set nNode = tvw.SelectedItem

    If nNode Is Nothing Then Exit Sub

    sFIleName = frmMain.ShowFileDialog(eSave, "", "Export Code Item", "Developers Code Book |*.dcb")

    If Len(sFIleName) = 0 Then Exit Sub

    lRet = MsgBox("Would you like to export the code styles (colouring)?", vbYesNo + vbInformation)
    If lRet = vbYes Then
        g_blnRTF = True
    Else
        g_blnRTF = False
    End If

    Set cHourGlass = New CWaitCursor
    cHourGlass.SetCursor

    iFile = FreeFile

    On Error Resume Next

    Kill sFIleName
    On Error GoTo 0

    Open sFIleName For Binary Access Write As iFile

    oHeader.lNumberOfRecords = frmMain.RecursiveCountNodes(tvw.SelectedItem, True)

    If nNode.Key <> "ROOT" Then
        oHeader.lNumberOfRecords = oHeader.lNumberOfRecords + 1
    End If

    Put #iFile, , oHeader
    ctl.Redraw False
    modData.RecursiveExportCode nNode, iFile, frmMain.ctlData1
    ctl.Redraw True
    Close iFile

    MsgBox "Code item exported to " & sFIleName

End Sub

Public Sub NewDB(ByVal strPath As String)

    Dim tdfCode As TableDef
    Dim tdfBookmark As TableDef
    Dim tdfFolders As TableDef
    Dim tdfVer As TableDef
    Dim tdfLinks As TableDef
    Dim tdfFiles As TableDef
    Dim fldFile As Field
    Dim fldID As Field
    Dim fldDesc As Field
    Dim fldCode As Field
    Dim fldNotes As Field
    Dim fldExample As Field
    Dim fldPID As Field
    Dim fldVer As Field
    Dim fldLev As Field
    Dim fldCodeID As Field
    Dim fldSect As Field
    Dim fldName As Field
    Dim fldFolder As Field
    Dim fldLink As Field
    Dim fldDateTime As Field
    Dim db As Database
    Dim rs As Recordset
    Dim strDBPath As String

    strDBPath = strPath

' Creates a new database for storing code in

    If strDBPath = "" Then Exit Sub

    If strDBPath = modData.DBName Then
        MsgBox "You cannot overwrite the database currently in use."
        Exit Sub
    End If

' Check if the database already exists and delete it if so

    If InStr(strDBPath, ".mdb") Then
        If Len(Dir$(strDBPath)) <> 0 Then Kill (strPath)
    Else
        If Dir$(strDBPath & ".mdb") <> "" Then Kill (strPath & ".mdb")
    End If

' Create the database and the first table

    Set db = CreateDatabase(strPath, dbLangGeneral)
    Set tdfCode = db.CreateTableDef("Code")

' Create all the fields needed in the Code table

    Set fldID = tdfCode.CreateField("ID", 4)
    fldID.Attributes = 17
    fldID.Required = False
    fldID.OrdinalPosition = 1
    Set fldDesc = tdfCode.CreateField("Description", dbText)
    Set fldCode = tdfCode.CreateField("Code", dbMemo)
    Set fldNotes = tdfCode.CreateField("Notes", dbMemo)
    Set fldExample = tdfCode.CreateField("Example", dbMemo)
    Set fldPID = tdfCode.CreateField("ParentID", dbInteger)
    Set fldVer = tdfCode.CreateField("Version", dbText)
    Set fldLev = tdfCode.CreateField("Level", dbText)

' Append the fields to the table

    With tdfCode.Fields
        .Append fldID
        .Append fldDesc
        .Append fldCode
        .Append fldNotes
        .Append fldExample
        .Append fldPID
        .Append fldVer
        .Append fldLev
    End With

' Append the table to the database

    db.TableDefs.Append tdfCode

' Create the Bookmarks table

    Set tdfBookmark = db.CreateTableDef("Bookmarks")

' Create the needed fields

    Set fldID = tdfBookmark.CreateField("ID", 4)
    Set fldCodeID = tdfBookmark.CreateField("CodeID", dbInteger)
    Set fldDesc = tdfBookmark.CreateField("Description", dbText)
    Set fldSect = tdfBookmark.CreateField("Section", dbText)
    Set fldFolder = tdfBookmark.CreateField("IsFolder", dbBoolean)

'Append the fields to the table

    With tdfBookmark.Fields
        .Append fldID
        .Append fldCodeID
        .Append fldDesc
        .Append fldSect
        .Append fldFolder
    End With

' Append the table to the database

    db.TableDefs.Append tdfBookmark

' Create the Folders table

    Set tdfFolders = db.CreateTableDef("Folders")

' Create the fields needed

    Set fldID = tdfFolders.CreateField("ID", 4)
    Set fldName = tdfFolders.CreateField("Name", dbText)
    Set fldPID = tdfFolders.CreateField("ParentID", dbInteger)

    fldID.Attributes = 17
    fldID.Required = False
    fldID.OrdinalPosition = 1

' Append the fields

    With tdfFolders.Fields
        .Append fldID
        .Append fldName
        .Append fldPID
    End With

' Append the table to the database

    db.TableDefs.Append tdfFolders

    Set tdfVer = db.CreateTableDef("Version")
    Set fldVer = tdfVer.CreateField("DB Version", dbInteger)
    tdfVer.Fields.Append fldVer

    db.TableDefs.Append tdfVer

    Set tdfLinks = db.CreateTableDef("Links")
    Set fldID = tdfLinks.CreateField("ID", 4)
    fldID.Attributes = 17
    fldID.Required = False
    fldID.OrdinalPosition = 1
    Set fldLink = tdfLinks.CreateField("Link", dbText)
    Set fldName = tdfLinks.CreateField("Name", dbText)
    Set fldDateTime = tdfLinks.CreateField("DateTime", dbText)

    With tdfLinks.Fields
        .Append fldID
        .Append fldLink
        .Append fldName
        .Append fldDateTime
    End With

    db.TableDefs.Append tdfLinks

    Set tdfFiles = db.CreateTableDef("Files")
    Set fldID = tdfFiles.CreateField("ID", 4)
    fldID.Attributes = 17
    fldID.Required = False
    fldID.OrdinalPosition = 1
    Set fldFile = tdfFiles.CreateField("File", dbLongBinary)
    Set fldDateTime = tdfFiles.CreateField("DateTime", dbText)
    Set fldName = tdfFiles.CreateField("Name", dbText)
    Set fldCodeID = tdfFiles.CreateField("CodeID", dbInteger)

    With tdfFiles.Fields
        .Append fldID
        .Append fldFile
        .Append fldDateTime
        .Append fldName
        .Append fldCodeID
    End With

    db.TableDefs.Append tdfFiles

    modData.DBName = strPath

    Set db = OpenDatabase(modData.DBName)
    Set rs = db.OpenRecordset("SELECT * FROM Version")
    rs.AddNew
    rs.Fields("DB Version").Value = 3
    rs.Update
    rs.Close
    db.Close

    modFiles.OpenDB modData.DBName

End Sub

Public Sub OpenDB(strPath As String)
    On Error Resume Next

' Opens a database when one is currently open

    If strPath = "" Then Exit Sub

' Carry out the form's unload routine

    frmMain.UnloadMe

' Save the old database filename and carry out shutdown routines

    SaveSetting ThisApp, "General", "DBPath", modData.DBName
    modData.SetNothing
    modData.DBName = modMain.LastDB

' Open the new database and fill the treeview

    If modData.OpenDB(strPath) = True Then
        modMain.ClearTree frmMain.tvwItems
        modData.FillTree frmMain.tvwItems
        frmMain.ctlFavourites1.Initalize
        frmMain.ctlData1.Initalize
    End If

End Sub

Public Sub InsertFile(strPath As String)

' Based on the VBCodeLibrary procedure by
' Chris Eastwood - [e-mail]

    Dim strDesc As String

    strDesc = strPath

    modData.Description = strDesc

    ' Insert the file
    modData.InserObject True, strPath
End Sub

Public Sub InsertLink(strLink As String, strDesc As String)

' Insert a link into the database

    modData.Description = strDesc

    modData.InserObject False, "", strLink

End Sub

Public Sub OutputFile(lv As ListView)
    Dim strKey As String
    Dim strFileName As String

' Check if an item is selected

    If lv.SelectedItem Is Nothing Then Exit Sub

' Set the data properties

    modData.Key = lv.SelectedItem.Key
    strKey = Right$(modData.Key, Len(modData.Key) - 1)

' Get the current filename, and then get the users filename

    strFileName = lv.SelectedItem.SubItems(1)

    strFileName = frmMain.ShowFileDialog(eSave, strFileName, "Save File As...")

    If Len(strFileName) = 0 Then Exit Sub

' Start the export process

    modData.ExportToFile strFileName

End Sub